Class ::xo::PackageMgr (public)

 ::xotcl::Class ::xo::PackageMgr

Defined in

Testcases:

No testcase defined.

Source code:

namespace eval ::xo {}
::nsf::object::alloc ::xotcl::Class ::xo::PackageMgr {set :__default_metaclass ::xotcl::Class
   set :__default_superclass ::xotcl::Object}
::xo::PackageMgr proc get_package_class_from_package_key package_key {
    return [acs::per_thread_cache eval -key xotcl-core.get_package_class_from_package_key($package_key) {
      set result ""
      foreach p [::xo::PackageMgr allinstances] {
        if {[$p package_key] eq $package_key} {
          set result $p
          break
        }
      }
      set result
    }]
  }
::xo::PackageMgr instproc require_site_wide_pages {{-refetch:boolean false} {-refetch_if_modified:boolean false} {-pages ""}} {
    #
    # When no pages are provided, take the default of the definition of
    # the package class.
    #
    if {$pages eq ""} {
      set pages ${:site_wide_pages}
    }
    set info [:require_site_wide_info]
    foreach n $pages {
      set item_id [::xo::db::CrClass lookup -name en:$n -parent_id [dict get $info folder_id]]
      #:log "lookup en:$n => $item_id"
      if {$item_id == 0} {
        #:log "require_site_wide_pages lookup for 'en:$n' failed"

        #
        # Try to refetch without prefix to support loading of
        # prefix-less pages.
        #
        set item_id [::xo::db::CrClass lookup -name $n -parent_id [dict get $info folder_id]]
        if {$item_id != 0} {
          :log "Page $n was already loaded without a prefix"
        }
      }
      set refetch_this_page $refetch

      #
      # Check, if we have to refetch the page, since it was changed in
      # the meantime in the file-system.
      #
      if {!$refetch_this_page && $item_id != 0 && $refetch_if_modified} {
        set existing_page [::xo::db::CrClass get_instance_from_db -item_id $item_id]
        set fn [:prototype_page_file_name -name $n -package_key ${:package_key}]
        set time [clock scan [::xo::db::tcl_date [$existing_page publish_date] tz_var]]
        if {[ad_file mtime $fn] > $time} {
          set refetch_this_page true
        }
        if {$refetch_this_page} {
          ns_log notice "page $n: refetch newer-than-installed prototype file"
        }
      }
      if {$item_id == 0 || $refetch_this_page} {
        :log "require_site_wide_pages tries to load en:$n"
        set page [:import_prototype_page  -name $n  -parent_id [dict get $info folder_id]  -package_id [dict get $info instance_id] ]
        :log "Page en:$n loaded as '$page'"
      }
    }
  }
::xo::PackageMgr instproc instances {{-include_unmounted false} {-closure false}} {
    set package_key ${:package_key}
    if {$include_unmounted} {
      set result [::xo::dc list get_xowiki_packages {select package_id  from apm_packages where package_key = :package_key}]
    } else {
      set result [::xo::dc list get_mounted_packages {select package_id  from apm_packages p, site_nodes s  where package_key = :package_key  and s.object_id = p.package_id}]
    }
    if {$closure} {
      foreach subclass [:info subclass] {
        foreach id [$subclass instances -include_unmounted $include_unmounted -closure true] {
          lappend result $id
        }
      }
    }
    return [lsort -integer $result]
  }
::xo::PackageMgr instproc form_usages {{-forms {}}} {

    if {$forms eq ""} {
      set forms [:site_wide_pages]
    }
    foreach form $forms {
      set sql [subst {
        select item_id, i.name,  i.parent_id, o.package_id, site_node__url(sn.node_id),
        (select count(*) from xowiki_form_instance_item_index where i.item_id = page_template),
        (select count(*) from xowiki_page_instance where i.item_id=page_template),
        (select count(revision_id) from cr_revisions r where i.item_id=r.item_id)
        from cr_items i, acs_objects o, site_nodes sn
        where i.name like '%$form%'
        and o.object_id = i.item_id and o.package_id = sn.object_id order by 3
      }]
      append msg "==== Form: $form [string repeat = [expr {90-[string length $form]}]]\n"
      append msg  [format %7s item_id] " " [format %4s revs] " " [format %-30s name] " "  [format %6s count1]  " " [format %6s count2] " "  [format %9s parent_id] " " [format %11s package_id] " "  path \n

      foreach tuple [xo::dc list_of_lists form-usages $sql] {
        lassign $tuple item_id name parent_id package_id url count1 count2 revs
        if {$parent_id ne 0} {
          xo::Package require $package_id
          set form [::xo::db::CrClass get_instance_from_db -item_id $item_id]
          set fullPath [$form pretty_link]
          set path [file join {*}[lrange [file split $fullPath] 0 end-1]]
        } else {
          set path $url
        }
        append msg  [format %7d $item_id] " " [format %4d $revs] " " [format %-30s $name] " "  [format %6d $count1]  " " [format %6d $count2] " "  [format %9d $parent_id] " " [format %11d $package_id] " "  $path \n
      }
      append msg \n
    }
    return $msg
  }
::xo::PackageMgr instproc get_nls_language_from_lang lang {
    #
    # Return the first nls_language matching the provided lang
    # prefix. This method is not precise (when e.g. two nls_languages
    # are defined with the same lang), but the only thing relevant is
    # the lang anyhow.  If nothing matches return empty.
    #
    foreach nls_language [lang::system::get_locales] {
      if {[string range $nls_language 0 1] eq $lang} {
        return $nls_language
      }
    }
    return ""
  }
::xo::PackageMgr instproc import_prototype_page {-package_key -name:required -parent_id:required -package_id:required {-lang en} {-add_revision:boolean true}} {
    if {![info exists package_key] && [info exists :package_key]} {
      set package_key ${:package_key}
    }
    set page ""
    set fn [:prototype_page_file_name -name $name -package_key $package_key]
    #:log "--W check $fn"
    if {![ad_file readable $fn]} {
      ns_log notice "no such prototype page $fn"
      return ""
    }
    #
    # We have the file of the prototype page. We try to create
    # either a new item or a revision from definition in the file
    # system.
    #
    if {[regexp {^(..):(.*)$} $name _ lang local_name]} {
      set fullName $name
    } else {
      set fullName en:$name
    }
    :log "--sourcing page definition $fn, using name '$fullName'"
    set page [source $fn]
    $page configure  -name $fullName  -parent_id $parent_id  -package_id $package_id
    #
    # xowiki::File has a different interface for build-name to
    # derive the "name" from a file-name. This is not important for
    # prototype pages, so we skip it
    #
    if {![$page istype ::xowiki::File]} {
      set nls_language [:get_nls_language_from_lang $lang]
      $page name [$page build_name -nls_language $nls_language]
      #:log "--altering name of page $page to '[$page name]'"
      set fullName [$page name]
    }
    if {![$page exists title]} {
      $page set title $object
    }
    $page destroy_on_cleanup
    $page set_content [string trim [$page text] " \n"]
    $page initialize_loaded_object

    xo::Package require $package_id
    set p [::$package_id get_page_from_name  -name $fullName  -assume_folder [$page is_folder_page]  -parent_id $parent_id]
    #:log "--get_page_from_name '$fullName' -parent_id $parent_id --> '$p'"
    if {$p eq ""} {
      #
      # We have to create the page new. The page is completed with
      # missing vars on save_new.
      #
      #:log "--save_new of $page class [$page info class]"
      $page save_new
    } else {
      #:log "--save revision $add_revision"
      if {$add_revision} {
        #
        # An old page exists already, create a revision.  Update the
        # existing page with all scalar variables from the prototype
        # page (which does not have always all instance variables set)
        #
        foreach v [$page info vars] {
          if {[$page array exists $v]} continue ;# don't copy arrays
          $p set $v [$page set $v]
        }
        #:log "--save of $p [$p name] class [$p info class]"
        $p save
      }
      set page $p
    }
    if {$page ne ""} {
      #
      # We want to be able to address the page after this call via the
      # canonical name ::$item_id
      #
      set page [::xo::db::CrClass get_instance_from_db -item_id [$page item_id]]
    }
    return $page
  }
