The meta class CrClass serves for a class of applications that mostly store information in the content repository and that use a few @@ -35,7 +36,7 @@
Each content item can be retrieved either through the
general method
-
+
CrClass get_instance_from_db or through the "get_instance_from_db" method of
every subclass of CrItem.
@@ -48,29 +49,38 @@
#
CrClass ad_proc get_object_type {
- -item_id
- {-revision_id 0}
+ -item_id:integer,required
+ {-revision_id:integer 0}
} {
Return the object type for an item_id or revision_id.
@return object_type typically an XOTcl class
} {
- set object_type [ns_cache eval xotcl_object_type_cache \
- [expr {$item_id ? $item_id : $revision_id}] {
- if {$item_id} {
- ::xo::dc 1row get_class_from_item_id \
- "select content_type as object_type from cr_items where item_id=:item_id"
- } else {
- ::xo::dc 1row get_class_from_revision_id \
- "select object_type from acs_objects where object_id=:revision_id"
- }
- return $object_type
- }]
+ #
+ # Use a request-spanning cache. When the type whould changes, we
+ # would require xo::broadcast or server restart.
+ #
+ set key ::xo::object_type($item_id,$revision_id)
+ if {[info exists $key]} {
+ return [set $key]
+ }
+ set $key [ns_cache eval xotcl_object_type_cache \
+ [expr {$item_id ? $item_id : $revision_id}] {
+ if {$item_id} {
+ ::xo::dc 1row get_class_from_item_id \
+ "select content_type as object_type from cr_items where item_id=:item_id"
+ } else {
+ ::xo::dc 1row get_class_from_revision_id \
+ "select object_type from acs_objects where object_id=:revision_id"
+ }
+ return $object_type
+ }]
}
CrClass ad_proc get_instance_from_db {
- {-item_id 0}
- {-revision_id 0}
+ {-item_id:integer 0}
+ {-revision_id:integer 0}
+ {-initialize:boolean true}
} {
Instantiate the live revision or the specified revision of an
CrItem. The XOTcl object is destroyed automatically on cleanup
@@ -80,7 +90,7 @@
} {
set object_type [my get_object_type -item_id $item_id -revision_id $revision_id]
set class [::xo::db::Class object_type_to_class $object_type]
- return [$class get_instance_from_db -item_id $item_id -revision_id $revision_id]
+ return [$class get_instance_from_db -item_id $item_id -revision_id $revision_id -initialize $initialize]
}
CrClass ad_proc get_parent_id {
@@ -409,7 +419,7 @@
-item_id:required
{-revision_id 0}
-object:required
- {-initialize true}
+ {-initialize:boolean true}
} {
Load a content item into the specified object. If revision_id is
provided, the specified revision is returned, otherwise the live
@@ -464,19 +474,27 @@
}
if {$revision_id} {
$object set revision_id $revision_id
- $object db_1row [my qn fetch_from_view_revision_id] "\
- select [join $atts ,], i.parent_id \
- from [my set table_name]i n, cr_items i,acs_objects o \
- where n.revision_id = :revision_id \
- and i.item_id = n.item_id \
- and o.object_id = n.revision_id"
+
+ db_with_handle db {
+ set sql [::xo::dc prepare -handle $db -argtypes integer "\
+ select [join $atts ,], i.parent_id \
+ from [my set table_name]i n, cr_items i,acs_objects o \
+ where n.revision_id = :revision_id \
+ and i.item_id = n.item_id \
+ and o.object_id = n.revision_id"]
+
+ set selection [db_exec 1row $db dbqd..cr-procs-fetch_object-from-revision_id $sql]
+ }
+ $object mset [ns_set array $selection]
+
} else {
# We fetch the creation_user and the modifying_user by returning the
# creation_user of the automatic view as modifying_user. In case of
# troubles, comment next line out.
lappend atts "n.creation_user as modifying_user"
$object set item_id $item_id
+
$object db_1row [my qn fetch_from_view_item_id] "\
select [join $atts ,], i.parent_id \
from [my set table_name]i n, cr_items i, acs_objects o \
@@ -502,6 +520,7 @@
CrClass ad_instproc get_instance_from_db {
{-item_id 0}
{-revision_id 0}
+ {-initialize:boolean true}
} {
Retrieve either the live revision or a specified revision
of a content item with all attributes into a newly created object.
@@ -516,7 +535,8 @@
set object ::[expr {$revision_id ? $revision_id : $item_id}]
if {![my isobject $object]} {
my fetch_object -object $object \
- -item_id $item_id -revision_id $revision_id
+ -item_id $item_id -revision_id $revision_id \
+ -initialize $initialize
$object destroy_on_cleanup
}
return $object
@@ -533,7 +553,7 @@
my get_context package_id creation_user creation_ip
#my log "ID [self] create $args"
if {[catch {set p [my create ::0 {*}$args]} errorMsg]} {
- my log "Error: $errorMsg, $::errorInfo"
+ ad_log error $errorMsg
}
#my log "ID [::0 serialize]"
set item_id [::0 save_new \
@@ -620,7 +640,9 @@
lappend cond "coalesce(ci.live_revision,ci.latest_revision) = bt.revision_id"
if {$parent_id ne ""} {
if {$with_children} {
- lappend cond "ci.parent_id in (select $parent_id from dual union select item_id from cr_items where parent_id = $parent_id)"
+ append from_clause ", (select $parent_id as item_id from dual union \
+ select item_id from cr_items where parent_id = $parent_id) children"
+ lappend cond "ci.parent_id = children.item_id"
} else {
lappend cond "ci.parent_id = $parent_id"
}
@@ -654,6 +676,7 @@
{-page_size 20}
{-page_number ""}
{-base_table "cr_revisions"}
+ {-initialize true}
} {
Returns a set (ordered composite) of the answer tuples of
an 'instance_select_query' with the same attributes.
@@ -671,7 +694,8 @@
-page_size $page_size \
-page_number $page_number \
-base_table $base_table \
- ]]
+ ] \
+ -initialize $initialize]
return $s
}
@@ -892,7 +916,7 @@
#my instvar creation_user
set __atts [list creation_user]
set __vars $__atts
-
+
# The modifying_user is not maintained by the CR (bug?)
# xotcl-core handles this by having the modifying user as
# creation_user of the revision.
@@ -918,11 +942,28 @@
lappend __vars $__slot_name
}
+ if {$use_given_publish_date} {
+ if {"publish_date" ni $__atts} {
+ my instvar publish_date
+ lappend __atts publish_date
+ lappend __vars publish_date
+ }
+ set publish_date_flag [list -publish_date $publish_date]
+ } else {
+ set publish_date_flag ""
+ }
+
::xo::dc transaction {
[my info class] instvar storage_type
set revision_id [xo::dc nextval acs_object_id_seq]
if {$storage_type eq "file"} {
- my instvar import_file
+ my instvar import_file mime_type name
+ # Get the mime_type from the file, eventually creating a new
+ # one if it's unrecognized.
+ set mime_type [cr_check_mime_type \
+ -mime_type $mime_type \
+ -filename $name \
+ -file $import_file]
set text [cr_create_content_file $item_id $revision_id $import_file]
}
::xo::dc [::xo::dc insert-view-operation] revision_add \
@@ -931,17 +972,15 @@
my fix_content $revision_id $text
if {$live_p} {
- ::xo::db::sql::content_item set_live_revision \
- -revision_id $revision_id \
- -publish_status [my set publish_status]
#
- # set_live revision updates publish_date to the current date.
- # In order to keep a given publish date, we have to update the
- # field manually.
+ # Update the life revision with the publish status and
+ # optionally the publish_date
#
- if {$use_given_publish_date} {
- my update_revision $revision_id publish_date [my publish_date]
- }
+ ::xo::db::sql::content_item set_live_revision \
+ -revision_id $revision_id \
+ -publish_status [my set publish_status] \
+ -is_latest true \
+ {*}$publish_date_flag
my set revision_id $revision_id
my update_item_index
} else {
@@ -956,34 +995,20 @@
return $item_id
}
- if {[apm_version_names_compare [ad_acs_version] 5.2] > -1} {
- ns_log notice "--OpenACS Version 5.2 or newer [ad_acs_version]"
- CrItem set content_item__new_args {
- -name $name -parent_id $parent_id -creation_user $creation_user \
- -creation_ip $creation_ip \
- -item_subtype "content_item" -content_type $object_type \
- -description $description -mime_type $mime_type -nls_language $nls_language \
- -is_live f -storage_type $storage_type -package_id $package_id
- }
- } else {
- ns_log notice "--OpenACS Version 5.1 or older [ad_acs_version]"
- CrItem set content_item__new_args {
- -name $name -parent_id $parent_id -creation_user $creation_user \
- -creation_ip $creation_ip \
- -item_subtype "content_item" -content_type $object_type \
- -description $description -mime_type $mime_type -nls_language $nls_language \
- -is_live f -storage_type $storage_type
- }
- }
-
- CrItem ad_instproc set_live_revision {-revision_id:required {-publish_status "ready"}} {
+ CrItem ad_instproc set_live_revision {
+ -revision_id:required
+ {-publish_status "ready"}
+ {-is_latest:boolean false}
+ } {
@param revision_id
@param publish_status one of 'live', 'ready' or 'production'
} {
::xo::db::sql::content_item set_live_revision \
-revision_id $revision_id \
- -publish_status $publish_status
+ -publish_status $publish_status \
+ -is_latest $is_latest
::xo::clusterwide ns_cache flush xotcl_object_cache ::[my item_id]
+ ::xo::clusterwide ns_cache flush xotcl_object_cache ::$revision_id
}
CrItem ad_instproc update_item_index {} {
@@ -1005,8 +1030,10 @@
@param creation_user user_id if the creating user
@param live_p make this revision the live revision
} {
+
set __class [my info class]
my instvar parent_id item_id import_file name
+
if {![info exists package_id] && [my exists package_id]} {
set package_id [my package_id]
}
@@ -1028,6 +1055,17 @@
lappend __atts [$__slot column_name]
lappend __vars $__slot_name
}
+
+ if {$use_given_publish_date} {
+ if {"publish_date" ni $__atts} {
+ my instvar publish_date
+ lappend __atts publish_date
+ lappend __vars publish_date
+ }
+ set publish_date_flag [list -publish_date $publish_date]
+ } else {
+ set publish_date_flag ""
+ }
::xo::dc transaction {
$__class instvar storage_type object_type
@@ -1044,10 +1082,32 @@
set title [expr {[my exists __title_prefix] ?
"[my set __title_prefix] ($name)" : $name}]
}
- #my msg --[subst [[self class] set content_item__new_args]]
- set item_id [eval ::xo::db::sql::content_item new \
- [[self class] set content_item__new_args]]
+
if {$storage_type eq "file"} {
+ # Get the mime_type from the file, eventually creating a new
+ # one if it's unrecognized.
+ set mime_type [cr_check_mime_type \
+ -mime_type $mime_type \
+ -filename $name \
+ -file $import_file]
+ }
+
+ set item_id [::xo::db::sql::content_item new \
+ -name $name \
+ -parent_id $parent_id \
+ -creation_user $creation_user \
+ -creation_ip $creation_ip \
+ -item_subtype "content_item" \
+ -content_type $object_type \
+ -description $description \
+ -mime_type $mime_type \
+ -nls_language $nls_language \
+ -is_live f \
+ -storage_type $storage_type \
+ -package_id $package_id \
+ -with_child_rels f]
+
+ if {$storage_type eq "file"} {
set text [cr_create_content_file $item_id $revision_id $import_file]
}
@@ -1056,12 +1116,15 @@
my fix_content $revision_id $text
if {$live_p} {
+ #
+ # Update the life revision with the publish status and
+ # optionally the publish_date
+ #
::xo::db::sql::content_item set_live_revision \
-revision_id $revision_id \
- -publish_status [my set publish_status]
- if {$use_given_publish_date} {
- my update_revision $revision_id publish_date [my publish_date]
- }
+ -publish_status [my set publish_status] \
+ -is_latest true \
+ {*}$publish_date_flag
my update_item_index
}
}
@@ -1088,14 +1151,26 @@
my instvar item_id
::xo::dc dml update_rename \
"update cr_items set name = :new_name where item_id = :item_id"
+ my set name $new_name
my update_item_index
}
- CrItem instproc revisions {} {
+ #
+ # The method "changed_redirect_url" is a helper method for old-style
+ # wiki pages, still using ad_form. Form.edit_data calls this method
+ # after a rename operation to optionally redirect the browser after
+ # the edit operation to the new url, unless an explicit return_url
+ # was specified.
+ #
+ CrItem instproc changed_redirect_url {} {
+ return ""
+ }
+ CrItem instproc www-revisions {} {
+
set isAdmin [acs_user::site_wide_admin_p]
- ::TableWidget t1 -volatile \
+ ::TableWidget create t1 -volatile \
-columns {
Field version_number -label "" -html {align right}
ImageAnchorField edit -label "" -src /resources/acs-subsite/Zoom16.gif \
@@ -1131,10 +1206,7 @@
content_revision__get_number(r.revision_id) as version_number " \
-from "cr_items ci, cr_revisions r, acs_objects o" \
-where "ci.item_id = :page_id and r.item_id = ci.item_id and o.object_id = r.revision_id
- and exists (select 1 from acs_object_party_privilege_map m
- where m.object_id = r.revision_id
- and m.party_id = :user_id
- and m.privilege = 'read')" \
+ and acs_permission__permission_p(r.revision_id, :user_id, 'read')" \
-orderby "r.revision_id desc"]
::xo::dc foreach revisions_select $sql {
@@ -1278,7 +1350,7 @@
#
# We should provide either a minimal parameter page for this
# purposes, or - more conservative - provide simply package
- # parameters for this. The only thing we are loosing are "computed
+ # parameters for this. The only thing we are losing are "computed
# parameters", what most probably no-one uses. The delegation based
# parameters are most probably good replacement to manage such
# parameters site-wide.
@@ -1377,6 +1449,7 @@
::xo::db::CrFolder ad_proc get_instance_from_db {
{-item_id 0}
{-revision_id 0}
+ {-initialize:boolean true}
} {
The "standard" get_instance_from_db methods return objects following the
naming convention "::