" } - Page ad_proc select_query { - {-select_attributes ""} - {-order_clause ""} - {-where_clause ""} - {-count:boolean false} - {-folder_id} - {-page_size 20} - {-page_number ""} - {-syndication:boolean false} - {-extra_where_clause ""} - {-extra_from_clause ""} - } { - returns the SQL-query to select the xowiki pages of the specified folder - @select_attributes attributes for the sql query to be retrieved, in addion - to ci.item_id acs_objects.object_type, which are always returned - @param order_clause clause for ordering the solution set - @param where_clause clause for restricting the answer set - @param count return the query for counting the solutions - @param folder_id parent_id - @return sql query - } { - my instvar object_type_key - if {![info exists folder_id]} {my instvar folder_id} + # + # URL and naming management + # + Page proc pretty_link {{-fully_qualified:boolean false} -lang -package_id name} { + my instvar folder_id + my log "--u name=<$name>" - set attributes [list ci.item_id ci.name p.page_id] - foreach a $select_attributes { - if {$a eq "title"} {set a p.title} - lappend attributes $a + if {![info exists package_id]} {set package_id [$folder_id set package_id]} + if {![my isobject ::$package_id]} { + my log "--u we create package ::xowiki::Package create ::$package_id -folder_id $folder_id" + ::xowiki::Package create ::$package_id -folder_id $folder_id } - if {$count} { - set attribute_selection "count(*)" - set order_clause "" ;# no need to order when we count - set page_number "" ;# no pagination when count is used + set url [::$package_id package_url] + + if {![info exists lang]} { + regexp {^(..):(.*)$} $name _ lang name + } + if {![info exists lang] && ![string match :* $name]} { + set lang [string range [lang::conn::locale] 0 1] + } + set host [expr {$fully_qualified ? [ad_url] : ""}] + if {[info exists lang]} { + return $host${url}$lang/[ad_urlencode $name] } else { - set attribute_selection [join $attributes ,] + return $host${url}[ad_urlencode $name] } + } - if {$where_clause ne ""} {set where_clause "and $where_clause "} -# if {$syndication} { -# append where_clause "and syndication.object_id = p.page_id" -# set extra_tables ", syndication " -# } else { -# set extra_tables "" -# } - if {$page_number ne ""} { - set pagination "offset [expr {$page_size*($page_number-1)}] limit $page_size" - } else { - set pagination "" + Page proc normalize_name {-package_id string} { + set string [string trim $string] + # if subst_blank_in_name is turned on, turn spaces into _ + if {[$package_id get_parameter subst_blank_in_name 1] != 0} { + regsub -all { } $string "_" string } - return "select $attribute_selection from xowiki_pagei p, cr_items ci $extra_from_clause \ - where ci.parent_id = $folder_id and ci.item_id = p.item_id and \ - ci.live_revision = p.page_id $where_clause $extra_where_clause $order_clause $pagination" + return $string } + Page instproc make_link {-privilege -url object method args} { + my instvar package_id + + if {[info exists privilege]} { + set granted [expr {$privilege eq "public" ? 1 : + [permission::permission_p -object_id $package_id -privilege $privilege] + }] + } else { + # determine privilege from policy + set granted [$package_id permission_p $object $method] + my log "--p $package_id permission_p $object $method ==> $granted" + } + if {$granted} { + if {[$object istype ::xowiki::Package]} { + set base [$package_id package_url] + if {[info exists url]} { + return [uplevel export_vars -base $base$url [list $args]] + } else { + lappend args [list $method 1] + return [uplevel export_vars -base $base [list $args]] + } + } elseif {[$object istype ::xowiki::Page]} { + set base [$package_id url] + lappend args [list m $method] + return [uplevel export_vars -base $base [list $args]] + } + } + return "" + } + # - # data definitions + # tag management, get_tags works on instance or gobally # - Page parameter { - page_id - {revision_id 0} - object_type - {folder_id -100} - {lang_links ""} - {lang en} - {render_adp 1} + Page proc save_tags {-package_id:required -item_id:required -user_id:required tags} { + db_dml delete_tags \ + "delete from xowiki_tags where item_id = $item_id and user_id = $user_id" + foreach tag $tags { + db_dml insert_tag \ + "insert into xowiki_tags (item_id,package_id, user_id, tag, time) \ + values ($item_id, $package_id, $user_id, :tag, current_timestamp)" + } + } + Page proc get_tags {-package_id:required -item_id -user_id} { + if {[info exists item_id]} { + if {[info exists user_id]} { + # tags for item and user + set tags [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"] + } else { + # all tags for this item + set tags [db_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 [db_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 [db_list get_tags "SELECT distinct tag from xowiki_tags where package_id=$package_id"] + } + } + join $tags " " } - Page set recursion_count 0 - Page array set RE { - include {([^\\]){{(.+)}}[ \n\r]*} - anchor {([^\\])\\\[\\\[([^\]]+)\\\]\\\]} - div {()([^\\])>>([^&]*)<<} - clean {[\\](\{\{|>>|\[\[)} - } - PlainPage parameter { - {render_adp 0} - } - PlainPage array set RE { - include {([^\\]){{(.+)}}[ \n\r]} - anchor {([^\\])\\\[\\\[([^\]]+)\\\]\\\]} - div {()([^\\])>>([^<]*)<<} - clean {[\\](\{\{|>>|\[\[)} - } - PageTemplate parameter { - {render_adp 0} - } - # # Methods of ::xowiki::Page # + Page instforward query_parameter {%my set package_id} %proc + Page instforward exists_query_parameter {%my set package_id} %proc + Page instforward form_parameter {%my set package_id} %proc + Page instforward exists_form_parameter {%my set package_id} %proc + + Page instproc condition {method attr value} { + switch $attr { + has_class {return [expr {[my set object_type] eq $value}]} + } + return 0 + } + + Page instproc get_user_name {uid} { + if {$uid ne "" && $uid != 0} { + acs_user::get -user_id $uid -array user + return "$user(first_names) $user(last_name)" + } else { + return nobody + } + } + + + Page instproc initialize_loaded_object {} { + my instvar title creator + if {[info exists title] && $title eq ""} {set title [my set name]} + #if {$creator eq ""} {set creator [my get_user_name [my set creation_user]]} + next + } + Page instproc regsub-eval {re string cmd} { subst [regsub -all $re [string map {\[ \\[ \] \\] \$ \\$ \\ \\\\} $string] \ "\[$cmd\]"] @@ -688,7 +689,7 @@ return "$ch$label" } - my instvar parent_id + my instvar parent_id package_id # do we have a language link (it starts with a ':') if {[regexp {^:(..):(.*)$} $link _ lang stripped_name]} { set link_type language @@ -702,20 +703,14 @@ regexp {^(..):(.+)$} $link _ lang stripped_name } } - set stripped_name [string trim $stripped_name] - if {$lang eq ""} {set lang [my lang]} + set stripped_name [Page normalize_name -package_id $package_id $stripped_name] + if {$lang eq ""} {set lang [my lang]} if {$label eq $arg} {set label $stripped_name} - # if subst_blank_in_name is turned on, turn spaces into _ - if {[$parent_id get_payload subst_blank_in_name] == 1} { - regsub -all { } $stripped_name "_" stripped_name - } - - #my log "--LINK lang=$lang type=$link_type stripped_name=$stripped_name" Link create [self]::link \ -type $link_type -name $lang:$stripped_name -lang $lang \ -stripped_name $stripped_name -label $label \ - -folder_id $parent_id -package_id [$parent_id set package_id] + -folder_id $parent_id -package_id $package_id return $ch[[self]::link render] } @@ -754,7 +749,7 @@ } Page instproc adp_subst {content} { - set __ignorelist [list RE __defaults name_method object_type_key url_prefix] + set __ignorelist [list RE __defaults name_method object_type_key] foreach __v [my info vars] { if {[info exists $__v]} continue my instvar $__v @@ -783,7 +778,7 @@ } Page instproc get_content {} { - my log "--" + #my log "--" set content [my substitute_markup [my set text]] } @@ -838,11 +833,10 @@ Page instproc record_last_visited {-user_id} { - my instvar parent_id item_id + my instvar item_id package_id if {![info exists user_id]} {set user_id [ad_conn user_id]} if {$user_id > 0} { # only record information for authenticated users - set package_id [$parent_id set package_id] db_dml update_last_visisted \ "update xowiki_last_visited set time = current_timestamp, count = count + 1 \ where page_id = $item_id and user_id = $user_id" @@ -858,6 +852,16 @@ # Methods of ::xowiki::PlainPage # + PlainPage parameter { + {render_adp 0} + } + PlainPage array set RE { + include {([^\\]){{(.+)}}[ \n\r]} + anchor {([^\\])\\\[\\\[([^\]]+)\\\]\\\]} + div {()([^\\])>>([^<]*)<<} + clean {[\\](\{\{|>>|\[\[)} + } + PlainPage instproc get_content {} { #my log "-- my class=[my info class]" return [my substitute_markup [my set text]] @@ -878,9 +882,15 @@ } # - # PageInstance methods + # PageTemplate specifics # + PageTemplate parameter { + {render_adp 0} + } + # + # PageInstance methods + # PageInstance instproc get_field_type {name template default_spec} { # get the widget field specifications from the payload of the folder object # for a field with a specified name in a specified page template @@ -932,6 +942,11 @@ # Methods of ::xowiki::Object # + #Object instproc save_new {} { + #my set text [::Serializer deepSerialize [self]] + #next + #} + Object instproc get_content {} { if {[[self]::payload info procs content] ne ""} { return [my substitute_markup [[self]::payload content]] @@ -946,15 +961,18 @@ } Object instproc set_payload {cmd} { set payload [self]::payload - if {![my isobject $payload]} {::xotcl::Object create $payload -requireNamespace} + if {[my isobject $payload]} {$payload destroy} + ::xotcl::Object create $payload -requireNamespace if {[catch {$payload eval $cmd} error ]} { ns_log error "XoWiki folder object: content lead to error: $error" } } - Object instproc get_payload {var} { + Object instproc get_payload {var {default ""}} { set payload [self]::payload if {![my isobject $payload]} {::xotcl::Object create $payload -requireNamespace} - expr {[$payload exists $var] ? [$payload set $var] : ""} + expr {[$payload exists $var] ? [$payload set $var] : $default} } -} \ No newline at end of file +} + +source [file dirname [info script]]/xowiki-www-procs.tcl \ No newline at end of file