::xo::PackageMgr instproc require_site_wide_info {} {
    if {![info exists :site_wide_info]} {

      if {[info exists :__currently_intiating]} {
        set site_wide_instance_id ${:__currently_intiating}
        dict set :site_wide_info folder_id [::$site_wide_instance_id folder_id]
      } else {

        set cmd [list [self] configure_fresh_instance  -parameter_page_info ${:site_wide_package_parameter_page_info}  -parameters ${:site_wide_package_parameters}  ]
        #
        # The call "require_site_wide_package" causes a flush in
        # site_nodes_id_cache-* (which might be overly
        # cautious). Since site_wide_info is required often, we cache
        # the call and result.
        #
        set site_wide_instance_id [::xo::xotcl_package_cache eval site_wide_package-${:package_key} {
          set r [acs_admin::require_site_wide_package  -package_key ${:package_key}  -configuration_command $cmd]
          if {$r eq ""} {
            ns_log warning "acs_admin::require_site_wide_package -package_key ${:package_key}"  "returned empty package_id. Do not cache!"
            break
          }
          set r
        }]
      }

      #ns_log notice "======require_site_wide_info site_wide_instance_id -> <$site_wide_instance_id>"

      #
      # During install, no xo::cc is available, but it seems to be
      # needed for instantiating prototype pages. So provide a best
      # effort initialization in such cases.
      #
      if {![nsf::is object ::xo::cc]} {
        :initialize -package_id $site_wide_instance_id -init_url false
        ns_log notice "require_site_wide_info gets own xo::cc"
      }

      #
      # Require the package to be available
      #
      :require $site_wide_instance_id

      dict set :site_wide_info folder_id [::$site_wide_instance_id folder_id]
      dict set :site_wide_info instance_id $site_wide_instance_id
    }
    return ${:site_wide_info}
  }
::xo::PackageMgr instproc configure_fresh_instance {-package_id:required {-parameter_page_info ""} {-parameters ""}} {
    set :__currently_intiating $package_id
    #
    # The parameter pages are an xowiki thing, so - for the time
    # being, we keep it here. Since there is no higher-level
    # counterpart for it.
    #
    if {[llength $parameter_page_info] > 0} {
      ::xowiki::require_parameter_page  -package_id $package_id  -name [dict get $parameter_page_info name]  -title [dict get $parameter_page_info title]  -instance_attributes [dict get $parameter_page_info instance_attributes]
    }
    #
    # Configuring of the parameters is performed after the optional
    # configuration of the parameter page, since by setting the
    # package parameter "parameter_page" to a page that does not exist
    # yet, would lead to errors.
    #
    if {[llength $parameters] > 0} {
      foreach {parameter value} $parameters {
        ::parameter::set_value  -package_id $package_id  -parameter $parameter  -value $value
      }
    }
    unset -nocomplain :__currently_intiating
  }
::xo::PackageMgr instproc form_unify {{-doit:switch false} {-forms {}}} {
    if {$forms eq ""} {
      set forms [:site_wide_pages]
    }

    set site_info [:require_site_wide_info]
    set parent_id [dict get $site_info folder_id]
    foreach form $forms {
      #
      # Change the page template the former global forms and other forms
      # (having parent_id != $parent_id) to the global instance forms.
      #
      set source_list [concat {*}[::xo::dc list_of_lists get_forms [subst {
        select name,item_id from cr_items
        where parent_id != :parent_id
        and content_type like '::%'
        and name = :form
      }]]]

      set target_list {*}[::xo::dc list_of_lists get_forms [subst {
        select name,item_id from cr_items
        where parent_id = :parent_id
        and name = :form
      }]]

      foreach {form id} $source_list {
        ns_log notice "WORK ON form <$form> id <$id>"
        if {[dict exist $target_list $form]} {
          #
          # Change page template to site_wide page except for site_wide
          # instance folder itself (chicken/egg problem).
          #
          set where_clause [subst {
            where page_template = $id
            and name != 'xowiki: [dict get $site_info instance_id]'
          }]
          #
          # Update xowiki_form_instance_item_index.
          #
          set cmd1 [list xo::dc dml change_page_template [subst {
            update xowiki_form_instance_item_index
            set page_template = '[dict get $target_list $form]' $where_clause
          }]]
          #
          # Update revisions.
          #
          set cmd2 [list xo::dc dml change_page_template [subst {
            update xowiki_page_instance
            set page_template = '[dict get $target_list $form]'
            where page_instance_id in (
                                       select page_instance_id
                                       from xowiki_page_instance x, cr_revisions cr, cr_items ci
                                       $where_clause and cr.revision_id = page_instance_id
                                       and cr.item_id = ci.item_id
                                       )
          }]]

          if {$doit} {
            {*}$cmd1
            {*}$cmd2
          } else {
            ns_log notice "unify_forms would do: $cmd1"
            ns_log notice "unify_forms would do: $cmd2"
            set item_ids [::xo::dc list get_items [subst {
              select item_id from xowiki_form_instance_item_index
              $where_clause
            }]]
            ns_log notice "affected items $item_ids"
          }
        } else {
          error "no such target form"
        }
      }
    }
  }
