Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -r1.472 -r1.473 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 12 Aug 2013 19:46:50 -0000 1.472 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 27 Oct 2014 16:42:05 -0000 1.473 @@ -1,9 +1,9 @@ ::xo::library doc { - XoWiki - main library classes and objects + XoWiki - main library classes and objects - @creation-date 2006-01-10 - @author Gustaf Neumann - @cvs-id $Id$ + @creation-date 2006-01-10 + @author Gustaf Neumann + @cvs-id $Id$ } namespace eval ::xowiki { @@ -15,33 +15,37 @@ -table_name "xowiki_page" -id_column "page_id" \ -mime_type text/html \ -slots { - ::xo::db::CrAttribute create page_order \ - -sqltype ltree -validator page_order -default "" + ::xo::db::CrAttribute create page_order \ + -sqltype ltree -validator page_order -default "" ::xo::db::CrAttribute create creator - # The following slots are defined elsewhere, but we override - # some default values, such as pretty_names, required state, - # help text etc. - ::xo::Attribute create name \ - -help_text #xowiki.Page-name-help_text# \ - -validator name \ - -spec "maxlength=400,required" \ - -required false ;#true - ::xo::Attribute create title \ - -required false ;#true - ::xo::Attribute create description \ - -spec "textarea,cols=80,rows=2" - ::xo::Attribute create text \ - -spec "richtext" - ::xo::Attribute create nls_language \ - -spec {select,options=[xowiki::locales]} \ + # The following slots are defined elsewhere, but we override + # some default values, such as pretty_names, required state, + # help text etc. + ::xo::Attribute create name \ + -help_text #xowiki.Page-name-help_text# \ + -validator name \ + -spec "maxlength=400,required" \ + -required false ;#true + #::xo::Attribute create title \ + # -required false ;#true + #::xo::Attribute create description \ + # -spec "textarea,cols=80,rows=2" + #::xo::Attribute create text \ + # -spec "richtext" + ::xo::Attribute create nls_language \ + -spec {select,options=[xowiki::locales]} \ -default [ad_conn locale] - ::xo::Attribute create publish_date \ - -spec date - ::xo::Attribute create last_modified \ - -spec date - ::xo::Attribute create creation_user \ - -spec user_id + #::xo::Attribute create publish_date \ + # -spec date + ::xo::Attribute create last_modified \ + -spec date + ::xo::Attribute create creation_user \ + -spec user_id } \ + -extend_slot {title -required false} \ + -extend_slot {description -spec "textarea,cols=80,rows=2"} \ + -extend_slot {text -spec "richtext"} \ + -extend_slot {publish_date -spec "date"} \ -parameter { {render_adp 1} {do_substitutions 1} @@ -51,7 +55,7 @@ if {$::xotcl::version < 1.5} { ::xowiki::Page log "Error: at least, XOTcl 1.5 is required.\ - You seem to use XOTcl $::xotcl::version !!!" + You seem to use XOTcl $::xotcl::version !!!" } ::xo::db::CrClass create PlainPage -superclass Page \ @@ -70,15 +74,15 @@ -pretty_name "#xowiki.PodcastItem_pretty_name#" -pretty_plural "#xowiki.PodcastItem_pretty_plural#" \ -table_name "xowiki_podcast_item" -id_column "podcast_item_id" \ -slots { - ::xo::db::CrAttribute create pub_date \ - -datatype date \ - -sqltype timestamp \ - -spec "date,format=YYYY_MM_DD_HH24_MI" - ::xo::db::CrAttribute create duration \ - -help_text "#xowiki.PodcastItem-duration-help_text#" - ::xo::db::CrAttribute create subtitle - ::xo::db::CrAttribute create keywords \ - -help_text "#xowiki.PodcastItem-keywords-help_text#" + ::xo::db::CrAttribute create pub_date \ + -datatype date \ + -sqltype timestamp \ + -spec "date,format=YYYY_MM_DD_HH24_MI" + ::xo::db::CrAttribute create duration \ + -help_text "#xowiki.PodcastItem-duration-help_text#" + ::xo::db::CrAttribute create subtitle + ::xo::db::CrAttribute create keywords \ + -help_text "#xowiki.PodcastItem-keywords-help_text#" } \ -storage_type file \ -form ::xowiki::PodcastForm @@ -88,7 +92,7 @@ -table_name "xowiki_page_template" -id_column "page_template_id" \ -slots { ::xo::db::CrAttribute create anon_instances \ - -datatype boolean \ + -datatype boolean \ -sqltype boolean -default "f" } \ -form ::xowiki::PageTemplateForm @@ -99,10 +103,10 @@ -slots { ::xo::db::CrAttribute create page_template \ -datatype integer \ - -references cr_items(item_id) + -references "cr_items(item_id) ON DELETE CASCADE" ::xo::db::CrAttribute create instance_attributes \ -sqltype long_text \ - -default "" + -default "" } \ -form ::xowiki::PageInstanceForm \ -edit_form ::xowiki::PageInstanceEditForm @@ -119,12 +123,12 @@ -slots { ::xo::db::CrAttribute create form \ -sqltype long_text \ - -default "" + -default "" ::xo::db::CrAttribute create form_constraints \ -sqltype long_text \ - -default "" \ + -default "" \ -validator form_constraints \ - -spec "textarea,cols=100,rows=5" + -spec "textarea,cols=100,rows=5" } \ -form ::xowiki::FormForm @@ -134,7 +138,7 @@ -slots { ::xo::db::CrAttribute create assignee \ -datatype integer \ - -references parties(party_id) \ + -references parties(party_id) \ -spec "hidden" ::xo::db::CrAttribute create state -default "" } @@ -144,45 +148,49 @@ ::xo::db::require index -table xowiki_form_page -col assignee ::xo::db::require index -table xowiki_page_instance -col page_template - ::xo::db::require table xowiki_references \ - "reference integer references cr_items(item_id) on delete cascade, - link_type [::xo::db::sql map_datatype text], - page integer references cr_items(item_id) on delete cascade" + ::xo::db::require table xowiki_references [subst { + reference {integer references cr_items(item_id) on delete cascade} + link_type {[::xo::dc map_datatype text]} + page {integer references cr_items(item_id) on delete cascade} + }] ::xo::db::require index -table xowiki_references -col reference - ::xo::db::require table xowiki_last_visited \ - "page_id integer references cr_items(item_id) on delete cascade, - package_id integer, - user_id integer, - count integer, - time timestamp" + ::xo::db::require table xowiki_last_visited { + page_id {integer references cr_items(item_id) on delete cascade} + package_id integer + user_id integer + count integer + time timestamp + } + ::xo::db::require index -table xowiki_last_visited -col user_id,page_id -unique true ::xo::db::require index -table xowiki_last_visited -col user_id,package_id ::xo::db::require index -table xowiki_last_visited -col time # Oracle has a limit of 3118 characters for keys, therefore we # cannot use "text" as type for "tag" - ::xo::db::require table xowiki_tags \ - "item_id integer references cr_items(item_id) on delete cascade, - package_id integer, - user_id integer references users(user_id), - tag varchar(3000), - time timestamp" + ::xo::db::require table xowiki_tags { + item_id {integer references cr_items(item_id) on delete cascade} + package_id integer + user_id {integer references users(user_id)} + tag varchar(3000) + time timestamp + } ::xo::db::require index -table xowiki_tags -col user_id,item_id ::xo::db::require index -table xowiki_tags -col tag,package_id ::xo::db::require index -table xowiki_tags -col user_id,package_id ::xo::db::require index -table xowiki_tags -col package_id ::xo::db::require index -table xowiki_page -col page_order \ - -using [expr {[::xo::db::has_ltree] ? "gist" : ""}] + -using [expr {[::xo::dc has_ltree] ? "gist" : ""}] set sortkeys [expr {[db_driverkey ""] eq "oracle" ? "" : ", ci.tree_sortkey, ci.max_child_sortkey"}] ::xo::db::require view xowiki_page_live_revision \ "select p.*, cr.*,ci.parent_id, ci.name, ci.locale, ci.live_revision, \ - ci.latest_revision, ci.publish_status, ci.content_type, ci.storage_type, \ - ci.storage_area_key $sortkeys \ + ci.latest_revision, ci.publish_status, ci.content_type, ci.storage_type, \ + ci.storage_area_key $sortkeys \ from xowiki_page p, cr_items ci, cr_revisions cr \ where p.page_id = ci.live_revision \ and p.page_id = cr.revision_id \ @@ -204,18 +212,19 @@ # number of sequences (in PostgresSQL or Oracle), the database # dependencies would be larger than in this simple approach. # - ::xo::db::require table xowiki_autonames \ - "parent_id integer references acs_objects(object_id) ON DELETE CASCADE, - name varchar(3000), - count integer" + ::xo::db::require table xowiki_autonames { + parent_id "integer references acs_objects(object_id) ON DELETE CASCADE" + name varchar(3000) + count integer + } ::xo::db::require index -table xowiki_autonames -col parent_id,name -unique true ::xotcl::Object create autoname autoname proc generate {-parent_id -name} { - db_transaction { - set already_recorded [::xo::db_0or1row autoname_query { - select count from xowiki_autonames - where parent_id = :parent_id and name = :name}] + ::xo::dc transaction { + set already_recorded [::xo::dc 0or1row autoname_query { + select count from xowiki_autonames + where parent_id = :parent_id and name = :name}] if {$already_recorded} { incr count @@ -241,7 +250,7 @@ autoname proc new {-parent_id -name} { while {1} { set generated_name [my generate -parent_id $parent_id -name $name] - if {[::xo::db::CrClass lookup -name $generated_name -parent_id $parent_id] eq 0} { + if {[::xo::db::CrClass lookup -name $generated_name -parent_id $parent_id] eq "0"} { return $generated_name } } @@ -257,7 +266,12 @@ # if {[catch {ns_cache flush xowiki_cache NOTHING}]} { ns_log notice "xotcl-core: creating xowiki cache" - ns_cache create xowiki_cache -size 200000 + + ns_cache create xowiki_cache \ + -size [parameter::get_global_value \ + -package_key xowiki \ + -parameter CacheSize \ + -default 400000] } ############################# @@ -291,7 +305,7 @@ # # Page marshall/demarshall # - Page instproc marshall {} { + Page instproc marshall {{-mode export}} { my instvar name my unset_temporary_instance_variables set old_creation_user [my creation_user] @@ -321,9 +335,13 @@ return $content } - File instproc marshall {} { + File instproc marshall {{-mode export}} { set fn [my full_file_name] - my set __file_content [::base64::encode [::xowiki::read_file $fn]] + if {$mode eq "export"} { + my set __file_content [::base64::encode [::xowiki::read_file $fn]] + } else { + my set __file_name $fn + } next } @@ -344,7 +362,7 @@ set categories [list] if {[my exists __category_map]} {array set cm [my set __category_map]} foreach category [::xowiki::Category get_category_infos -tree_id $tree_id] { - foreach {category_id category_name deprecated_p level} $category break + lassign $category category_id category_name deprecated_p level lappend categories $level $category_name set names($level) $category_name set node_name $tree_name @@ -384,6 +402,8 @@ } elseif {[$f exists is_party_id]} { #my msg "page [my name] field [$f name] is a party_id" set cm([$f name]) [list party_id $multiple] + } elseif {[$f istype "::xowiki::formfield::file"]} { + set cm([$f name]) [list file 0] } } if {[array exists cm]} { @@ -414,7 +434,7 @@ # # build reverse category_map foreach category [::xowiki::Category get_category_infos -tree_id $tree_id] { - foreach {category_id category_name deprecated_p level} $category break + lassign $category category_id category_name deprecated_p level lappend categories $level $category_name set names($level) $category_name set node_name $name @@ -427,9 +447,9 @@ } - Form instproc marshall {} { + Form instproc marshall {{-mode export}} { #set form_fields [my create_form_fields_from_form_constraints \ - # [my get_form_constraints]] + # [my get_form_constraints]] #my log "--ff=$form_fields" #my build_instance_attribute_map $form_fields next @@ -456,12 +476,22 @@ # map a party_id # return [my map_party -property $map_type $value] + } elseif {$map_type eq "file" && [llength $value] % 2 == 0} { + # + # drop revision_id from file value + # + set result {} + foreach {a v} $value { + if {$a eq "revision_id"} continue + lappend result $a $v + } + return $result } else { return $value } } - FormPage instproc marshall {} { + FormPage instproc marshall {{-mode export}} { # # Handle mapping from IDs to symbolic representations in # form-field values. We perform the mapping on xowiki::FormPages @@ -473,6 +503,9 @@ # necessary to move e.g. category definitions into the global form # constraints. # + if {$mode eq "copy" && ![string match "*revision_id*" [my set instance_attributes]]} { + return [next] + } set form_fields [my create_form_fields_from_form_constraints \ [my get_form_constraints]] my build_instance_attribute_map $form_fields @@ -487,15 +520,14 @@ # my log "+++ we have an instance_attribute_map for [my name]" # my log "+++ starting with instance_attributes [my instance_attributes]" array set use [my set __instance_attribute_map] - array set multiple_index [list category 2 party_id 1] + array set multiple_index [list category 2 party_id 1 file 1] set ia [list] foreach {name value} [my instance_attributes] { #my log "marshall check $name $value [info exists use($name)]" if {[info exists use($name)]} { set map_type [lindex $use($name) 0] set multiple [lindex $use($name) $multiple_index($map_type)] - #my log "+++ marshall check $name $value m=?$multiple" - + #my log "+++ marshall check $name $value use <$use($name)> m=?$multiple" if {$multiple} { lappend ia $name [my map_values $map_type $value] } else { @@ -526,21 +558,21 @@ if {![catch {acs_user::get -user_id $party_id -array info}]} { set result [list] foreach a {username email first_names last_name screen_name url} { - lappend result $a $info($a) + lappend result $a $info($a) } ns_log notice "-- map_party $party_id: $result" return $result } if {![catch {group::get -group_id $party_id -array info}]} { - ns_log notice "got group info: [array get info]" - set result [array get info] - set members {} - foreach member_id [group::get_members -group_id $party_id] { - lappend members [my map_party -property $property $member_id] - } - lappend result members $members - ns_log notice "-- map_party $party_id: $result" - return $result + ns_log notice "got group info: [array get info]" + set result [array get info] + set members {} + foreach member_id [group::get_members -group_id $party_id] { + lappend members [my map_party -property $property $member_id] + } + lappend result members $members + ns_log notice "-- map_party $party_id: $result" + return $result } ns_log warning "Cannot map party_id $party_id, probably not a user; property $property lost during export" return {} @@ -566,27 +598,27 @@ if {$create_user_ids} { if {[info exists (group_name)] && $(group_name) ne ""} { - my log "+++ create a new group group_name=$(group_name)" - set group_id [group::new -group_name $(group_name)] - array set info [list join_policy $(join_policy)] - group::update -group_id $group_id -array info - ns_log notice "+++ reverse_party_map: we could add members $(members) - but we don't" - return $group_id + my log "+++ create a new group group_name=$(group_name)" + set group_id [group::new -group_name $(group_name)] + array set info [list join_policy $(join_policy)] + group::update -group_id $group_id -array info + ns_log notice "+++ reverse_party_map: we could add members $(members) - but we don't" + return $group_id } else { - my log "+++ create a new user username=$(username), email=$(email)" - array set status [auth::create_user -username $(username) -email $(email) \ - -first_names $(first_names) -last_name $(last_name) \ - -screen_name $(screen_name) -url $(url)] - if {$status(creation_status) eq "ok"} { - return $status(user_id) - } - my log "+++ create user username=${username}, email=$(email) failed, reason=$status(creation_status)" + my log "+++ create a new user username=$(username), email=$(email)" + array set status [auth::create_user -username $(username) -email $(email) \ + -first_names $(first_names) -last_name $(last_name) \ + -screen_name $(screen_name) -url $(url)] + if {$status(creation_status) eq "ok"} { + return $status(user_id) + } + my log "+++ create user username=${username}, email=$(email) failed, reason=$status(creation_status)" } } return $default_party } - + Page instproc reverse_map_party_attribute {-attribute {-default_party 0} {-create_user_ids 0}} { if {![my exists $attribute]} { my set $attribute $default_party @@ -633,11 +665,20 @@ File instproc demarshall {args} { next # we have to care about recoding the file content - my instvar import_file __file_content - set import_file [ns_tmpnam] - ::xowiki::write_file $import_file [::base64::decode $__file_content] - catch {my unset full_file_name} - unset __file_content + + if {[my exists __file_content]} { + my instvar import_file __file_content + set import_file [ad_tmpnam] + ::xowiki::write_file $import_file [::base64::decode $__file_content] + catch {my unset full_file_name} + unset __file_content + } elseif {[my exists __file_name]} { + my instvar import_file __file_name + set import_file $__file_name + unset __file_name + } else { + error "either __file_content or __file_name must be set" + } } # set default values. @@ -666,8 +707,8 @@ set mapped_values [list] foreach value $values { lappend mapped_values [my reverse_map_value \ - -creation_user $creation_user -create_user_ids $create_user_ids \ - $map_type $value category_ids] + -creation_user $creation_user -create_user_ids $create_user_ids \ + $map_type $value category_ids] } return $mapped_values } @@ -690,8 +731,8 @@ return "" } else { my msg "cannot map value '$value' (map_type $map_type)\ - of [my name] to an ID; maybe there is some\ - same_named category tree with less entries..." + of [my name] to an ID; maybe there is some\ + same_named category tree with less entries..." my msg "reverse category map has values [lsort [array names ::__xowiki_reverse_category_map]]" return "" } @@ -717,22 +758,22 @@ # set ia [list] array set use [my set __instance_attribute_map] - array set multiple_index [list category 2 party_id 1] + array set multiple_index [list category 2 party_id 1 file 1] foreach {name value} [my instance_attributes] { #my msg "use($name) --> [info exists use($name)]" if {[info exists use($name)]} { - #my msg "try to map value '$value' (category tree: $use($name))" + #my msg "try to map value '$value' (category tree: $use($name))" set map_type [lindex $use($name) 0] set multiple [lindex $use($name) $multiple_index($map_type)] if {$multiple eq ""} {set multiple 1} if {$multiple} { lappend ia $name [my reverse_map_values \ - -creation_user $creation_user -create_user_ids $create_user_ids \ - $map_type $value category_ids] + -creation_user $creation_user -create_user_ids $create_user_ids \ + $map_type $value category_ids] } else { lappend ia $name [my reverse_map_value \ - -creation_user $creation_user -create_user_ids $create_user_ids \ - $map_type $value category_ids] + -creation_user $creation_user -create_user_ids $create_user_ids \ + $map_type $value category_ids] } } else { # nothing to map @@ -837,20 +878,20 @@ # Page proc save_tags { - -package_id:required - -item_id:required - -revision_id:required - -user_id:required - tags - } { - db_dml [my qn delete_tags] \ - "delete from xowiki_tags where item_id = $item_id and user_id = $user_id" + -package_id:required + -item_id:required + -revision_id:required + -user_id:required + tags + } { + ::xo::dc dml [my qn delete_tags] \ + "delete from xowiki_tags where item_id = :item_id and user_id = :user_id" foreach tag [split $tags " ,;"] { if {$tag ne ""} { - db_dml [my qn insert_tag] \ - "insert into xowiki_tags (item_id,package_id, user_id, tag, time) \ - values ($item_id, $package_id, $user_id, :tag, current_timestamp)" + ::xo::dc dml [my qn insert_tag] \ + "insert into xowiki_tags (item_id,package_id, user_id, tag, time) \ + values (:item_id, :package_id, :user_id, :tag, now())" } } search::queue -object_id $revision_id -event UPDATE @@ -860,30 +901,30 @@ if {[info exists item_id]} { if {[info exists user_id]} { # tags for item and user - set tags [::xo::db_list get_tags { - SELECT distinct tag from xowiki_tags - where user_id = :user_id and item_id = :item_id and package_id = :package_id - }] + set tags [::xo::dc list get_tags { + SELECT distinct tag from xowiki_tags + where user_id = :user_id and item_id = :item_id and package_id = :package_id + }] } else { # all tags for this item - set tags [::xo::db_list get_tags { - SELECT distinct tag from xowiki_tags - where item_id = :item_id and package_id = :package_id - }] + set tags [::xo::dc list get_tags { + SELECT distinct tag from xowiki_tags + where item_id = :item_id and package_id = :package_id + }] } } else { if {[info exists user_id]} { # all tags for this user - set tags [::xo::db_list get_tags { - SELECT distinct tag from xowiki_tags - where user_id = :user_id and package_id :package_id - }] + set tags [::xo::dc list get_tags { + SELECT distinct tag from xowiki_tags + where user_id = :user_id and package_id :package_id + }] } else { # all tags for the package - set tags [::xo::db_list get_tags { - SELECT distinct tag from xowiki_tags - where package_id = :package_id - }] + set tags [::xo::dc list get_tags { + SELECT distinct tag from xowiki_tags + where package_id = :package_id + }] } } join $tags " " @@ -899,17 +940,17 @@ Page instforward form_parameter {%my set package_id} %proc Page instforward exists_form_parameter {%my set package_id} %proc -# Page instproc init {} { -# my log "--W " -# ::xo::show_stack -# next -# } + # Page instproc init {} { + # my log "--W " + # ::xo::show_stack + # next + # } -# Page instproc destroy {} { -# my log "--W " -# ::xo::show_stack -# next -# } + # Page instproc destroy {} { + # my log "--W " + # ::xo::show_stack + # next + # } # # check certain properties of a page (is_* methods) @@ -989,9 +1030,9 @@ FormPage instproc compute_link_properties {item_ref} { my instvar package_id set page [$package_id get_page_from_item_ref \ - -default_lang [my lang] \ - -parent_id [my parent_id] \ - $item_ref] + -default_lang [my lang] \ + -parent_id [my parent_id] \ + $item_ref] if {$page ne ""} { set item_id [$page item_id] set link_type [expr {[$page is_folder_page] ? "folder_link" : "link"}] @@ -1091,8 +1132,8 @@ foreach att {item package parent} { set name physical_${att}_id if {[my exists $name]} { - my set ${att}_id [my set $name] - my unset $name + my set ${att}_id [my set $name] + my unset $name } } } @@ -1121,22 +1162,22 @@ set page [self] while {1} { if {[$page istype ::xowiki::FormPage]} { - if {[$page is_folder_page]} break + if {[$page is_folder_page]} break -# set page_template [$page page_template] -# set page_template_name [$page_template name] -# # search the page_template in the list of form_ids -# if {[lsearch $folder_form_ids $page_template] > -1} { -# break -# } elseif {$page_template_name eq "en:folder.form"} { -# # safety belt, in case we have in different directories -# # diffenent en:folder.form -# break -# } elseif {$page_template_name eq "en:link.form"} { -# set fp [my is_folder_page] -# my msg fp=$fp -# break -# } + # set page_template [$page page_template] + # set page_template_name [$page_template name] + # # search the page_template in the list of form_ids + # if {$page_template in $folder_form_ids} { + # break + # } elseif {$page_template_name eq "en:folder.form"} { + # # safety belt, in case we have in different directories + # # diffenent en:folder.form + # break + # } elseif {$page_template_name eq "en:link.form"} { + # set fp [my is_folder_page] + # my msg fp=$fp + # break + # } } set page [::xo::db::CrClass get_instance_from_db -item_id [$page parent_id]] } @@ -1146,13 +1187,39 @@ # # save / restore # + + Page instproc can_contain {obj} { + # + # This is a stub which can / should be refined in applications, + # which want to disallow pages (e.g. folders) to be parent of some + # kind of content. The function should return 0 if some content is + # not allowed. + # + return 1 + } + + Page instproc can_save {} { + # + # Determine the parent object of the page to be saved. If the + # parent object is an page as well, then call can_contain. The + # function is just determining a boolen value shuch it can be used + # for testing insertability as well. + # + set parent [my get_parent_object] + if {$parent ne "" && [$parent istype ::xowiki::Page]} { + return [$parent can_contain [self]] + } + return 1 + } Page instproc save args { + if {![my can_save]} {error "can't save this page under this parent"} [my package_id] flush_page_fragment_cache next } Page instproc save_new args { + if {![my can_save]} {error "can't save this page under this parent"} [my package_id] flush_page_fragment_cache next } @@ -1167,6 +1234,21 @@ # misc # + Page instproc get_parent_object {} { + # + # Obtain the parent object for a page. If the parent page is a + # dummy entry or not an object, return empty. + # + set parent_id [my set parent_id] + if {$parent_id > 0} { + if {! [my isobject ::$parent_id] } { + ::xo::db::CrClass get_instance_from_db -item_id $parent_id + } + return ::$parent_id + } + return "" + } + Page instproc get_instance_attributes {} { if {[my exists instance_attributes]} { return [my set instance_attributes] @@ -1231,27 +1313,27 @@ if {[my isclass ::xowiki::includelet::$page_name]} { # direct call, without page, not tailorable set page [::xowiki::includelet::$page_name new \ - -package_id $package_id \ - -name $page_name \ + -package_id $package_id \ + -name $page_name \ -locale [::xo::cc locale] \ - -actual_query [::xo::cc actual_query]] + -actual_query [::xo::cc actual_query]] } else { # # Include a wiki page, tailorable. # #set page [my resolve_included_page_name $page_name] set page [$package_id get_page_from_item_ref \ - -use_package_path true \ - -use_site_wide_pages true \ - -use_prototype_pages true \ - -default_lang [my lang] \ - -parent_id [my parent_id] $page_name] + -use_package_path true \ + -use_site_wide_pages true \ + -use_prototype_pages true \ + -default_lang [my lang] \ + -parent_id [my parent_id] $page_name] if {$page ne "" && ![$page exists __decoration]} { - # - # we use as default decoration for included pages - # the "portlet" decoration - # + # + # we use as default decoration for included pages + # the "portlet" decoration + # $page set __decoration [$package_id get_parameter default-portlet-decoration portlet] } } @@ -1305,10 +1387,10 @@ return $html } -# Page instproc include_portlet {arg} { -# my log "+++ method [self proc] of [self class] is deprecated" -# return [my include $arg] -# } + # Page instproc include_portlet {arg} { + # my log "+++ method [self proc] of [self class] is deprecated" + # return [my include $arg] + # } Page ad_instproc include {-configure arg} { Include the html of the includelet. The method generates @@ -1346,10 +1428,10 @@ # if {[string match "admin/*" $adp_fn]} { set allowed [::xo::cc permission \ - -object_id [my package_id] -privilege admin \ - -party_id [::xo::cc user_id]] + -object_id [my package_id] -privilege admin \ + -party_id [::xo::cc user_id]] if {!$allowed} { - return [list allowed $allowed msg "Page can only be included by an admin!" fn ""] + return [list allowed $allowed msg "Page can only be included by an admin!" fn ""] } } if {[string match "/*" $adp_fn] || [string match "../*" $adp_fn]} { @@ -1406,7 +1488,7 @@ set ::template::parse_level $including_page_level incr ::xowiki_inclusion_depth -1 return [my error_in_includelet $arg \ - [_ xowiki.error-includelet-error_during_adp_evaluation]] + [_ xowiki.error-includelet-error_during_adp_evaluation]] } return $page$ch2 @@ -1423,8 +1505,8 @@ if {$arg eq "content"} { return "
" } elseif {[string match "left-col*" $arg] \ - || [string match "right-col*" $arg] \ - || $arg eq "sidebar"} { + || [string match "right-col*" $arg] \ + || $arg eq "sidebar"} { return "
" } elseif {$arg eq "box"} { return "
" @@ -1497,9 +1579,9 @@ Page instproc detail_link {} { if {[my exists instance_attributes]} { - array set __ia [my set instance_attributes] - if {[info exists __ia(detail_link)] && $__ia(detail_link) ne ""} { - return $__ia(detail_link) + set __ia [my set instance_attributes] + if {[dict exists $__ia detail_link] && [dict get $__ia detail_link] ne ""} { + return [dict get $__ia detail_link] } } return [my pretty_link] @@ -1525,25 +1607,25 @@ # a direct treatment. Javascript and CSS files are # included, images are rendered directly. # - switch -glob -- [::xowiki::guesstype $link] { - text/css { - ::xo::Page requireCSS $link - return "" - } - application/x-javascript { - ::xo::Page requireJS $link - return "" - } - image/* { - Link create [self]::link \ - -page [self] \ + switch -glob -- [::xowiki::guesstype $link] { + text/css { + ::xo::Page requireCSS $link + return "" + } + application/x-javascript { + ::xo::Page requireJS $link + return "" + } + image/* { + Link create [self]::link \ + -page [self] \ -name "" \ - -type localimage [list -label $label] \ - -href $link - [self]::link configure {*}$options - return [self]::link - } - } + -type localimage [list -label $label] \ + -href $link + [self]::link configure {*}$options + return [self]::link + } + } } set l [ExternalLink new [list -label $label] -href $link] $l configure {*}$options @@ -1555,7 +1637,7 @@ # ## do we have a typed link? prefix has more than two chars... # if {[regexp {^([^:/?][^:/?][^:/?]+):((..):)?(.+)$} $link _ \ - # link_type _ lang stripped_name]} { + # link_type _ lang stripped_name]} { # set name file:$stripped_name # } @@ -1570,17 +1652,17 @@ if {[regexp {^:(..):(.+)$} $(link) _ lang stripped_name]} { # language link (it starts with a ':') array set "" [$package_id item_ref \ - -use_package_path $use_package_path \ - -default_lang [my lang] \ - -parent_id $parent_id \ + -use_package_path $use_package_path \ + -default_lang [my lang] \ + -parent_id $parent_id \ ${lang}:$stripped_name] set (link_type) language } else { regsub {^[.]SELF[.]/} $(link) [my name]/ (link) array set "" [$package_id item_ref \ - -use_package_path $use_package_path \ - -default_lang [my lang] \ - -parent_id $parent_id \ + -use_package_path $use_package_path \ + -default_lang [my lang] \ + -parent_id $parent_id \ $(link)] } #my msg "link '$(link)' => [array get {}]" @@ -1591,7 +1673,7 @@ Link create [self]::link \ -page [self] -form $(form) \ -type $(link_type) [list -name $item_name] -lang $(prefix) \ - [list -anchor $(anchor)] [list -query $(query)] \ + [list -anchor $(anchor)] [list -query $(query)] \ [list -stripped_name $(stripped_name)] [list -label $label] \ -parent_id $(parent_id) -item_id $(item_id) -package_id $package_id @@ -1606,15 +1688,15 @@ Page instproc new_link {-name -title -nls_language -return_url -parent_id page_package_id} { if {[info exists parent_id] && $parent_id eq ""} {unset parent_id} return [$page_package_id make_link -with_entities 0 $page_package_id \ - edit-new object_type name title nls_language return_url parent_id autoname] + edit-new object_type name title nls_language return_url parent_id autoname] } FormPage instproc new_link {-name -title -nls_language -parent_id -return_url page_package_id} { set template_id [my page_template] if {![info exists parent_id]} {set parent_id [$page_package_id folder_id]} set form [$page_package_id pretty_link -parent_id $parent_id [$template_id name]] return [$page_package_id make_link -with_entities 0 -link $form $template_id \ - create-new return_url name title nls_language] + create-new return_url name title nls_language] } @@ -1740,9 +1822,9 @@ set description [ad_html_text_convert -from text/html -to text/plain -- $content] } if {$description eq "" && $revision_id > 0} { - set body [::xo::db_string get_description_from_syndication \ - "select body from syndication where object_id = $revision_id" \ - -default ""] + set body [::xo::dc get_value get_description_from_syndication \ + "select body from syndication where object_id = $revision_id" \ + -default ""] set description [ad_html_text_convert -from text/html -to text/plain -- $body] } if {[info exists nr_chars] && [string length $description] > $nr_chars} { @@ -1754,7 +1836,7 @@ Page instproc render_content {} { #my log "-- '[my set text]'" set html ""; set mime "" - foreach {html mime} [my set text] break + lassign [my set text] html mime if {[my render_adp]} { set html [my adp_subst $html] } @@ -1771,14 +1853,14 @@ set spec "" #my msg WidgetSpecs=[$package_id get_parameter WidgetSpecs] foreach {s widget_spec} [$package_id get_parameter WidgetSpecs] { - foreach {page_name var_name} [split $s ,] break + lassign [split $s ,] page_name var_name # in case we have no name (edit new page) we use the first value or the default. set name [expr {[my exists name] ? [my set name] : $page_name}] #my msg "--w T.name = '$name' var=$page_name ([string match $page_name $name]), $var_name $field_name ([string match $var_name $field_name])" if {[string match $page_name $name] && [string match $var_name $field_name]} { set spec $widget_spec - #my msg "setting spec to $spec" + #my msg "setting spec to $spec" break } } @@ -1808,11 +1890,11 @@ Page instproc references_update {references} { #my msg $references my instvar item_id - db_dml [my qn delete_references] \ + ::xo::dc dml delete_references \ "delete from xowiki_references where page = :item_id" foreach ref $references { - foreach {r link_type} $ref break - db_dml [my qn insert_reference] \ + lassign $ref r link_type + ::xo::dc dml insert_reference \ "insert into xowiki_references (reference, link_type, page) \ values (:r,:link_type,:item_id)" } @@ -1846,7 +1928,7 @@ set tag_content [my include my-tags] set tag_includelet [my set __last_includelet] if {[$tag_includelet exists tags]} { - set tags [$tag_includelet set tags] + set tags [$tag_includelet set tags] } } else { set tag_content "" @@ -1870,8 +1952,8 @@ [::xo::get_user_name [::xo::cc user_id]]] append footer "
" \ [my include [list my-yahoo-publisher \ - -publisher $publisher \ - -rssurl "$package_url?rss"]] \ + -publisher $publisher \ + -rssurl "$package_url?rss"]] \ "
\n" } @@ -1882,7 +1964,7 @@ if {[$package_id get_parameter "show_per_object_categories" 1]} { set html [my include my-categories] if {$html ne ""} { - append footer $html
+ append footer $html
} set categories_includelet [my set __last_includelet] } @@ -1978,31 +2060,32 @@ foreach tag {h1 h2 h3 h4 h5 b strong} { foreach {match words} [regexp -all -inline "<$tag>(\[^<\]+)" $html] { - foreach w [split $words] { - if {$w eq ""} continue - set word($w) 1 - } + foreach w [split $words] { + if {$w eq ""} continue + set word($w) 1 + } } } foreach tag [::xowiki::Page get_tags -package_id [my package_id] -item_id [my item_id]] { set word($tag) 1 } - #my log [list html $html keywords [array names work]] - return [list html $html keywords [array names work]] + #my log [list html $html keywords [array names word]] + return [list mime text/html html $html keywords [array names word] text ""] } Page instproc record_last_visited {-user_id} { my instvar item_id package_id if {![info exists user_id]} {set user_id [::xo::cc set untrusted_user_id]} if {$user_id > 0} { # only record information for authenticated users - db_dml [my qn update_last_visisted] \ - "update xowiki_last_visited set time = current_timestamp, count = count + 1 \ - where page_id = :item_id and user_id = :user_id" - if {[db_resultrows] < 1} { - db_dml [my qn insert_last_visisted] \ + set rows [xo::dc dml update_last_visisted { + update xowiki_last_visited set time = now(), count = count + 1 + where page_id = :item_id and user_id = :user_id + }] + if {$rows ne "" && $rows < 1} { + ::xo::dc dml insert_last_visisted \ "insert into xowiki_last_visited (page_id, package_id, user_id, count, time) \ - values (:item_id, :package_id, :user_id, 1, current_timestamp)" + values (:item_id, :package_id, :user_id, 1, now())" } } } @@ -2015,8 +2098,8 @@ # OpenACS templating widget or directly. If the list is not # well-formed, it must be contained directly. if {![catch {set l [llength $content]}] - && $l == 2 - && [string match "text/*" [lindex $content 1]]} { + && $l == 2 + && [string match "text/*" [lindex $content 1]]} { return [lindex $content 0] } return $content @@ -2054,16 +2137,16 @@ foreach name_and_spec [my get_form_constraints] { regexp {^([^:]+):(.*)$} $name_and_spec _ spec_name short_spec if {[string match $spec_name $name]} { - set f [my create_form_fields_from_form_constraints [list $name:$short_spec]] - set $key $f - return $f + set f [my create_form_fields_from_form_constraints [list $name:$short_spec]] + set $key $f + return $f } } if {$name ni {fontname fontsize formatblock}} { set names [list] foreach f $form_fields {lappend names [$f name]} my msg "No form field with name '$name' found\ - (available fields: [lsort [array names ::_form_field_names]])" + (available fields: [lsort [array names ::_form_field_names]])" } set f [my create_form_fields_from_form_constraints [list $name:text]] set $key $f @@ -2094,10 +2177,6 @@ Page instproc translate {-from -to text} { set langpair $from|$to set ie UTF8 - #set r [xo::HttpRequest new -url http://translate.google.com/translate_t \ - -post_data [export_vars {langpair text ie}] \ - -content_type application/x-www-form-urlencoded] - #my msg url=http://translate.google.com/#$from/$to/$text set r [xo::HttpRequest new -url http://translate.google.com/#$from/$to/$text] #my msg status=[$r set status] if {[$r set status] eq "finished"} { @@ -2155,7 +2234,7 @@ } # Make sure to load the instance attributes - $f array set __ia [$f instance_attributes] + #$f array set __ia [$f instance_attributes] # Call the application specific initialization, when a FormPage is # initially created. This is used to control the life-cycle of @@ -2261,15 +2340,33 @@ if {![my exists full_file_name]} { if {[my exists item_id]} { my instvar text mime_type package_id item_id revision_id - set storage_area_key [::xo::db_string get_storage_key \ - "select storage_area_key from cr_items where item_id=$item_id"] + set storage_area_key [::xo::dc get_value get_storage_key \ + "select storage_area_key from cr_items where item_id=:item_id"] my set full_file_name [cr_fs_path $storage_area_key]/$text #my log "--F setting FILE=[my set full_file_name]" } } return [my set full_file_name] } + File instproc search_render {} { + # array set "" {mime text/html text "" html "" keywords ""} + set mime [my set mime_type] + if {$mime eq "text/plain"} { + set result [next] + } else { + if {[info commands "::search::convert::binary_to_text"] ne ""} { + set txt [search::convert::binary_to_text -filename [my full_file_name] -mime_type $mime] + set result [list text $txt mime text/plain] + } else { + set result [list text "" mime text/plain] + } + } + + #ns_log notice "search_render returns $result" + return $result + } + File instproc html_content {{-add_sections_to_folder_tree 0} -owner} { set parent_id [my parent_id] set fileName [my full_file_name] @@ -2299,43 +2396,43 @@ foreach n [$root selectNodes //img] { set src [$n getAttribute src] if {[regexp {^[^/]} $src]} { - $n setAttribute src $prefix/$src - #my msg "setting src to $prefix/$src" + $n setAttribute src $prefix/$src + #my msg "setting src to $prefix/$src" } } # # In case, the switch is activated, and we have a menubar, add the # top level section # - if {$add_sections_to_folder_tree && [info command ::__xowiki__MenuBar] ne ""} { + if {$add_sections_to_folder_tree && [info commands ::__xowiki__MenuBar] ne ""} { $owner set book_mode 1 set pages [::xo::OrderedComposite new -destroy_on_cleanup] if {$add_sections_to_folder_tree == 1} { - set selector //h2 + set selector //h2 } else { - set selector {//h2 | //h3} + set selector {//h2 | //h3} } set order 0 foreach n [$root selectNodes $selector] { - if {[$n hasAttribute id]} { - set name [$n getAttribute id] - } else { - set name "section $n" - } - set o [::xotcl::Object new] - $o set page_order [incr $order] - $o set title [$n asText] - - set e [$doc createElement a] - $e setAttribute name $name - [$n parentNode] insertBefore $e $n + if {[$n hasAttribute id]} { + set name [$n getAttribute id] + } else { + set name "section $n" + } + set o [::xotcl::Object new] + $o set page_order [incr $order] + $o set title [$n asText] + + set e [$doc createElement a] + $e setAttribute name $name + [$n parentNode] insertBefore $e $n - $o set name $name - $pages add $o + $o set name $name + $pages add $o } - + #$o instvar page_order title name ::__xowiki__MenuBar additional_sub_menu -kind folder -pages $pages -owner $owner @@ -2349,7 +2446,7 @@ return $content } - + File instproc render_content {} { my instvar name mime_type description parent_id package_id item_id creation_user # don't require permissions here, such that rss can present the link @@ -2387,16 +2484,16 @@ switch -glob $mime_type { image/* { - set l [Link new -volatile \ - -page [self] -query $query \ - -type image -name $name -lang "" \ - -stripped_name $stripped_name -label $label \ - -parent_id $parent_id -item_id $item_id -package_id $package_id] - set preview "
[$l render]
" + set l [Link new -volatile \ + -page [self] -query $query \ + -type image -name $name -lang "" \ + -stripped_name $stripped_name -label $label \ + -parent_id $parent_id -item_id $item_id -package_id $package_id] + set preview "
[$l render]
" } text/plain { - set text [::xowiki::read_file [my full_file_name]] - set preview "
[::xowiki::Includelet html_encode $text]
" + set text [::xowiki::read_file [my full_file_name]] + set preview "
[::xowiki::Includelet html_encode $text]
" } default {set preview ""} } @@ -2432,31 +2529,31 @@ {-publish_status ready} } { return [::xowiki::PageTemplate count_usages -package_id $package_id -parent_id $parent_id \ - -item_id [my item_id] -publish_status $publish_status] + -item_id [my item_id] -publish_status $publish_status] } PageTemplate proc count_usages { - {-package_id:integer 0} - {-parent_id:integer 0} - -item_id:required - {-publish_status ready} - } { + {-package_id:integer 0} + {-parent_id:integer 0} + -item_id:required + {-publish_status ready} + } { set publish_status_clause [::xowiki::Includelet publish_status_clause -base_table i $publish_status] if {$package_id} { set bt "xowiki_page_instancei" - set package_clause "and object_package_id = $package_id" + set package_clause "and object_package_id = :package_id" } else { set bt "xowiki_page_instance" set package_clause "" } if {$parent_id} { - set parent_id_clause "and parent_id = $parent_id" + set parent_id_clause "and parent_id = :parent_id" } else { set parent_id_clause "" } - set count [::xo::db_string [my qn count_usages] \ - "select count(page_instance_id) from $bt, cr_items i \ - where page_template = $item_id \ + set count [::xo::dc get_value count_usages \ + "select count(page_instance_id) from $bt, cr_items i \ + where page_template = $item_id \ $publish_status_clause $package_clause $parent_id_clause \ and page_instance_id = coalesce(i.live_revision,i.latest_revision)"] return $count @@ -2468,7 +2565,11 @@ # We need this acually only for PageTemplate and FormPage, but # aliases will require XOTcl 2.0.... so we define it for the time # being on ::xowiki::Page - set name [expr {$margin_form ? "margin-form " : ""}] + if {[parameter::get_global_value -package_key xowiki -parameter PreferredCSSToolkit -default yui] ne "bootstrap"} { + set name [expr {$margin_form ? "margin-form " : ""}] + } else { + set name "" + } set CSSname [my name] # Remove language prefix, if used. @@ -2526,7 +2627,7 @@ #my msg "fc of [self] [my name] = $form_constraints" if {$form_constraints ne ""} { set s [::xowiki::PageInstance get_short_spec_from_form_constraints \ - -name $name -form_constraints $form_constraints] + -name $name -form_constraints $form_constraints] #my msg "get_short_spec $name c=$form_constraints => '$s'" return $s } @@ -2549,7 +2650,7 @@ # for a field with a specified name in a specified page template my instvar package_id foreach {s widget_spec} [$package_id get_parameter WidgetSpecs] { - foreach {template_name var_name} [split $s ,] break + lassign [split $s ,] template_name var_name #ns_log notice "--w template_name $template_name, given '$given_template_name' varname=$var_name name=$name" if {([string match $template_name $given_template_name] || $given_template_name eq "") && [string match $var_name $name]} { @@ -2594,7 +2695,7 @@ # PageInstances have no form_constraints return "" } - + #FormPage instproc save args { # my debug_msg [my set instance attributes] # my log "IA=[my set instance_attributes]" @@ -2683,19 +2784,18 @@ PageInstance instproc adp_subst {content} { # initialize template variables (in case, new variables are added to template) - array set __ia [my template_vars $content] - # add extra variables as instance attributes - array set __ia [my set instance_attributes] + # and add extra variables from instance attributes + set __ia [dict merge [my template_vars $content] [my set instance_attributes]] - foreach var [array names __ia] { + foreach var [dict keys $__ia] { #my log "-- set $var [list $__ia($var)]" # TODO: just for the lookup, whether a field is a richt text field, # there should be a more efficient and easier way... if {[string match "richtext*" [my get_field_type $var text]]} { # ignore the text/html info from htmlarea - set value [lindex $__ia($var) 0] + set value [lindex [dict get $__ia $var] 0] } else { - set value $__ia($var) + set value [dict get $__ia $var] } # the value might not be from the form attributes (e.g. title), don't clear it. if {$value eq "" && [my exists $var]} continue @@ -2710,7 +2810,7 @@ {-publish_status ready} } { return [::xowiki::PageTemplate count_usages -package_id $package_id \ - -parent_id $parent_id -item_id [my item_id] -publish_status $publish_status] + -parent_id $parent_id -item_id [my item_id] -publish_status $publish_status] } # @@ -2791,7 +2891,9 @@ $doc documentElement root my dom_disable_input_fields -with_submit $with_submit $root set form [lindex [$root selectNodes //form] 0] - Form add_dom_attribute_value $form class "margin-form" + if {[parameter::get_global_value -package_key xowiki -parameter PreferredCSSToolkit -default yui] ne "bootstrap"} { + Form add_dom_attribute_value $form class "margin-form" + } return [$root asHTML] } @@ -2816,7 +2918,7 @@ if {[lindex $text 0] ne ""} { my do_substitutions 0 set html ""; set mime "" - foreach {html mime} [my set text] break + lassign [my set text] html mime set content [my substitute_markup $html] } elseif {[lindex $form 0] ne ""} { set content [[self class] disable_input_fields [lindex $form 0]] @@ -2846,9 +2948,9 @@ #my msg "checking spec '$short_spec' for form field '$spec_name'" lappend form_fields [my create_raw_form_field \ - -name $spec_name \ - -slot [my find_slot $spec_name] \ - -spec $short_spec] + -name $spec_name \ + -slot [my find_slot $spec_name] \ + -spec $short_spec] } return $form_fields } @@ -2894,11 +2996,19 @@ #my msg "[my name] [my info class]" if {[my exists page_template]} { set p [::xo::db::CrClass get_instance_from_db -item_id [my page_template]] - # The Form might come from a different package type (e.g. a workflow) - # make sure, the source package is available - ::xo::Package require [$p package_id] + # + # The Form might come from a different package type (e.g. a + # workflow) make sure, the source package is available. + # + # Note, that global pages (site_wide_pages) might not belong to + # a package and have therefore an empty package_id. + # + set package_id [$p package_id] + if {$package_id ne ""} { + ::xo::Package require $package_id + } } - my array set __ia [my instance_attributes] + #my array set __ia [my instance_attributes] next } FormPage instproc initialize {} { @@ -2922,10 +3032,10 @@ } FormPage proc filter_expression { - {-sql true} - input_expr - logical_op - } { + {-sql true} + input_expr + logical_op + } { array set tcl_op {= eq < < > > >= >= <= <=} array set sql_op {= = < < > > >= >= <= <=} array set op_map {contains,sql {$lhs_var like '%$rhs%'} contains,tcl {[lsearch $lhs_var {$rhs}] > -1}} @@ -2941,7 +3051,7 @@ set rhs_expr [string trim $rhs_expr] if {[string range $lhs 0 0] eq "_"} { set lhs_var [string range $lhs 1 end] - set rhs [split $rhs_expr |] + set rhs [split $rhs_expr |] if {[info exists op_map($op,sql)]} { lappend sql_clause [subst -nocommands $op_map($op,sql)] if {[my exists $lhs_var]} { @@ -2953,28 +3063,28 @@ } elseif {[llength $rhs]>1} { lappend sql_clause "$lhs_var in ('[join $rhs ',']')" # the following statement is only needed, when we rely on tcl-only - lappend tcl_clause "\[lsearch -exact {$rhs} \[my property $lhs\]\] > -1" + lappend tcl_clause "\[lsearch -exact {$rhs} \[my property $lhs\]\] > -1" } else { lappend sql_clause "$lhs_var $sql_op($op) '$rhs'" # the following statement is only needed, when we rely on tcl-only - lappend tcl_clause "\[my property $lhs\] $tcl_op($op) {$rhs}" + lappend tcl_clause "\[my property $lhs\] $tcl_op($op) {$rhs}" } } else { set hleft [my h_double_quote $lhs] lappend vars $lhs "" - if {$op eq "contains"} { - #make approximate query - set lhs_var instance_attributes - set rhs $rhs_expr - lappend sql_clause [subst -nocommands $op_map($op,sql)] - } - set lhs_var "\$__ia($lhs)" + if {$op eq "contains"} { + #make approximate query + set lhs_var instance_attributes + set rhs $rhs_expr + lappend sql_clause [subst -nocommands $op_map($op,sql)] + } + set lhs_var "\[dict get \$__ia $lhs\]" foreach rhs [split $rhs_expr |] { - if {[info exists op_map($op,tcl)]} { - lappend tcl_clause [subst -nocommands $op_map($op,tcl)] - } else { - lappend tcl_clause "$lhs_var $tcl_op($op) {$rhs}" - } + if {[info exists op_map($op,tcl)]} { + lappend tcl_clause [subst -nocommands $op_map($op,tcl)] + } else { + lappend tcl_clause "$lhs_var $tcl_op($op) {$rhs}" + } if {$op eq "="} { # TODO: think about a solution for other operators with # hstore maybe: extracting it by a query via hstore and @@ -2995,20 +3105,20 @@ } FormPage proc get_form_entries { - -base_item_ids:required - -package_id:required - -form_fields:required - {-publish_status ready} - {-parent_id "*"} - {-extra_where_clause ""} - {-h_where {tcl true h "" vars "" sql ""}} - {-always_queried_attributes ""} - {-orderby ""} - {-page_size 20} - {-page_number ""} - {-initialize true} - {-from_package_ids ""} - } { + -base_item_ids:required + -package_id:required + -form_fields:required + {-publish_status ready} + {-parent_id "*"} + {-extra_where_clause ""} + {-h_where {tcl true h "" vars "" sql ""}} + {-always_queried_attributes ""} + {-orderby ""} + {-page_size 20} + {-page_number ""} + {-initialize true} + {-from_package_ids ""} + } { # # Get query attributes for all tables (to allow e.g. sorting by time) # @@ -3033,7 +3143,7 @@ bt.creation_date bt.creation_user bt.last_modified \ "bt.object_package_id as package_id" bt.title \ bt.page_template bt.state bt.assignee - ] + ] if {$always_queried_attributes eq "*"} { lappend sql_atts \ bt.object_type bt.object_id \ @@ -3084,7 +3194,7 @@ # set filter_clause "" array set wc $h_where - set use_hstore [expr {[::xo::db::has_hstore] && + set use_hstore [expr {[::xo::dc has_hstore] && [$package_id get_parameter use_hstore 0] }] if {$use_hstore && $wc(h) ne ""} { @@ -3102,9 +3212,11 @@ # Build package clause # if {$from_package_ids eq ""} { - set package_clause "and object_package_id = $package_id" + set package_clause "and object_package_id = :package_id" } elseif {$from_package_ids eq "*"} { set package_clause "" + } elseif {[llength $from_package_ids] == 1} { + set package_clause "and object_package_id = :from_package_ids" } else { set package_clause "and object_package_id in ([join $from_package_ids ,])" } @@ -3118,17 +3230,17 @@ # transform all into an SQL query # set sql [::xowiki::FormPage instance_select_query \ - -select_attributes $sql_atts \ - -from_clause "" \ - -where_clause " bt.page_template in ([join $base_item_ids ,]) \ - $publish_status_clause $filter_clause $package_clause \ - $extra_where_clause" \ - -orderby $orderby \ - -with_subtypes false \ - -parent_id $parent_id \ - -page_size $page_size \ - -page_number $page_number \ - -base_table xowiki_form_pagei \ + -select_attributes $sql_atts \ + -from_clause "" \ + -where_clause " bt.page_template in ([join $base_item_ids ,]) \ + $publish_status_clause $filter_clause $package_clause \ + $extra_where_clause" \ + -orderby $orderby \ + -with_subtypes false \ + -parent_id $parent_id \ + -page_size $page_size \ + -page_number $page_number \ + -base_table xowiki_form_pagei \ ] #my ds $sql @@ -3141,27 +3253,26 @@ -named_objects $named_objects -object_named_after "item_id" \ -object_class ::xowiki::FormPage -initialize $initialize] - if {!$use_hstore && $wc(tcl) ne "true"} { + if {!$use_hstore && $wc(tcl) != "true"} { # Make sure, that the expr method is available; # in xotcl 2.0 this will not be needed ::xotcl::alias ::xowiki::FormPage expr -objscope ::expr set init_vars $wc(vars) foreach p [$items children] { - array set __ia $init_vars - array set __ia [$p instance_attributes] + set __ia [dict merge $init_vars [$p instance_attributes]] if {![$p expr $wc(tcl)]} {$items delete $p} } } return $items } - + FormPage proc get_folder_children { - -folder_id:required - {-publish_status ready} - {-object_types {::xowiki::Page ::xowiki::Form ::xowiki::FormPage}} - {-extra_where_clause true} - } { + -folder_id:required + {-publish_status ready} + {-object_types {::xowiki::Page ::xowiki::Form ::xowiki::FormPage}} + {-extra_where_clause true} + } { set publish_status_clause [::xowiki::Includelet publish_status_clause $publish_status] set result [::xo::OrderedComposite new -destroy_on_cleanup] @@ -3170,17 +3281,17 @@ "to_char(last_modified,'YYYY-MM-DD HH24:MI') as last_modified" ] set base_table [$object_type set table_name]i if {$object_type eq "::xowiki::FormPage"} { - set attributes "* $attributes" + set attributes "* $attributes" } set items [$object_type get_instances_from_db \ - -folder_id $folder_id \ - -with_subtypes false \ - -select_attributes $attributes \ - -where_clause "$extra_where_clause $publish_status_clause" \ - -base_table $base_table] + -folder_id $folder_id \ + -with_subtypes false \ + -select_attributes $attributes \ + -where_clause "$extra_where_clause $publish_status_clause" \ + -base_table $base_table] foreach i [$items children] { - $result add $i + $result add $i } } return $result @@ -3196,7 +3307,7 @@ set folder [::xo::db::CrClass get_instance_from_db -item_id $folder_id -revision_id 0] if {[$folder istype ::xowiki::FormPage]} { foreach ref [$folder property inherit_folders] { - if {$ref ni $aggregated_folder_refs} {lappend additional_folder_refs $ref} + if {$ref ni $aggregated_folder_refs} {lappend additional_folder_refs $ref} } } # @@ -3208,17 +3319,17 @@ set page [$package_id get_page_from_item_ref $item_ref] if {$page eq ""} {error "configured inherited folder $item_ref cannot be resolved"} set aggregated_folder_refs \ - [FormPage get_super_folders $package_id [$page item_id] $aggregated_folder_refs] + [FormPage get_super_folders $package_id [$page item_id] $aggregated_folder_refs] } return $aggregated_folder_refs } FormPage proc get_all_children { - -folder_id:required - {-publish_status ready} - {-object_types {::xowiki::Page ::xowiki::Form ::xowiki::FormPage}} - {-extra_where_clause true} - } { + -folder_id:required + {-publish_status ready} + {-object_types {::xowiki::Page ::xowiki::Form ::xowiki::FormPage}} + {-extra_where_clause true} + } { set folder [::xo::db::CrClass get_instance_from_db -item_id $folder_id -revision_id 0] set package_id [$folder package_id] @@ -3234,32 +3345,32 @@ foreach item_ref $inherit_folders { set folder [::xo::cc cache [list $package_id get_page_from_item_ref $item_ref]] if {$folder eq ""} { - my log "Error: Could not resolve parameter folder page '$item_ref' of FormPage [self]." + my log "Error: Could not resolve parameter folder page '$item_ref' of FormPage [self]." } else { - lappend list_of_folders [$folder item_id] + lappend list_of_folders [$folder item_id] } } $result set folder_ids $list_of_folders foreach folder_id $list_of_folders { foreach object_type $object_types { - set attributes [list revision_id creation_user title parent_id page_order \ - "to_char(last_modified,'YYYY-MM-DD HH24:MI') as last_modified" ] - set base_table [$object_type set table_name]i - if {$object_type eq "::xowiki::FormPage"} { - set attributes "* $attributes" - } - set items [$object_type get_instances_from_db \ - -folder_id $folder_id \ - -with_subtypes false \ - -select_attributes $attributes \ - -where_clause "$extra_where_clause $publish_status_clause" \ - -base_table $base_table] - - foreach i [$items children] { - $result add $i - } + set attributes [list revision_id creation_user title parent_id page_order \ + "to_char(last_modified,'YYYY-MM-DD HH24:MI') as last_modified" ] + set base_table [$object_type set table_name]i + if {$object_type eq "::xowiki::FormPage"} { + set attributes "* $attributes" + } + set items [$object_type get_instances_from_db \ + -folder_id $folder_id \ + -with_subtypes false \ + -select_attributes $attributes \ + -where_clause "$extra_where_clause $publish_status_clause" \ + -base_table $base_table] + + foreach i [$items children] { + $result add $i + } } } return $result @@ -3268,79 +3379,92 @@ # part of the code copied from Package->get_parameter # see xowiki/www/prototypes/folder.form.page FormPage instproc get_parameter {attribute {default ""}} { - # TODO: check whether the following comment applies here - # Try to get the parameter from the parameter_page. We have to - # be very cautious here to avoid recursive calls (e.g. when - # resolve_page_name needs as well parameters such as - # use_connection_locale or subst_blank_in_name, etc.). - # - set value "" - set pp [my property ParameterPages] - if {$pp ne {}} { - if {![regexp {/?..:} $pp]} { - my log "Error: Name of parameter page '$pp' of FormPage [self] must contain a language prefix" - } else { - set page [::xo::cc cache [list [my package_id] get_page_from_item_ref $pp]] - if {$page eq ""} { - my log "Error: Could not resolve parameter page '$pp' of FormPage [self]." - } - - if {$page ne "" && [$page exists instance_attributes]} { - array set __ia [$page set instance_attributes] - if {[info exists __ia($attribute)]} { - set value $__ia($attribute) - } - } - } + # TODO: check whether the following comment applies here + # Try to get the parameter from the parameter_page. We have to + # be very cautious here to avoid recursive calls (e.g. when + # resolve_page_name needs as well parameters such as + # use_connection_locale or subst_blank_in_name, etc.). + # + set value "" + set pp [my property ParameterPages] + if {$pp ne {}} { + if {![regexp {/?..:} $pp]} { + my log "Error: Name of parameter page '$pp' of FormPage [self] must contain a language prefix" + } else { + set page [::xo::cc cache [list [my package_id] get_page_from_item_ref $pp]] + if {$page eq ""} { + my log "Error: Could not resolve parameter page '$pp' of FormPage [self]." + } + + if {$page ne "" && [$page exists instance_attributes]} { + set __ia [$page set instance_attributes] + if {[dict exists $__ia $attribute]} { + set value [dict get $__ia $attribute] + } + } } - - - if {$value eq {}} {set value [next $attribute $default]} - return $value + } + + + if {$value eq {}} {set value [next $attribute $default]} + return $value } # # begin property management # - FormPage instproc property_key {name} { + #FormPage instproc property_key {name} { + # if {[regexp {^_([^_].*)$} $name _ varname]} { + # return $varname + # } { + # return __ia($name) + # } + #} + + FormPage instproc exists_property {name} { if {[regexp {^_([^_].*)$} $name _ varname]} { - return $varname - } { - return __ia($name) + return [my exists $varname] } + my instvar instance_attributes + return [dict exists $instance_attributes $name] } - FormPage instproc exists_property {name} { - return [my exists [my property_key $name]] - } - FormPage instproc property {name {default ""}} { - set key [my property_key $name] - #my msg "$key [my exists $key] //[my array names __ia]//" - if {[my exists $key]} { - return [my set $key] + + if {[regexp {^_([^_].*)$} $name _ varname]} { + if {[my exists $varname]} { + return [my set $varname] + } + return $default } + + my instvar instance_attributes + if {[dict exists $instance_attributes $name]} { + return [dict get $instance_attributes $name] + } return $default } FormPage instproc set_property {{-new 0} name value} { if {[string match "_*" $name]} { set key [string range $name 1 end] - set instance_attributes_refresh 0 - } { - set key __ia($name) - set instance_attributes_refresh 1 + + if {!$new && ![my exists $key]} { + error "property '$name' ($key) does not exist. \ + you might use flag '-new 1' for set_property to create new properties" + } + my set $key $value + + } else { + + my instvar instance_attributes + if {!$new && ![dict exists $instance_attributes $name]} { + error "property '$name' does not exist. \ + you might use flag '-new 1' for set_property to create new properties" + } + dict set instance_attributes $name $value } - if {!$new && ![my exists $key]} { - error "property '$name' ($key) does not exist. \ - you might use flag '-new 1' for set_property to create new properties\n[lsort [my info vars]]" - } - my set $key $value - #my msg "[self] set $key $value" - if {$instance_attributes_refresh} { - my instance_attributes [my array get __ia] - } return $value } @@ -3359,22 +3483,21 @@ # The passed value is a tuple of the form # {property-name operator property-value} # - foreach {property_name op property_value} $value break + lassign $value property_name op property_value if {![info exists property_value]} {return 0} #my log "$value => [my adp_subst $value]" array set wc [::xowiki::FormPage filter_expression [my adp_subst $value] &&] #my log "wc= [array get wc]" - array set __ia $wc(vars) - array set __ia [my instance_attributes] + set __ia [dict merge $wc(vars) [my instance_attributes]] #my log "expr $wc(tcl) returns => [expr $wc(tcl)]" return [expr $wc(tcl)] } # # end property management # - + FormPage instproc set_publish_status {value} { if {$value ni {production ready}} { error "invalid value '$value'; use 'production' or 'ready'" @@ -3397,10 +3520,10 @@ } -# FormPage instproc form_attributes {} { -# my log "DEPRECATRED, use 'field_names_from_form' instead " -# return [my field_names_from_form] -# } + # FormPage instproc form_attributes {} { + # my log "DEPRECATRED, use 'field_names_from_form' instead " + # return [my field_names_from_form] + # } FormPage instproc field_names_from_form {{-form ""}} { # @@ -3419,9 +3542,9 @@ if {$form eq ""} { foreach {var _} [my template_vars $template] { #if {[string match _* $var]} continue - if {$var ni $allvars && $var ni $field_names} { - lappend field_names $var - } + if {$var ni $allvars && $var ni $field_names} { + lappend field_names $var + } } set from_HTML_form 0 } else { @@ -3434,13 +3557,13 @@ set fields [$root selectNodes "//*\[@name != ''\]"] foreach field $fields { set node_name [$field nodeName] - if {$node_name ne "input" + if {$node_name ne "input" && $node_name ne "textarea" && $node_name ne "select" } continue - set att [$field getAttribute name] + set att [$field getAttribute name] #if {[string match _* $att]} continue - if {$att ni $field_names} { lappend field_names $att } + if {$att ni $field_names} { lappend field_names $att } } set from_HTML_form 1 } @@ -3462,23 +3585,23 @@ } switch [$page_template name] { en:folder.form { - return [list text "" is_richtext true] + return [list text "" is_richtext true] } en:link.form { - set link_type [my get_property_from_link_page link_type "unresolved"] - set link_icon "http://www.ejoe.at/typo3/sysext/rtehtmlarea/res/accessibilityicons/img/internal_link.gif" - if {$link_type eq "unresolved"} { - return [list text " \ - " is_richtext true] - } - if {$link_type eq "folder_link"} { - return [list text " \ - " is_richtext true] - } - return [list text "" is_richtext true] + set link_type [my get_property_from_link_page link_type "unresolved"] + set link_icon "http://www.ejoe.at/typo3/sysext/rtehtmlarea/res/accessibilityicons/img/internal_link.gif" + if {$link_type eq "unresolved"} { + return [list text " \ + " is_richtext true] + } + if {$link_type eq "folder_link"} { + return [list text " \ + " is_richtext true] + } + return [list text "" is_richtext true] } default { - return [list text [$page_template title] is_richtext false] + return [list text [$page_template title] is_richtext false] } } } @@ -3509,11 +3632,11 @@ set line [string trim $line] set order 1 if {[llength $line]>1} { - set e1 [lindex $line 0] - if {[string is integer -strict $e1]} { - set order $e1 - set line [lindex $line 1] - } + set e1 [lindex $line 0] + if {[string is integer -strict $e1]} { + set order $e1 + set line [lindex $line 1] + } } ::xo::Page requireCSS -order $order $line } @@ -3529,35 +3652,37 @@ catch {set text [lindex $text 0]} } if {$text ne ""} { - #my msg "we have a template text='$text'" + #my log "we have a template text='$text'" # we have a template return [next] } else { - #my msg "we have a form '[my get_form]'" + #my log "we have a form '[my get_form]'" set form [my get_form] if {$form eq ""} {return ""} - ::xowiki::Form requireFormCSS + my setCSSDefaults - foreach {form_vars field_names} [my field_names_from_form -form $form] break + lassign [my field_names_from_form -form $form] form_vars field_names my array unset __field_in_form if {$form_vars} {foreach v $field_names {my set __field_in_form($v) 1}} set form_fields [my create_form_fields $field_names] my load_values_into_form_fields $form_fields - + # deactivate form-fields and do some final sanity checks foreach f $form_fields {$f set_disabled 1} my form_fields_sanity_check $form_fields set form [my regsub_eval \ - [template::adp_variable_regexp] $form \ - {my form_field_as_html -mode display "\\\1" "\2" $form_fields}] + [template::adp_variable_regexp] $form \ + {my form_field_as_html -mode display "\\\1" "\2" $form_fields}] # we parse the form just for the margin-form.... maybe regsub? dom parse -simple -html $form doc $doc documentElement root set form_node [lindex [$root selectNodes //form] 0] + my log "render-content" + Form add_dom_attribute_value $form_node role form Form add_dom_attribute_value $form_node class [$page_template css_class_name] # The following two commands are for non-generated form contents my set_form_data $form_fields @@ -3586,19 +3711,19 @@ # set f [::xowiki::formfield::FormField get_from_name [self] $varname] if {$f ne ""} { - # - # the form field exists already, we just fill in the actual - # value (needed e.g. in weblogs, when the same form field is - # used for multiple page instances in a single request) - # - set value [$f value [my property $varname]] + # + # the form field exists already, we just fill in the actual + # value (needed e.g. in weblogs, when the same form field is + # used for multiple page instances in a single request) + # + set value [$f value [my property $varname]] } else { - # - # create a form-field from scratch - # - set value [my property $varname] - set f [my create_form_field -cr_field_spec $cr_field_spec -field_spec $field_spec $varname] - $f value $value + # + # create a form-field from scratch + # + set value [my property $varname] + set f [my create_form_field -cr_field_spec $cr_field_spec -field_spec $field_spec $varname] + $f value $value } if {[$f hide_value]} { @@ -3617,7 +3742,7 @@ # Iterate over the variables for substitution set content [my regsub_eval -noquote true \ [template::adp_variable_regexp] " $content" \ - {my get_value -field_spec $field_spec -cr_field_spec $cr_field_spec "\\\1" "\2"}] + {my get_value -field_spec $field_spec -cr_field_spec $cr_field_spec "\\\1" "\2"}] return [string range $content 1 end] } @@ -3668,7 +3793,7 @@ Page instproc unset_temporary_instance_variables {} { # don't marshall/save/cache the following vars - my array unset __ia + #my array unset __ia my array unset __field_in_form my array unset __field_needed } @@ -3685,7 +3810,7 @@ my instvar package_id name - db_transaction { + ::xo::dc transaction { # # if the newly created item was in production mode, but ordinary entries # are not, change on the first save the status to ready @@ -3698,9 +3823,7 @@ my map_categories $category_ids my save -use_given_publish_date $use_given_publish_date - #my log "-- old_name $old_name, name $name" if {$old_name ne $name} { - #my msg "do rename from $old_name to $name" $package_id flush_name_cache -name $old_name -parent_id [my parent_id] my rename -old_name $old_name -new_name $name } @@ -3712,3 +3835,9 @@ ::xo::library source_dependent +# +# Local variables: +# mode: tcl +# tcl-indent-level: 2 +# indent-tabs-mode: nil +# End: