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

Methods: All Methods Documented Methods Hide Methods
Source: Display Source Hide Source
Variables: Show Variables Hide Variables

Class ::xo::PackageMgr

::xo::PackageMgr create ... \
           [ -default_package_parameter_page_info (default "") ] \
           [ -default_package_parameters (default "") ] \
           [ -package_key package_key ] \
           [ -site_wide_package_parameter_page_info (default "") ] \
           [ -site_wide_package_parameters (default "") ] \
           [ -site_wide_pages (default "") ]

Defined in

Class Relations

class: ::xotcl::Class
superclass: ::xo::db::Class

::xotcl::Class create ::xo::PackageMgr \
     -superclass ::xo::db::Class

Methods (to be applied on the object)

get_package_class_from_package_key (scripted, public)

 xo::PackageMgr get_package_class_from_package_key package_key

Obtain the package class from a package key

Parameters:

package_key (required)

Testcases:
package_normalize_path, xowiki_test_cases, link_tests, path_resolve, create_form_with_form_instance

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
}]

Methods (to be applied on instances)

configure_fresh_instance (scripted)

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

default_package_parameter_page_info (setter)
default_package_parameters (setter)

first_instance (scripted, public)

 <instance of xo::PackageMgr> first_instance \
    [ -privilege privilege ] [ -party_id party_id ]

Returns the first mounted instance of this Package. When a privilege and a party are specified, will return the first instance where the party has such privilege.

Switches:

-privilege (optional)
-party_id (optional)
the party we are checking the privilege for

Returns:
integer package_id, empty string when none is found

Testcases:
xowiki_test_cases, create_form_with_form_instance

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]

fix_site_wide_package_ids (scripted)

#
# 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]))
    }]
  }
}

form_unify (scripted)

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"
    }
  }
}

form_usages (scripted)


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

get_nls_language_from_lang (scripted)

#
# 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 ""

get_site_wide_page (scripted)

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 ""

import_prototype_page (scripted, public)

 <instance of xo::PackageMgr> import_prototype_page \
    [ -package_key package_key ] -name name  -parent_id parent_id  \
    -package_id package_id  [ -lang lang ] [ -add_revision on|off ]

Import a named page from the prototypes folder of the package, i.e. under www/prototypes/*.page of the package.

Switches:

-package_key (optional)
when provided, the package_key used to locate the page. When not provided, use the package_key of the class, on which this function is called.
-name (required)
name of the page to be loaded (not including the language prefix)
-parent_id (required)
place to where the page should be loaded
-package_id (required)
package instance to which the page should be loaded
-lang (optional, defaults to "en")
-add_revision (optional, boolean, defaults to "true")
When the page to be loaded exists already, add a new revision. When the page exists already, and the flag is not set, no change happens.

Testcases:
xowiki_test_cases

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

initialize (scripted, public)

 <instance of xo::PackageMgr> initialize [ -ad_doc ad_doc ] \
    [ -parameter parameter ] [ -package_id package_id ] [ -url url ] \
    [ -user_id user_id ] [ -actual_query actual_query ] \
    [ -original_url_and_query original_url_and_query ] \
    [ -init_url init_url ] [ -keep_cc keep_cc ] \
    [ -form_parameter form_parameter ] [ -export_vars export_vars ]

Create the connection context ::xo::cc and a package object if these are none defined yet. The connection context ::xo::cc and the package object will be destroyed on cleanup, when the global variables are reclaimed. As a side effect this method sets in the calling context the query parameters and package_id as variables, using the "defaults" for default values. init_url false requires the package_id to be specified and a call to Package instproc set_url to complete initialization. keep_cc true means that the original connection context is preserved (i.e. not altered) in case it exists already.

Switches:

-ad_doc (optional)
-parameter (optional)
-package_id (optional, defaults to "0")
-url (optional)
-user_id (optional, defaults to "-1")
-actual_query (optional, defaults to " ")
-original_url_and_query (optional)
-init_url (optional, defaults to "true")
-keep_cc (optional, defaults to "false")
-form_parameter (optional)
-export_vars (optional, defaults to "true")

Testcases:
package_normalize_path, includelet_toc, includelet_childresources, xowiki_test_cases, link_tests, slot_interactions, path_resolve, create_form_with_form_instance

#: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

instances (scripted, public)

 <instance of xo::PackageMgr> instances \
    [ -include_unmounted include_unmounted ] [ -closure closure ]

Switches:

-include_unmounted (optional, defaults to "false")
include unmounted package instances
-closure (optional, defaults to "false")
include instances of subclasses of the package

Returns:
list of package_ids of xowiki instances

Testcases:
No testcase defined.

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]

lookup_side_wide_page (scripted)

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

package_key (setter)

prototype_page_file_name (scripted)

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

require (scripted, public)

 <instance of xo::PackageMgr> require [ -url url ] package_id

Create package object if needed.

Switches:

-url (optional)

Parameters:

package_id (required)

Testcases:
create_folder_with_page, package_normalize_path, xowiki_test_cases, create_form_with_form_instance

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
  }
}

require_site_wide_info (scripted)

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}

require_site_wide_pages (scripted, public)

 <instance of xo::PackageMgr> require_site_wide_pages \
    [ -refetch on|off ] [ -refetch_if_modified on|off ] \
    [ -pages pages ]

Load site-wide pages from the prototype page directory. The pages are loaded into to site-wide instance. When a page to be loaded exists already, a new revision is added. If no pages are provided, use the list of pages as defined for the package.

Switches:

-refetch (optional, boolean, defaults to "false")
force fresh loading of prototype pages
-refetch_if_modified (optional, boolean, defaults to "false")
refetch when modification date of file is new than the version in the content repository
-pages (optional)
list of pages (without languages prefix) or empty to refer to per-package definition.

Testcases:
xowiki_test_cases

#
# 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'"
  }
}

site_wide_package_parameter_page_info (setter)
site_wide_package_parameters (setter)
site_wide_pages (setter)

Methods: All Methods Documented Methods Hide Methods
Source: Display Source Hide Source
Variables: Show Variables Hide Variables

Class ::xo::PackageMgr

Class Relations

Methods (to be applied on the object)

get_package_class_from_package_key (scripted, public)

Methods (to be applied on instances)

configure_fresh_instance (scripted)

default_package_parameter_page_info (setter)

default_package_parameters (setter)

first_instance (scripted, public)

fix_site_wide_package_ids (scripted)

form_unify (scripted)

form_usages (scripted)

get_nls_language_from_lang (scripted)

get_site_wide_page (scripted)

import_prototype_page (scripted, public)

initialize (scripted, public)

instances (scripted, public)

lookup_side_wide_page (scripted)

package_key (setter)

prototype_page_file_name (scripted)

require (scripted, public)

require_site_wide_info (scripted)

require_site_wide_pages (scripted, public)

site_wide_package_parameter_page_info (setter)

site_wide_package_parameters (setter)

site_wide_pages (setter)