::xo::PackageMgr instproc get_site_wide_page -name:required {
    set item_id [:lookup_side_wide_page -name $name]
    # :ds "lookup from base objects $name => $item_id"
    if {$item_id} {
      set page [::xo::db::CrClass get_instance_from_db -item_id $item_id]
      set package_id [$page package_id]
      if {$package_id ne ""} {
        #$form set_resolve_context -package_id $package_id -parent_id $parent_id
        ::xo::Package require $package_id
      }

      return $page
    }
    return ""
  }
::xo::PackageMgr instproc prototype_page_file_name {-package_key -name:required} {
    if {![info exists package_key] && [info exists :package_key]} {
      set package_key ${:package_key}
    }
    foreach location {resources www} {
      set fn $::acs::rootdir/packages/$package_key/$location/prototypes/$name.page
      if {[file exists $fn]} {
        if {$location eq "www"} {
          ad_log_deprecated "location of prototype page" $fn  packages/$package_key/resources/prototypes/
        }
        break
      }
    }
    return $fn
  }
::xo::PackageMgr instproc initialize {-ad_doc {-parameter ""} {-package_id 0} {-url ""} {-user_id -1} {-actual_query " "} -original_url_and_query {-init_url true} {-keep_cc false} -form_parameter {-export_vars true}} {
    #:msg "--i [self args], URL=$url, init_url=$init_url"

    if {[info exists ad_doc] && [api_page_documentation_mode_p]} {
      ad_parse_documentation_string $ad_doc doc_elements
      set doc_elements(query) $parameter
      error [array get doc_elements] "ad_page_contract documentation"
    }

    if {$url eq "" && $init_url} {
      if {[ns_conn isconnected]} {
        set url [acs::root_of_host [ad_host]][ns_conn url]
      } else {
        #
        # In case, we are not connected and no URL path is provided,
        # we do a best effort job to set the "url" variable to a path
        # belonging to the right package. The is no way to provide
        # here a better approximation. Note that if e.g. a batch job
        # needs a more precise (object_specific) url, this has to be
        # generated on the caller side with [$object_id pretty_link]
        # or similar means.
        #
        set url [lindex [site_node::get_url_from_object_id -object_id $package_id] 0]
        ns_log warning "PackageMgr initialize sets best-effort URL <$url>"
      }
      #:log "--CONN ns_conn url -> $url"
    }

    #
    # Get package_id from url in case it is not known. When the
    # package_id is already known, this is a noop.
    #
    set package_id [ConnectionContext require_package_id_from_url  -package_id $package_id $url]
    #
    # Require connection context if needed
    #
    ConnectionContext require  -keep_cc $keep_cc  -package_id $package_id -user_id $user_id  -parameter $parameter -url $url -actual_query $actual_query

    if {[info exists original_url_and_query]} {
      ::xo::cc original_url_and_query $original_url_and_query
    }

    if {[info exists form_parameter]} {
      ::xo::cc array set form_parameter $form_parameter
    }

    #
    # Create package object instance if necessary.
    #
    if {$keep_cc} {
      :require $package_id
    } else {
      :require -url $url $package_id
    }

    #
    # In case the login expired, we can force an early login to
    # prevent later login redirects, which can cause problems
    # from within catch operations. The package can decide, if
    # it want to force a refresh of the login, even if some pages
    # might not require the real user_id.
    #
    #:msg "force [::$package_id force_refresh_login] && #    [::xo::cc set untrusted_user_id] != [::xo::cc user_id]"
    if {[::$package_id force_refresh_login]
        && [::xo::cc set untrusted_user_id] != [::xo::cc user_id]} {
      auth::require_login
    }

    if {$export_vars} {
      ::xo::cc export_vars -level 2
    }
    return $package_id
  }
::xo::PackageMgr instproc lookup_side_wide_page -name:required {
    set id [::xo::db::CrClass lookup  -name $name  -parent_id [dict get [:require_site_wide_info] folder_id]]
    #:log "lookup_side_wide_page <$name> uses [:require_site_wide_info] => $id"
    return $id
  }
::xo::PackageMgr instproc first_instance {-privilege -party_id} {
    set package_key ${:package_key}
    if {![info exists privilege]} {
      return [::xo::dc get_value -prepare text get_first_package_id {
        select min(package_id)
          from apm_packages, site_nodes s
         where package_key = :package_key
           and s.object_id = package_id
      }]
    } elseif {[db_driverkey ""] eq "postgresql"} {
      # On Postgres we can use a recursive database function to check
      # for permissions on many objects more efficiently.
      set sql {
        select min(orig_object_id)
          from acs_permission.permission_p_recursive_array(array(
                select package_id
                  from apm_packages, site_nodes s
                 where package_key = :package_key
                   and s.object_id = package_id
                ), :party_id, :privilege)
      }
    } else {
      set sql {
        select min(package_id)
        from apm_packages, site_nodes s
       where package_key = :package_key
         and s.object_id = package_id
         and acs_permission.permission_p(package_id, :party_id, :privilege) = 't'
      }
    }

    return [::xo::dc get_value -prepare {text integer text} get_first_package_id_with_privilege $sql]
  }
::xo::PackageMgr instproc fix_site_wide_package_ids {} {
    #
    # In case, site-wide pages were moved to the global instance, fix
    # the package ids.
    #
    set site_info [:require_site_wide_info]
    set package_id [dict get $site_info instance_id]
    set item_ids [xo::db::CrClass get_child_item_ids  -item_id [dict get $site_info folder_id]]
    if {[llength $item_ids] > 0} {
      xo::dc transaction {
        #
        # Fix items
        #
        xo::dc dml fix_package_ids1 [subst {
          update acs_objects set package_id = :package_id
          where object_id in ([ns_dbquotelist $item_ids])
        }]
        #
        # Fix revisions
        #
        xo::dc dml fix_package_ids2 [subst {
          update acs_objects set package_id = :package_id
          where object_id in (select revision_id from cr_revisions
                              where item_id in ([ns_dbquotelist $item_ids]))
        }]
      }
    }
  }
::xo::PackageMgr instproc require {{-url ""} package_id} {
    if {$package_id eq ""} {
      #::xo::show_stack
      error "package_id must not be empty"
    }

    #:log "--R $package_id exists? [nsf::is object ::$package_id] url='$url'"

    if {![nsf::is object ::$package_id]} {
      #:log "--R we have to create ::$package_id //url='$url'"
      #
      # To make initialization code generic, we obtain from the
      # package_id the class of the package.
      #
      set package_key [apm_package_key_from_id $package_id]
      set package_class [[self class] get_package_class_from_package_key $package_key]
      if {$package_class eq ""} {
        #
        # For some unknown reason, we did not find the key.  We want
        # to be conservative, behave like in older versions that did
        # not provide a package_key, but required for this call to be
        # invoked on the actual class of the package. We provide
        # compatibility, but complain in ns_log.
        #
        # (E.g. hypermail2xowiki uses this)
        ns_log warning "Could not find ::xo::Package with key $package_key ($package_id)"
        set package_class [self]
      }

      if {$url ne ""} {
        $package_class create ::$package_id -destroy_on_cleanup -id $package_id -url $url
      } else {
        $package_class create ::$package_id -destroy_on_cleanup -id $package_id
      }
    } else {
      if {$url ne ""} {
        ::$package_id set_url -url $url
      }
    }
  }
::xo::PackageMgr instparametercmd site_wide_package_parameters
::xo::PackageMgr instparametercmd default_package_parameters
::xo::PackageMgr instparametercmd package_key
::xo::PackageMgr instparametercmd site_wide_pages
::xo::PackageMgr instparametercmd default_package_parameter_page_info
::xo::PackageMgr instparametercmd site_wide_package_parameter_page_info
::nsf::relation::set ::xo::PackageMgr superclass ::xo::db::Class

::nx::slotObj -container slot ::xo::PackageMgr
::xo::PackageMgr::slot eval {set :__parameter {
        package_key
        {default_package_parameters ""}
        {default_package_parameter_page_info ""}
        {site_wide_package_parameters ""}
        {site_wide_package_parameter_page_info ""}
        {site_wide_pages ""}
      }}

::nsf::object::alloc ::xotcl::Attribute ::xo::PackageMgr::slot::site_wide_package_parameter_page_info {set :accessor public
   set :configurable true
   set :convert false
   set :default {}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::PackageMgr
   set :incremental 0
   set :manager ::xo::PackageMgr::slot::site_wide_package_parameter_page_info
   set :methodname site_wide_package_parameter_page_info
   set :multiplicity 1..1
   set :name site_wide_package_parameter_page_info
   set :parameterSpec {-site_wide_package_parameter_page_info:substdefault {}}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::PackageMgr::slot::default_package_parameters {set :accessor public
   set :configurable true
   set :convert false
   set :default {}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::PackageMgr
   set :incremental 0
   set :manager ::xo::PackageMgr::slot::default_package_parameters
   set :methodname default_package_parameters
   set :multiplicity 1..1
   set :name default_package_parameters
   set :parameterSpec {-default_package_parameters:substdefault {}}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::PackageMgr::slot::default_package_parameter_page_info {set :accessor public
   set :configurable true
   set :convert false
   set :default {}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::PackageMgr
   set :incremental 0
   set :manager ::xo::PackageMgr::slot::default_package_parameter_page_info
   set :methodname default_package_parameter_page_info
   set :multiplicity 1..1
   set :name default_package_parameter_page_info
   set :parameterSpec {-default_package_parameter_page_info:substdefault {}}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::PackageMgr::slot::site_wide_package_parameters {set :accessor public
   set :configurable true
   set :convert false
   set :default {}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::PackageMgr
   set :incremental 0
   set :manager ::xo::PackageMgr::slot::site_wide_package_parameters
   set :methodname site_wide_package_parameters
   set :multiplicity 1..1
   set :name site_wide_package_parameters
   set :parameterSpec {-site_wide_package_parameters:substdefault {}}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::PackageMgr::slot::site_wide_pages {set :accessor public
   set :configurable true
   set :convert false
   set :default {}
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::PackageMgr
   set :incremental 0
   set :manager ::xo::PackageMgr::slot::site_wide_pages
   set :methodname site_wide_pages
   set :multiplicity 1..1
   set :name site_wide_pages
   set :parameterSpec {-site_wide_pages:substdefault {}}
   set :per-object false
   set :position 0
   set :required false
   set :substdefault 0b111
   set :trace none
   : init}

::nsf::object::alloc ::xotcl::Attribute ::xo::PackageMgr::slot::package_key {set :accessor public
   set :configurable true
   set :convert false
   set :defaultmethods {}
   set :disposition alias
   set :domain ::xo::PackageMgr
   set :incremental 0
   set :manager ::xo::PackageMgr::slot::package_key
   set :methodname package_key
   set :multiplicity 1..1
   set :name package_key
   set :parameterSpec -package_key
   set :per-object false
   set :position 0
   set :required false
   set :trace none
   : init}

XQL Not present:

Generic, PostgreSQL, Oracle