$msg

" + } elseif {[string match left-col* $arg] \ + || [string match right-col* $arg] \ + || $arg eq "sidebar"} { + return "$ch

" + } elseif {$arg eq "box"} { + return "$ch

" + } elseif {$arg eq ""} { + return "$ch

" + } else { + return $ch + } + } + Page instproc anchor {ch arg} { + set label $arg + set link $arg + set options "" + regexp {^([^|]+)[|](.*)$} $arg _ link label + regexp {^([^|]+)[|](.*)$} $label _ label options + if {[string match "http*//*" $link] || [string match "//*" $link]} { + regsub {^//} $link / link + set l [ExternalLink new -label $label -href $link] + eval $l configure $options + set html [$l render] + $l destroy + return "$ch$html" + } + + set name "" + 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 + } elseif {[regexp {^(file|image|swf):(.*)$} $link _ link_type stripped_name]} { + set lang "" + set name $link + } else { + # do we have a typed link? + if {![regexp {^([^:][^:][^:]+):((..):)?(.+)$} $link _ link_type _ lang stripped_name]} { + # must be an untyped link; defaults, in case the second regexp does not match either + set lang "" + set link_type link + set stripped_name $link + regexp {^(..):(.+)$} $link _ lang stripped_name + } + } + set normalized_name [::$package_id normalize_name $stripped_name] + if {$lang eq ""} {set lang [my lang]} + if {$name eq ""} {set name $lang:$normalized_name} + if {$label eq $arg} {set label $stripped_name} + + Link create [self]::link \ + -page [self] \ + -type $link_type -name $name -lang $lang \ + -stripped_name $normalized_name -label $label \ + -folder_id $parent_id -package_id $package_id + + if {[catch {eval [self]::link configure $options} error]} { + return "${ch}

Error during processing of options: $error

" + } else { + return $ch[[self]::link render] + } + } + + + Page instproc substitute_markup {source} { + set baseclass [expr {[[my info class] exists RE] ? [my info class] : [self class]}] + $baseclass instvar RE + #my log "-- baseclass for RE = $baseclass" + if {[my set mime_type] eq "text/enhanced"} { + set source [ad_enhanced_text_to_html $source] + } + set content "" + set l " "; #use one byte trailer for regexps for escaped content + foreach l0 [split [lindex $source 0] \n] { + append l $l0 + if {[string first \{\{ $l] > -1 && [string first \}\} $l] == -1} continue + set l [my regsub_eval $RE(anchor) $l {my anchor "\1" "\2"}] + set l [my regsub_eval $RE(div) $l {my div "\2" "\3"}] + set l [my regsub_eval $RE(include) $l {my include "\\\1" "\2" "\3"}] + regsub -all $RE(clean) $l {\1} l + regsub -all $RE(clean2) $l { \1} l + append content [string range $l 1 end] \n + set l " " + } + #my log "--substitute_markup returns $content" + return $content + } + + Page instproc adp_subst {content} { + #my log "--adp_subst in [my name]" + set __ignorelist [list RE __defaults name_method object_type_key] + foreach __v [my info vars] { + if {[info exists $__v]} continue + my instvar $__v + } + foreach __v [[my info class] info vars] { + if {[lsearch -exact $__ignorelist $__v]>-1} continue + if {[info exists $__v]} continue + [my info class] instvar $__v + } + set __ignorelist [list __v __ignorelist __varlist __template_variables__ \ + text item_id content lang_links] + set __varlist [list] + set __template_variables__ "

$__v: '[set $__v]'\n" + } + append __template_variables__ "

\n" + regsub -all [template::adp_variable_regexp] $content {\1@\2;noquote@} content + #my log "--adp before adp_eval '[template::adp_level]'" + # + # The adp buffer has limited size. For large pages, it might happen + # that the buffer overflows. In Aolserver 4.5, we can increase the + # buffer size. In 4.0.10, we are out of luck. + # + set l [string length $content] + if {[catch {set bufsize [ns_adp_ctl bufsize]}]} { + set bufsize 0 + } + if {$bufsize > 0 && $l > $bufsize} { + # we have aolserver 4.5, we can increase the bufsize + ns_adp_ctl bufsize [expr {$l + 1024}] + } + set template_code [template::adp_compile -string $content] + set my_parse_level [template::adp_level] + if {[catch {set template_value [template::adp_eval template_code]} errMsg]} { + set ::template::parse_level $my_parse_level + #my log "--adp after adp_eval '[template::adp_level]' mpl=$my_parse_level" + return "

Error in Page $name: $errMsg

$content

Possible values are$__template_variables__" + } + return $template_value + } + + Page instproc get_description {content} { + my instvar revision_id + set description [my set description] + if {$description eq "" && $content ne ""} { + set description [ad_html_text_convert -from text/html -to text/plain -- $content] + } + if {$description eq "" && $revision_id > 0} { + set description [db_string [my qn get_description_from_syndication] \ + "select body from syndication where object_id = $revision_id" \ + -default ""] + } + return $description + } + + Page instproc get_content {} { + #my log "--" + return [my substitute_markup [my set text]] + } + Page instproc set_content {text} { + my text [list [string map [list >> "\n
>>" << "<<\n"] \ + [string trim $text " \n"]] text/html] + } + + Page instproc get_rich_text_spec {field_name default} { + my instvar package_id + set spec "" + foreach {s widget_spec} [$package_id get_parameter widget_specs] { + foreach {page_name var_name} [split $s ,] break + # 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, $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" + break + } + } + if {$spec eq ""} {return $default} + return $field_name:$spec + } + + Page instproc validate=name {name} { + upvar nls_language nls_language + my set data [self] ;# for the time being; change clobbering when validate_name becomes a method + set success [::xowiki::validate_name] + if {$success} { + # set the instance variable with a potentially prefixed name + # the classical validators do just an upvar + my set name $name + } + return $success + } + Page instproc validate=page_order {value} { + if {[my exists page_order]} { + set page_order [string trim $value " ."] + my page_order $page_order + } + return 1 + } + + Page instproc update_references {page_id references} { + db_dml [my qn delete_references] \ + "delete from xowiki_references where page = $page_id" + foreach ref $references { + foreach {r link_type} $ref break + db_dml [my qn insert_reference] \ + "insert into xowiki_references (reference, link_type, page) \ + values ($r,:link_type,$page_id)" + } + } + + Page proc container_already_rendered {field} { + if {![info exists ::xowiki_page_item_id_rendered]} { + return "" + } + #my log "--OMIT and not $field in ([join $::xowiki_page_item_id_rendered ,])" + return "and not $field in ([join $::xowiki_page_item_id_rendered ,])" + } + + Page instproc footer {} { + return "" + } + + Page instproc render {-update_references:switch} { + my instvar item_id revision_id references lang render_adp unresolved_references parent_id + my array set lang_links {found "" undefined ""} + #my log "-- my class=[my info class]" + set name [my set name] + regexp {^(..):(.*)$} $name _ lang name + set references [list] + set unresolved_references 0 + #my log "--W setting unresolved_references to 0 [info exists unresolved_references]" + set content [my get_content] + #my log "--W after content [info exists unresolved_references] [my exists unresolved_references] ?? [info vars]" + if {$update_references || $unresolved_references > 0} { + my update_references $item_id [lsort -unique $references] + } + set html [expr {$render_adp ? [my adp_subst $content] : $content}] + if {![my exists __no_footer]} {append html [my footer]} + return $html + } + + Page instproc record_last_visited {-user_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 + 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] \ + "insert into xowiki_last_visited (page_id, package_id, user_id, count, time) \ + values ($item_id, $package_id, $user_id, 1, current_timestamp)" + } + } + } + + # + # Some utility functions, called on different kind of pages + # + + Page instproc lookup_form_field { + -name + form_fields + } { + set found 0 + foreach f $form_fields { + if {[$f name] eq $name} {set found 1; break} + } + if {!$found && [regexp {^([^.]+)[.](.*)$} $name _ container component]} { + # components of a field + set f [my lookup_form_field -name $container $form_fields]::$component + set found 1 + } + if {!$found} { + error "No form field with name $name found" + } + return $f + } + + Page instproc show_fields {form_fields} { + # this method is for debugging only + set msg "" + foreach f $form_fields { append msg "[$f name] [$f info class], " } + my msg $msg + } + + + # + # Methods of ::xowiki::PlainPage + # + + PlainPage parameter { + {render_adp 0} + } + PlainPage array set RE { + include {([^\\]){{(.+?)}}[ \n\r]} + anchor {([^\\])\\\[\\\[([^\]]+?)\\\]\\\]} + div {()([^\\])>>([^<]*?)<<} + clean {[\\](\{\{|>>|\[\[)} + clean2 {(--DUMMY NOT USED--)} + } + + PlainPage instproc get_content {} { + #my log "-- my class=[my info class]" + return [my substitute_markup [my set text]] + } + PlainPage instproc set_content {text} { + my text $text + } + + PlainPage instproc substitute_markup {source} { + [self class] instvar RE + set content "" + foreach l [split $source \n] { + set l " $l" + set l [my regsub_eval $RE(anchor) $l {my anchor "\1" "\2"}] + set l [my regsub_eval $RE(div) $l {my div "\2" "\3"}] + set l [my regsub_eval $RE(include) $l {my include "\1" "\2" ""}] + regsub -all $RE(clean) $l {\1} l + append content [string range $l 1 end] \n + } + return $content + } + + # + # Methods of ::xowiki::File + # + + File parameter { + {render_adp 0} + } + File instproc complete_name {name {fn ""}} { + my instvar mime_type package_id + switch -glob -- $mime_type { + image/* {set type image} + default {set type file} + } + if {$name ne ""} { + set stripped_name $name + regexp {^(.*):(.*)$} $name _ _t stripped_name + } else { + set stripped_name $fn + } + return ${type}:[::$package_id normalize_name $stripped_name] + } + File instproc full_file_name {} { + 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 [db_string [my qn 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 get_content {} { + my instvar name mime_type description parent_id package_id creation_user + # don't require permissions here, such that rss can present the link + set page_link [$package_id make_link -privilege public [self] download ""] + #my log "--F page_link=$page_link ---- " + set t [TableWidget new -volatile \ + -columns { + AnchorField name -label [_ xowiki.Page-name] + Field mime_type -label "Content Type" + Field last_modified -label "Last Modified" + Field mod_user -label "By User" + Field size -label "Size" + }] + + regsub {[.][0-9]+([^0-9])} [my set last_modified] {\1} last_modified + regexp {^([^:]+):(.*)$} $name _ link_type stripped_name + set label $stripped_name + + $t add \ + -name $stripped_name \ + -mime_type $mime_type \ + -name.href $page_link \ + -last_modified $last_modified \ + -mod_user [::xo::get_user_name $creation_user] \ + -size [file size [my full_file_name]] + + if {$link_type eq "image"} { + set l [Link new -volatile \ + -page [self] \ + -type $link_type -name $name -lang "" \ + -stripped_name $stripped_name -label $label \ + -folder_id $parent_id -package_id $package_id] + set image "

[$l render]

" + } else { + set image "" + } + return "$image

[$t asHTML]

$description

" + } + + PodcastItem instproc get_content {} { + set content [next] + append content

$i: [my set $i]\n" + } + append content

+ return $content + } + + # + # PageTemplate specifics + # + PageTemplate parameter { + {render_adp 0} + } + PageTemplate instproc count_usages {{-all false}} { + return [::xowiki::PageTemplate count_usages -item_id [my item_id] -all $all] + } + + PageTemplate proc count_usages {-item_id:required {-all:boolean false}} { + set publish_status_clause [expr {$all ? "" : " and i.publish_status <> 'production' "}] + set count [db_string [my qn count_usages] \ + "select count(page_instance_id) from xowiki_page_instance, cr_items i \ + where page_template = $item_id \ + $publish_status_clause \ + and page_instance_id = coalesce(i.live_revision,i.latest_revision)"] + return $count + } + + # + # PageInstance methods + # + + PageInstance proc get_short_spec_from_form_constraints {-name -form_constraints} { + foreach name_and_spec $form_constraints { + foreach {spec_name short_spec} [split $name_and_spec :] break + if {$spec_name eq $name} { + #my msg "get_short_spec $name returns 1 $short_spec" + return $short_spec + } + } + return "" + } + + PageInstance instproc get_short_spec {name} { + #my msg "get_short_spec $name" + my instvar page_template + # in the old-fashioned 2-form page-instance create, page_template + # might be non-existant or empty. + if {[info exists page_template] && $page_template ne "" && + [$page_template exists form_constraints]} { + set short_spec [::xowiki::PageInstance get_short_spec_from_form_constraints \ + -name $name -form_constraints [$page_template form_constraints]] + if {$short_spec ne ""} { + return $short_spec + } + } + return "" + } + + PageInstance instproc get_field_label {name value} { + set short_spec [my get_short_spec $name] + if {$short_spec ne ""} { + set f [FormField new -volatile -name $name -spec $short_spec] + return [$f pretty_value $value] + } + return $value + } + PageInstance instproc widget_spec_from_folder_object {name given_template_name} { + # get the widget field specifications from the payload of the folder object + # for a field with a specified name in a specified page template + my instvar page_template + foreach {s widget_spec} [[my set parent_id] get_payload widget_specs] { + foreach {template_name var_name} [split $s ,] break + #ns_log notice "--w T.title = '$given_template_name' var=$name" + if {([string match $template_name $given_template_name] || $given_template_name eq "") && + [string match $var_name $name]} { + return $widget_spec + #ns_log notice "--w using $widget for $name" + } + } + return "" + } + PageInstance instproc get_field_type {name default_spec} { + my instvar page_template + # get widget spec from folder (highest priority) + set spec [my widget_spec_from_folder_object $name [$page_template set name]] + if {$spec ne ""} { + return $spec + } + # get widget spec from attribute definition + set f [my create_form_field -name $name -slot [my find_slot $name]] + if {$f ne ""} { + return [$f asWidgetSpec] + } + # use default widget spec + return $default_spec + } + + PageInstance instproc get_from_template {var} { + my instvar page_template + #my log "-- fetching page_template = $page_template" + ::Generic::CrItem instantiate -item_id $page_template + $page_template destroy_on_cleanup + return [$page_template set $var] + } + + PageInstance instproc get_content {} { + set raw_template [my get_from_template text] + set T [my adp_subst [lindex $raw_template 0]] + return [my substitute_markup [list $T [lindex $raw_template 1]]] + } + PageInstance instproc template_vars {content} { + set result [list] + foreach {_ _ v} [regexp -inline -all [template::adp_variable_regexp] $content] { + lappend result $v "" + } + return $result + } + 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] + foreach var [array names __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] + } else { + set value $__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 + my set $var [my get_field_label $var $value] + } + next + } + + # + # Methods of ::xowiki::Object + # + + Object instproc get_content {} { + if {[[self]::payload info methods content] ne ""} { + return [my substitute_markup [[self]::payload content]] + } else { + return "

[string map {> > < <} [my set text]]

" + } + } + + Object instproc initialize_loaded_object {} { + my set_payload [my set text] + next + } + Object instproc set_payload {cmd} { + set payload [self]::payload + if {[my isobject $payload]} {$payload destroy} + ::xo::Context create $payload -requireNamespace \ + -actual_query [::xo::cc actual_query] + $payload set package_id [my set package_id] + if {[catch {$payload contains $cmd} error ]} { + ns_log error "content $cmd lead to error: $error" + } + #my log "call init mixins=[my info mixin]//[$payload info mixin]" + $payload init + } + Object instproc get_payload {var {default ""}} { + set payload [self]::payload + if {![my isobject $payload]} { + ::xo::Context create $payload -requireNamespace + } + expr {[$payload exists $var] ? [$payload set $var] : $default} + } + + # + # Methods of ::xowiki::Form + # + Form instproc footer {} { + return [my include_portlet [list form-menu -form_item_id [my item_id]]] + } + + Form proc disable_input_fields {form} { + dom parse -simple -html $form doc + $doc documentElement root + set fields [$root selectNodes "//button | //input | //optgroup | //option | //select | //textarea "] + foreach field $fields { + $field setAttribute disabled "disabled" + } + return [$root asHTML] + } + + Form instproc get_content {} { + my instvar text form + ::xowiki::Form requireFormCSS + + # we assume, that the richtext is stored as 2-elem list with mime-type + #my log "-- text='$text'" + if {[lindex $text 0] ne ""} { + set content [my substitute_markup [my set text]] + } elseif {[lindex $form 0] ne ""} { + set content [[self class] disable_input_fields [lindex $form 0]] + } else { + set content "" + } + return $content + } + + Form instproc list {} { + my view [my include_portlet [list form-usages -form_item_id [my item_id]]] + } + + + Form instproc validate=form_constraints {form_constraints} { + # + # First check for invalid meta characters for security reasons. + # + if {[regexp {[\[\]]} $form_constraints]} { + my uplevel [list set errorMsg [_ xowiki.error-form_constraint-invalid_characters]] + return 0 + } + # + # Create from fields from all specs and report, if there are any errors + # + foreach name_and_spec $form_constraints { + foreach {spec_name short_spec} [split $name_and_spec :] break + if {$spec_name eq "@table" || $spec_name eq "@categories"} continue + + #my msg "checking spec '$short_spec' for form field '$spec_name'" + if {[catch { + set f [my create_form_field \ + -name $spec_name \ + -slot [my find_slot $spec_name] \ + -spec $short_spec] + $f destroy + } errorMsg]} { + my uplevel [list set errorMsg $errorMsg] + #my msg "ERROR: invalid spec '$short_spec' for form field '$spec_name' -- $errorMsg" + return 0 + } + } + return 1 + } + + + # + # Methods of ::xowiki::FormPage + # + FormPage instproc footer {} { + if {[my exists __no_form_page_footer]} { + next + } else { + return [my include_portlet [list form-entry-menu]] + } + } + + FormPage instproc form_attributes {} { + # + # this method returns the form attributes (including _*) + # + my instvar page_template + set dont_edit [concat [[my info class] edit_atts] [list title] \ + [::Generic::CrClass set common_query_atts]] + + set template [lindex [my get_from_template text] 0] + #set field_names [list _name _title _description _creator _nls_language _page_order] + set field_names [list] + set form [lindex [my get_from_template form] 0] + if {$form eq ""} { + foreach {var _} [my template_vars $template] { + #if {[string match _* $var]} continue + if {[lsearch $dont_edit $var] == -1} {lappend field_names $var} + } + set form_vars 0 + } else { + foreach {match 1 att} [regexp -all -inline [template::adp_variable_regexp] $form] { + #if {[string match _* $att]} continue + lappend field_names $att + } + dom parse -simple -html $form doc + $doc documentElement root + set fields [$root selectNodes "//*\[@name != ''\]"] + foreach field $fields { + set node_name [$field nodeName] + if {$node_name ne "input" + && $node_name ne "textarea" + && $node_name ne "select" + } continue + set att [$field getAttribute name] + #if {[string match _* $att]} continue + if {[lsearch $field_names $att] == -1} { + lappend field_names $att + } + } + set form_vars 1 + } + return [list $form_vars $field_names] + } + + + FormPage instproc get_content {} { + my instvar doc root package_id page_template + set text [lindex [my get_from_template text] 0] + if {$text ne ""} { + #my msg "we have a template text='$text'" + # we have a template + return [next] + } else { + ::xowiki::Form requireFormCSS + set form [lindex [my get_from_template form] 0] + foreach {form_vars field_names} [my form_attributes] break + set form_fields [my create_form_fields $field_names] + set form [my regsub_eval \ + [template::adp_variable_regexp] $form \ + {my form_field_as_html -mode display "\\\1" "\2" $form_fields}] + + dom parse -simple -html $form doc + $doc documentElement root + my set_form_data + return [Form disable_input_fields [$root asHTML]] + } + } + + FormPage instproc get_value {before varname} { + #my msg "varname=$varname" + array set __ia [my set instance_attributes] + switch -glob $varname { + _* {set value [my set [string range $varname 1 end]]} + default { + if {[info exists __ia($varname)]} { + set value [set __ia($varname)] + } elseif {[my exists $varname]} { + set value [my $varname] + } else { + my msg "**** unknown variable '$varname' ****" + #set value **** unknown variable '$varname' ****" + set value "" + } + } + } + + set f [my create_form_field -name $varname \ + -slot [my find_slot [string trimleft $varname _]] \ + -configuration [list -value $value]] + set v $value + set value [$f pretty_value $value] + #my msg "$varname [$f info class] before=$v after pretty_value=$value" + #my msg [$f serialize] + + return $before$value + } + + FormPage instproc adp_subst {content} { + set content [my regsub_eval -noquote true \ + [template::adp_variable_regexp] " $content" {my get_value "\\\1" "\2"}] + #regsub -all $content {\1@\2;noquote@} content + return [string range $content 1 end] + } + + FormPage instproc is_new_entry {old_name} { + return [expr {[my publish_status] eq "production" && $old_name eq [my revision_id]}] + } + + FormPage instproc save_data {old_name category_ids} { + #my log "-- [self args]" + my instvar package_id name + db_transaction { + # + # if the newly created item was in production mode, but ordinary entries + # are not, change on the first save the status to ready + # + if {[my is_new_entry $old_name]} { + if {![$package_id get_parameter production_mode 0]} { + my set publish_status "ready" + } + } + # could be optimized, if we do not want to have categories (form constraints?) + category::map_object -remove_old -object_id [my item_id] $category_ids + + my save + my log "-- old_name $old_name, name $name" + if {$old_name ne $name} { + my log "--formpage renaming" + db_dml [my qn update_rename] "update cr_items set name = :name \ + where item_id = [my item_id]" + } + } + return [my item_id] + } + +} + +source [file dirname [info script]]/xowiki-www-procs.tcl + Index: openacs-4/packages/xowiki/tcl/xowiki-sc-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-sc-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/tcl/xowiki-sc-procs.tcl 1 Aug 2007 21:39:24 -0000 1.21.2.2 @@ -0,0 +1,144 @@ +ad_library { + XoWiki - Search Service Contracts + + @creation-date 2006-01-10 + @author Gustaf Neumann + @cvs-id $Id: xowiki-sc-procs.tcl,v 1.21.2.2 2007/08/01 21:39:24 gustafn Exp $ +} + +namespace eval ::xowiki {} + +ad_proc -private ::xowiki::datasource { revision_id } { + @param revision_id + + returns a datasource for the search package +} { + #ns_log notice "--sc datasource called with revision_id = $revision_id" + + set page [::xowiki::Package instantiate_page_from_id -revision_id $revision_id -user_id 0] + $page volatile + + #ns_log notice "--sc package=[[$page package_id] serialize]" + ns_log notice "--sc $page [$page set publish_status]" + + if {[$page set publish_status] eq "production"} { + # no data source for for pages under construction + #ns_log notice "--sc page under construction, no datasource" + return [list object_id $revision_id title "" \ + content "" keywords "" \ + storage_type text mime text/html] + } + + $page absolute_links 1 + #ns_log notice "--sc setting absolute links for page = $page [$page set name]" + + set html [$page render] + set text [ad_html_text_convert -from text/html -to text/plain -- $html] + #set text [ad_text_to_html $html]; #this could be used for entity encoded html text in rss entries + + #::xowiki::notification::do_notifications -page $page -html $html -text $text + + #ns_log notice "--sc INDEXING $revision_id -> $text" + #$page set unresolved_references 0 + $page instvar item_id + # cleanup old stuff. This might run into an error, when search is not + # configured, and therefore txt does not exist. TODO: we should look for a better + # solution, where syndication does not depend on search.... + catch { + db_dml delete_old_revisions { + delete from txt where object_id in \ + (select revision_id from cr_revisions + where item_id = :item_id and revision_id != :revision_id) + } + } + 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 + } + } + } + #ns_log notice "--sc keywords $revision_id -> [array names word]" + + return [list object_id $revision_id title [$page title] \ + content $text keywords [array names word] \ + storage_type text mime text/html \ + syndication [list \ + link [::[$page package_id] pretty_link -absolute 1 [$page set name]] \ + description $text \ + author [$page set creator] \ + category "" \ + guid "$item_id" \ + pubDate [$page set last_modified]] \ + ] +} + +ad_proc -private ::xowiki::url { revision_id} { + returns a url for a message to the search package +} { + return [::xowiki::Package get_url_from_id -revision_id $revision_id] +} + + +namespace eval ::xowiki::sc { + + ad_proc -private ::xowiki::sc::register_implementations {} { + Register the content type fts contract + } { + acs_sc::impl::new_from_spec -spec { + name "::xowiki::Page" + aliases { + datasource ::xowiki::datasource + url ::xowiki::url + } + contract_name FtsContentProvider + owner xowiki + } + acs_sc::impl::new_from_spec -spec { + name "::xowiki::PlainPage" + aliases { + datasource ::xowiki::datasource + url ::xowiki::url + } + contract_name FtsContentProvider + owner xowiki + } + acs_sc::impl::new_from_spec -spec { + name "::xowiki::PageInstance" + aliases { + datasource ::xowiki::datasource + url ::xowiki::url + } + contract_name FtsContentProvider + owner xowiki + } + acs_sc::impl::new_from_spec -spec { + name "::xowiki::FormPage" + aliases { + datasource ::xowiki::datasource + url ::xowiki::url + } + contract_name FtsContentProvider + owner xowiki + } + acs_sc::impl::new_from_spec -spec { + name "::xowiki::File" + aliases { + datasource ::xowiki::datasource + url ::xowiki::url + } + contract_name FtsContentProvider + owner xowiki + } +} + + ad_proc -private ::xowiki::sc::unregister_implementations {} { + acs_sc::impl::delete -contract_name FtsContentProvider -impl_name ::xowiki::Page + acs_sc::impl::delete -contract_name FtsContentProvider -impl_name ::xowiki::PlainPage + acs_sc::impl::delete -contract_name FtsContentProvider -impl_name ::xowiki::PageInstance + acs_sc::impl::delete -contract_name FtsContentProvider -impl_name ::xowiki::FormPage + acs_sc::impl::delete -contract_name FtsContentProvider -impl_name ::xowiki::File + } +} + Index: openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 1 Aug 2007 21:39:25 -0000 1.95.2.2 @@ -0,0 +1,1082 @@ +ad_library { + XoWiki - www procs. These procs are the methods called on xowiki pages via + the web interface. + + @creation-date 2006-04-10 + @author Gustaf Neumann + @cvs-id $Id: xowiki-www-procs.tcl,v 1.95.2.2 2007/08/01 21:39:25 gustafn Exp $ +} + + +namespace eval ::xowiki { + + Page instproc htmlFooter {{-content ""}} { + my instvar package_id description + if {[my exists __no_footer]} {return ""} + + set footer "

" + + if {$description eq ""} { + set description [my get_description $content] + } + + #set ::META(description) $description + + if {[ns_conn isconnected]} { + set url "[ns_conn location][::xo::cc url]" + set package_url "[ns_conn location][$package_id package_url]" + } + + if {[$package_id get_parameter "with_tags" 1] && + ![my exists_query_parameter no_tags] && + [::xo::cc user_id] != 0 + } { + set tag_content "[my include_portlet my-tags]
" + set tag_includelet [my set __last_includelet] + set tags [$tag_includelet set tags] + } else { + set tag_content "" + set tags "" + } + + if {[$package_id get_parameter "with_digg" 0] && [info exists url]} { + append footer "

" \ + [my include_portlet [list digg -description $description -url $url]] "

\n" + } + + if {[$package_id get_parameter "with_delicious" 0] && [info exists url]} { + append footer "

" \ + [my include_portlet [list delicious -description $description -url $url -tags $tags]] \ + "

\n" + } + + if {[$package_id get_parameter "with_yahoo_publisher" 0] && [info exists package_url]} { + append footer "

" \ + [my include_portlet [list my-yahoo-publisher \ + -publisher [::xo::get_user_name [::xo::cc user_id]] \ + -rssurl "$package_url?rss"]] \ + "

\n" + } + + append footer [my include_portlet my-references]
+ + if {[$package_id get_parameter "show_per_object_categories" 1]} { + append footer [my include_portlet my-categories]
+ set categories_includelet [my set __last_includelet] + } + + append footer $tag_content + + if {[$package_id get_parameter "with_general_comments" 0] && + ![my exists_query_parameter no_gc]} { + append footer [my include_portlet my-general-comments]
+ } + + return "

$footer

\n" + } + +} + +namespace eval ::xowiki { + + Page instproc view {{content ""}} { + # view is used only for the toplevel call, when the xowiki page is viewed + # this is not inteded for embedded wiki pages + my instvar package_id item_id + $package_id instvar folder_id ;# this is the root folder + ::xowiki::Page set recursion_count 0 + + set template_file [my query_parameter "template_file" \ + [::$package_id get_parameter template_file view-default]] + + if {[my isobject ::xowiki::$template_file]} { + $template_file before_render [self] + } + + if {$content eq ""} { + set content [my render] + } + #my log "--after render" + set footer [my htmlFooter -content $content] + + set top_portlets "" + set vp [$package_id get_parameter "top_portlet" ""] + if {$vp ne ""} { + set top_portlets [my include_portlet $vp] + } + + if {[$package_id get_parameter "with_user_tracking" 1]} { + my record_last_visited + } + + # Deal with the views package (many thanks to Malte for this snippet!) + if {[$package_id get_parameter with_views_package_if_available 1] + && [apm_package_installed_p "views"]} { + views::record_view -object_id $item_id -viewer_id [::xo::cc user_id] + array set views_data [views::get -object_id $item_id] + } + + # import title, name and text into current scope + my instvar title name text + + if {[my exists_query_parameter return_url]} { + set return_url [my query_parameter return_url] + } + + if {[$package_id get_parameter "with_notifications" 1]} { + if {[::xo::cc user_id] != 0} { ;# notifications require login + set notifications_return_url [expr {[info exists return_url] ? $return_url : [ad_return_url]}] + set notification_type [notification::type::get_type_id -short_name xowiki_notif] + set notification_text "Subscribe the XoWiki instance" + set notification_subscribe_link \ + [export_vars -base /notifications/request-new \ + {{return_url $notifications_return_url} + {pretty_name $notification_text} + {type_id $notification_type} + {object_id $package_id}}] + set notification_image \ + "

" + } + } + #my log "--after notifications [info exists notification_image]" + + set master [$package_id get_parameter "master" 1] + #if {[my exists_query_parameter "edit_return_url"]} { + # set return_url [my query_parameter "edit_return_url"] + #} + my log "--after options" + + if {$master} { + set context [list $title] + set autoname [$package_id get_parameter autoname 0] + set object_type [$package_id get_parameter object_type [my info class]] + set rev_link [$package_id make_link [self] revisions] + set edit_link [$package_id make_link [self] edit return_url] + set delete_link [$package_id make_link [self] delete return_url] + if {[my istype ::xowiki::FormPage]} { + set template_id [my page_template] + set form [$package_id pretty_link [$template_id name]] + set new_link [$package_id make_link -link $form $template_id create-new return_url] + } else { + set new_link [$package_id make_link $package_id edit-new object_type return_url autoname] + } + set admin_link [$package_id make_link -privilege admin -link admin/ $package_id {} {}] + set index_link [$package_id make_link -privilege public -link "" $package_id {} {}] + set create_in_req_locale_link "" + + if {[$package_id get_parameter use_connection_locale 0]} { + $package_id get_name_and_lang_from_path \ + [$package_id set object] req_lang req_local_name + set default_lang [$package_id default_language] + if {$req_lang ne $default_lang} { + set l [Link create new -destroy_on_cleanup \ + -page [self] -type language -stripped_name $req_local_name \ + -name ${default_lang}:$req_local_name -lang $default_lang \ + -label $req_local_name -folder_id $folder_id \ + -package_id $package_id -init \ + -return_only undefined] + $l render + } + } + + #my log "--after context delete_link=$delete_link " + set template [$folder_id get_payload template] + set page [self] + + if {$template ne ""} { + set __including_page $page + set __adp_stub [acs_root_dir]/packages/xowiki/www/view-default + set template_code [template::adp_compile -string $template] + if {[catch {set content [template::adp_eval template_code]} errmsg]} { + ns_return 200 text/html "Error in Page $name: $errmsg
$template" + } else { + ns_return 200 text/html $content + } + } else { + + # use adp file + foreach css [$package_id get_parameter extra_css ""] {::xowiki::Page requireCSS $css} + # refetch it, since it might have been changed via set-parameter + set template_file [my query_parameter "template_file" \ + [::$package_id get_parameter template_file view-default]] + + if {![regexp {^[./]} $template_file]} { + set template_file /packages/xowiki/www/$template_file + } + set header_stuff [::xowiki::Page header_stuff] + $package_id return_page -adp $template_file -variables { + name title item_id context header_stuff return_url + content footer package_id + rev_link edit_link delete_link new_link admin_link index_link + notification_subscribe_link notification_image + top_portlets page + views_data + } + } + } else { + ns_return 200 [::xo::cc get_parameter content-type text/html] $content + } + } +} + + +namespace eval ::xowiki { + + Page instproc edit { + {-new:boolean false} + {-autoname:boolean false} + {-validaton_errors ""} + } { + my instvar package_id item_id revision_id + $package_id instvar folder_id ;# this is the root folder + + # set some default values if they are provided + foreach key {name title page_order last_page_id} { + if {[$package_id exists_query_parameter $key]} { + my set $key [$package_id query_parameter $key] + } + } + if {$new} { + my set creator [::xo::get_user_name [::xo::cc user_id]] + my set nls_language [ad_conn locale] + } + + set object_type [my info class] + if {!$new && $object_type eq "::xowiki::Object" && [my set name] eq "::$folder_id"} { + # if we edit the folder object, we have to do some extra magic here, + # since the folder object has slightly different naming conventions. + # ns_log notice "--editing folder object ::$folder_id, FLUSH $page" + ns_cache flush xotcl_object_cache [self] + ns_cache flush xotcl_object_cache ::$folder_id + my move ::$folder_id + set page ::$folder_id + #ns_log notice "--move page=$page" + } + + # + # setting up folder id for file selector (use community folder if available) + # + set fs_folder_id "" + if {[info commands ::dotlrn_fs::get_community_shared_folder] ne ""} { + set fs_folder_id [::dotlrn_fs::get_community_shared_folder \ + -community_id [::dotlrn_community::get_community_id]] + } + + # the following line is like [$package_id url], but works as well with renamed objects + # set myurl [$package_id pretty_link [my form_parameter name]] + + if {[my exists_query_parameter "return_url"]} { + set submit_link [my query_parameter "return_url" "."] + set return_url $submit_link + } else { + set submit_link "." + } + #my log "--u submit_link=$submit_link qp=[my query_parameter return_url]" + + # we have to do template mangling here; ad_form_template writes form + # variables into the actual parselevel, so we have to be in our + # own level in order to access an pass these + variable ::template::parse_level + lappend parse_level [info level] + set action_vars [expr {$new ? "{edit-new 1} object_type return_url" : "{m edit} return_url"}] + #my log "--formclass=[$object_type getFormClass -data [self]] ot=$object_type" + [$object_type getFormClass -data [self]] create ::xowiki::f1 -volatile \ + -action [export_vars -base [$package_id url] $action_vars] \ + -data [self] \ + -folderspec [expr {$fs_folder_id ne "" ?"folder_id $fs_folder_id":""}] \ + -submit_link $submit_link \ + -autoname $autoname + + if {[info exists return_url]} { + ::xowiki::f1 generate -export [list [list return_url $return_url]] + } else { + ::xowiki::f1 generate + } + + ::xowiki::f1 instvar edit_form_page_title context formTemplate + + if {[info exists item_id]} { + set rev_link [$package_id make_link [self] revisions] + set view_link [$package_id make_link [self] view] + } + if {[info exists last_page_id]} { + set back_link [$package_id url] + } + + set index_link [$package_id make_link -privilege public -link "" $package_id {} {}] + set html [$package_id return_page -adp /packages/xowiki/www/edit \ + -form f1 \ + -variables {item_id edit_form_page_title context formTemplate + view_link back_link rev_link index_link}] + template::util::lpop parse_level + #my log "--e html length [string length $html]" + return $html + } + + Page instproc find_slot {-start_class name} { + if {![info exists start_class]} { + set start_class [my info class] + } + foreach cl [concat $start_class [$start_class info heritage]] { + set slotobj ${cl}::slot::$name + if {[my isobject $slotobj]} { + #my msg $slotobj + return $slotobj + } + } + return "" + } + + Page instproc create_form_field { + -name + {-slot ""} + {-spec ""} + {-configuration ""} + } { + if {$slot eq ""} { + # We have no slot, so create a minimal slot. This should only happen for instance attributes + set slot [::xo::Attribute new -pretty_name $name -datatype text -volatile -noinit] + } + + set spec_list [list] + if {[$slot exists spec]} {lappend spec_list [$slot set spec]} + if {$spec ne ""} {lappend spec_list $spec} + #my msg "[self args] spec_list $spec_list" + #my msg "$name, spec_list = '[join $spec_list ,]'" + + if {[$slot exists pretty_name]} { + set label [$slot set pretty_name] + } else { + set label $name + my log "no pretty_name for variable $name in slot $slot" + } + + if {[$slot exists default]} { + #my msg "setting ff $name default = [$slot default]" + set default [$slot default] + } else { + set default "" + } + set f [FormField new -name $name \ + -id [::xowiki::Portlet html_id F.[my name].$name] \ + -locale [my nls_language] \ + -label $label \ + -type [expr {[$slot exists datatype] ? [$slot set datatype] : "text"}] \ + -help_text [expr {[$slot exists help_text] ? [$slot set help_text] : ""}] \ + -validator [expr {[$slot exists validator] ? [$slot set validator] : ""}] \ + -required [expr {[$slot exists required] ? [$slot set required] : "false"}] \ + -default $default \ + -spec [join $spec_list ,] \ + -object [self] \ + ] + + $f destroy_on_cleanup + eval $f configure $configuration + return $f + } + + PageInstance instproc create_form_field { + -name + {-slot ""} + {-spec ""} + {-configuration ""} + } { + set short_spec [my get_short_spec $name] + #my msg "create form field '$name', short_spec = '$short_spec', slot=$slot" + set spec_list [list] + if {$spec ne ""} {lappend spec_list $spec} + if {$short_spec ne ""} {lappend spec_list $short_spec} + #my msg "$name: short_spec '$short_spec', spec_list 1 = '[join $spec_list ,]'" + set f [next -name $name -slot $slot -spec [join $spec_list ,] -configuration $configuration] + return $f + } + +} + +namespace eval ::xowiki { + + FormPage instproc create_category_fields {} { + set category_spec [my get_short_spec @categories] + foreach f [split $category_spec ,] { + if {$f eq "off"} {return [list]} + } + + set category_fields [list] + set container_object_id [my package_id] + set category_trees [category_tree::get_mapped_trees $container_object_id] + set category_ids [category::get_mapped_categories [my item_id]] + #my msg "mapped category ids=$category_ids" + + foreach category_tree $category_trees { + foreach {tree_id tree_name subtree_id assign_single_p require_category_p} $category_tree break + + set options [list] + #if {!$require_category_p} {lappend options [list "--" ""]} + set value [list] + foreach category [category_tree::get_tree -subtree_id $subtree_id $tree_id] { + foreach {category_id category_name deprecated_p level} $category break + if {[lsearch $category_ids $category_id] > -1} {lappend value $category_id} + set category_name [ad_quotehtml [lang::util::localize $category_name]] + if { $level>1 } { + set category_name "[string repeat { } [expr {2*$level -4}]]..$category_name" + } + lappend options [list $category_name $category_id] + } + set f [FormField new \ + -name "__category_${tree_name}_$tree_id" \ + -locale [my nls_language] \ + -label $tree_name \ + -type select \ + -value $value \ + -required $require_category_p] + #my msg "category field [my name] created, value '$value'" + $f destroy_on_cleanup + $f options $options + $f multiple [expr {!$assign_single_p}] + lappend category_fields $f + } + return $category_fields + } + + FormPage instproc set_form_value {att value} { + my instvar root item_id + set fields [$root selectNodes "//*\[@name='$att'\]"] + #my msg "found field = $fields xp=//*\[@name='$att'\]" + foreach field $fields { + # TODO missing: textarea + if {[$field nodeName] ne "input"} continue + set type [expr {[$field hasAttribute type] ? [$field getAttribute type] : "text"}] + # the switch should be really different objects ad classes...., but thats HTML, anyhow. + switch $type { + checkbox {$field setAttribute checked true} + radio { + set inputvalue [$field getAttribute value] + if {$inputvalue eq $value} { + $field setAttribute checked true + } + } + hidden - + text { $field setAttribute value $value} + default {my msg "can't handle $type so far $att=$value"} + } + } + } +} + + +namespace eval ::xowiki { + + FormPage ad_instproc set_form_data {} { + Store the instance attributes in the form. + } { + #my msg "set_form_value instance attributes = [my instance_attributes]" + foreach {att value} [my instance_attributes] { + #my msg "set_form_value $att '$value'" + my set_form_value $att $value + } + } +} + + +namespace eval ::xowiki { + + FormPage ad_instproc get_form_data {form_fields} { + Get the values from the form and store it as + instance attributes. + } { + set validation_errors 0 + set category_ids [list] + array set containers [list] + array set __ia [my set instance_attributes] + + # we have a form and get all form variables + + foreach att [::xo::cc array names form_parameter] { + #my msg "getting att=$att" + switch -glob -- $att { + __category_* { + set f [my lookup_form_field -name $att $form_fields] + set value [$f value [::xo::cc form_parameter $att]] + foreach v $value {lappend category_ids $v} + } + __* { + # other internal variables (like __object_name) are ignored + } + _* { + # instance attribute fields + set f [my lookup_form_field -name $att $form_fields] + set value [$f value [::xo::cc form_parameter $att]] + set varname [string range $att 1 end] + if {![string match *.* $att]} {my set $varname $value} + } + default { + # user form content fields + set f [my lookup_form_field -name $att $form_fields] + set value [$f value [::xo::cc form_parameter $att]] + # my msg "value of $att is $value" + if {![string match *.* $att]} {set __ia($att) $value} + } + } + if {[string match *.* $att]} { + foreach {container component} [split $att .] break + lappend containers($container) $component + } + } + + # + # In a second iteration, combine the values from the components + # of a container to the value of the container. + # + foreach c [array names containers] { + switch -glob -- $c { + __* {} + _* { + set f [my lookup_form_field -name $c $form_fields] + my set [string range $c 1 end] [$f get_compound_value] + } + default { + set f [my lookup_form_field -name $c $form_fields] + set __ia($c) [$f get_compound_value] + } + } + } + + # + # Run validators + # + foreach f $form_fields { + set validation_error [$f validate [self]] + #my msg "validation of [$f name] with value '[$f value]' returns $validation_error" + if {$validation_error ne ""} { + $f error_msg $validation_error + incr validation_errors + } + } + #my log "--set instance attributes to [array get __ia]" + my set instance_attributes [array get __ia] + return [list $validation_errors $category_ids] + } + + FormPage instproc form_field_as_html {{-mode edit} before name form_fields} { + set found 0 + foreach f $form_fields { + if {[$f name] eq $name} {set found 1; break} + } + if {!$found} { + set f [my create_form_field -name $name -slot [my find_slot $name]] + } + #my msg "$name mode=$mode type=[$f set type]" + if {$mode eq "edit" || [$f display_field]} { + set html [$f asHTML] + } else { + set html @$name@ + } + #my msg "$name $html" + return ${before}$html + } +} + +namespace eval ::xowiki { + + FormPage instproc create_form_fields {field_names} { + + set form_fields [my create_category_fields] + set cr_field_spec [my get_short_spec @cr_fields] + set field_spec [my get_short_spec @fields] + + foreach att $field_names { + switch -glob -- $att { + __* {} + _* { + set varname [string range $att 1 end] + lappend form_fields [my create_form_field -name $att \ + -spec $cr_field_spec \ + -slot [my find_slot $varname]] + } + default { + lappend form_fields [my create_form_field -name $att \ + -spec $field_spec \ + -slot [my find_slot $att]] + } + } + } + return $form_fields + } + + FormPage instproc edit { + {-validation_errors ""} + } { + my instvar page_template doc root package_id + + ::xowiki::Form requireFormCSS + + set form [lindex [my get_from_template form] 0] + set anon_instances [my get_from_template anon_instances] + + if {$form eq ""} { + # + # Since we have no form, we create it on the fly + # from the template variables and the form field specifications. + # + set form "" + set formgiven 0 + } else { + set formgiven 1 + } + + foreach {form_vars needed_attributes} [my form_attributes] break + #my msg "form_vars=$form_vars needed_attributes=$needed_attributes" + if {$form_vars} {foreach v $needed_attributes {set field_in_form($v) 1}} + + # + # Remove the fields already included in auto_fields form the needed_attributes. + # The final list field_names determines the order of the fields in the form. + # + set auto_fields [list _name _page_order _creator _title _text _description _nls_language] + set reduced_attributes $needed_attributes + + foreach f $auto_fields { + set p [lsearch $reduced_attributes $f] + if {$p > -1} { + #if {$form_vars} { + #set auto_field_in_form($f) 1 + #} + set reduced_attributes [lreplace $reduced_attributes $p $p] + } + } + #my msg reduced_attributes=$reduced_attributes + #my msg fields_from_from=[array names field_in_form] + + set field_names [list _name] + if {[$package_id show_page_order]} { lappend field_names _page_order } + lappend field_names _title _creator + foreach fn $reduced_attributes { lappend field_names $fn } + foreach fn [list _text _description _nls_language] { lappend field_names $fn } + #my msg field_names=$field_names + + set form_fields [my create_form_fields $field_names] + if {$anon_instances} { + set f [my lookup_form_field -name _name $form_fields] + $f config_from_spec hidden + } + # include _text only, if explicitely needed (in form or template) + if {[lsearch $needed_attributes _text] == -1} { + #my msg "setting text hidden" + set f [my lookup_form_field -name _text $form_fields] + $f config_from_spec hidden + } + #my show_fields $form_fields + + if {[my form_parameter __form_action ""] eq "save-form-data"} { + #my msg "we have to validate" + # + # we have to valiate and save the form data + # + foreach {validation_errors category_ids} [my get_form_data $form_fields] break + if {$validation_errors != 0} { + #my msg "$validation_errors errors in $form_fields" + #foreach f $form_fields { my msg "$f: [$f name] '[$f set value]' err: [$f error_msg] " } + # reset the name in error cases to the original one + my set name [my form_parameter __object_name] + } else { + # + # we have no validation erros, so we can save the content + # + my save_data [::xo::cc form_parameter __object_name ""] $category_ids + #my log "--forminstance redirect to [$package_id pretty_link [my name]]" + $package_id returnredirect \ + [my query_parameter "return_url" [$package_id pretty_link [my name]]] + return + } + } else { + # + # display the current values + # + + if {[my is_new_entry [my name]]} { + my set creator [::xo::get_user_name [::xo::cc user_id]] + my set nls_language [ad_conn locale] + } + + array set __ia [my set instance_attributes] + foreach att $field_names { + switch -glob $att { + __* {} + _* { + set f [my lookup_form_field -name $att $form_fields] + set varname [string range $att 1 end] + $f value [my set $varname] + } + default { + set f [my lookup_form_field -name $att $form_fields] + if {[info exists __ia($att)]} { + $f value $__ia($att) + } + } + } + set ff($att) $f + } + + # for named entries, just set the entry fields to empty, + # without changing the instance variables + if {[my is_new_entry [my name]]} { + if {![$ff(_title) istype ::xowiki::FormField::hidden]} {$ff(_title) value ""} + if {!$anon_instances} {$ff(_name) value ""} + } + } + + # the following command wout be correct, but does not work due to a bug in + # tdom. + #set form [my regsub_eval \ + # [template::adp_variable_regexp] $form \ + # {my form_field_as_html "\\\1" "\2" $form_fields}] + # due to this bug, we replace the at-character by \x003 to avoid conflict withe the + # input and we insert the fields in the result from tdom. + + set form [string map [list @ \x003] $form] + #my msg form=$form + + dom parse -simple -html $form doc + $doc documentElement root + + ::require_html_procs + $root firstChild fcn + # + # prepend some fields above the HTML contents of the form + # + $root insertBeforeFromScript { + ::html::input -type hidden -name __object_name -value [my name] + ::html::input -type hidden -name __form_action -value save-form-data + + # insert automatic form fields on top + foreach att $field_names { + #if {$formgiven && ![string match _* $att]} continue + if {[info exists field_in_form($att)]} continue + set f [my lookup_form_field -name $att $form_fields] + #my msg "insert auto_field $att" + $f render_item + } + } $fcn + # + # append some fields after the HTML contents of the form + # + set submit_button_class "" + $root appendFromScript { + # append category fields + foreach f $form_fields { + if {[string match "__category_*" [$f name]]} { + $f render_item + } elseif {[$f info class] eq "::xowiki::FormField::richtext::wym"} { + set submit_button_class "wymupdate" + } + } + + # insert unreported errors and add a submit field at bottom + foreach f $form_fields { + if {[$f set error_msg] ne "" && ![$f exists error_reported]} { + $f render_error_msg + } + } + set f [::xowiki::FormField::submit_button new -destroy_on_cleanup \ + -name __form_button_ok \ + -CSSclass $submit_button_class] + $f render_content + } + set form [lindex [$root selectNodes //form] 0] + if {$form eq ""} { + my msg "no form found in page [$page_template name]" + } else { + if {[my exists_query_parameter "return_url"]} { + set return_url [my query_parameter "return_url"] + } + set url [export_vars -base [$package_id pretty_link [my name]] {{m "edit"} return_url}] + $form setAttribute action $url method POST + set oldCSSClass [expr {[$form hasAttribute class] ? [$form getAttribute class] : ""}] + $form setAttribute class [string trim "$oldCSSClass margin-form"] + } + my set_form_data + set html [$root asHTML] + + set html [my regsub_eval \ + {(^|[^\\])\x003([a-zA-Z0-9_:]+)\x003} $html \ + {my form_field_as_html "\\\1" "\2" $form_fields}] + + #my msg result=$html + my view $html + } + + + + File instproc download {} { + my instvar text mime_type package_id item_id revision_id + $package_id set mime_type $mime_type + set use_bg_delivery [expr {![catch {ns_conn contentsentlength}] && + [info command ::bgdelivery] ne ""}] + $package_id set delivery \ + [expr {$use_bg_delivery ? "ad_returnfile_background" : "ns_returnfile"}] + #my log "--F FILE=[my full_file_name]" + return [my full_file_name] + } + + Page instproc revisions {} { + my instvar package_id name item_id + set context [list [list [$package_id url] $name ] [_ xotcl-core.revisions]] + set title "[_ xotcl-core.revision_title] '$name'" + set content [next] + $package_id return_page -adp /packages/xowiki/www/revisions -variables { + content context {page_id $item_id} title + } + } + + Page instproc make-live-revision {} { + my instvar revision_id item_id package_id + #my log "--M set_live_revision($revision_id)" + ::xo::db::sql::content_item set_live_revision -revision_id $revision_id + set page_id [my query_parameter "page_id"] + ns_cache flush xotcl_object_cache ::$item_id + ::$package_id returnredirect [my query_parameter "return_url" \ + [export_vars -base [$package_id url] {{m revisions}}]] + } + + + Page instproc delete-revision {} { + my instvar revision_id package_id item_id + db_1row [my qn get_revision] "select latest_revision,live_revision from cr_items where item_id = $item_id" + ns_cache flush xotcl_object_cache ::$item_id + ns_cache flush xotcl_object_cache ::$revision_id + ::xo::db::sql::content_revision del -revision_id $revision_id + set redirect [my query_parameter "return_url" \ + [export_vars -base [$package_id url] {{m revisions}}]] + if {$live_revision == $revision_id} { + # latest revision might have changed by delete_revision, so we have to fetch here + db_1row [my qn get_revision] "select latest_revision from cr_items where item_id = $item_id" + if {$latest_revision eq ""} { + # we are out of luck, this was the final revision, delete the item + my instvar package_id name + $package_id delete -name $name -item_id $item_id + } else { + ::xo::db::sql::content_item set_live_revision -revision_id $latest_revision + } + } + if {$latest_revision ne ""} { + # otherwise, "delete" did already the redirect + ::$package_id returnredirect [my query_parameter "return_url" \ + [export_vars -base [$package_id url] {{m revisions}}]] + } + } + + Page instproc delete {} { + my instvar package_id item_id name + [my info class] delete -item_id $item_id + ::$package_id flush_references -item_id $item_id -name $name + ::$package_id returnredirect \ + [my query_parameter "return_url" [$package_id package_url]] + } + + Page instproc save-tags {} { + my instvar package_id item_id + ::xowiki::Page save_tags -user_id [::xo::cc user_id] -item_id $item_id \ + -package_id $package_id [my form_parameter new_tags] + + ::$package_id returnredirect \ + [my query_parameter "return_url" [$package_id url]] + } + + Page instproc popular-tags {} { + my instvar package_id item_id parent_id + set limit [my query_parameter "limit" 20] + set weblog_page [$package_id get_parameter weblog_page weblog] + set href [$package_id pretty_link $weblog_page]?summary=1 + + set entries [list] + db_foreach [my qn get_popular_tags] \ + [::xo::db::sql \ + -vars "count(*) as nr, tag" \ + -from "xowiki_tags" \ + -where "item_id=$item_id" \ + -groupby "tag" \ + -orderby "nr" \ + -limit $limit] { + lappend entries "$tag ($nr)" + } + ns_return 200 text/html "[_ xowiki.popular_tags_label]: [join $entries {, }]" + } + + Page instproc diff {} { + my instvar package_id + set compare_id [my query_parameter "compare_revision_id" 0] + if {$compare_id == 0} { + return "" + } + set my_page [::xowiki::Package instantiate_page_from_id -revision_id [my set revision_id]] + $my_page volatile + + set html1 [$my_page render] + set text1 [ad_html_text_convert -from text/html -to text/plain -- $html1] + set user1 [::xo::get_user_name [$my_page set creation_user]] + set time1 [$my_page set creation_date] + set revision_id1 [$my_page set revision_id] + regexp {^([^.]+)[.]} $time1 _ time1 + + set other_page [::xowiki::Package instantiate_page_from_id -revision_id $compare_id] + $other_page volatile + #$other_page absolute_links 1 + + set html2 [$other_page render] + set text2 [ad_html_text_convert -from text/html -to text/plain -- $html2] + set user2 [::xo::get_user_name [$other_page set creation_user]] + set time2 [$other_page set creation_date] + set revision_id2 [$other_page set revision_id] + regexp {^([^.]+)[.]} $time2 _ time2 + + set title "Differences for [my set name]" + set context [list $title] + + set content [::xowiki::html_diff $text2 $text1] + $package_id return_page -adp /packages/xowiki/www/diff -variables { + content title context + time1 time2 user1 user2 revision_id1 revision_id2 + } + } + + proc html_diff {doc1 doc2} { + set out "" + set i 0 + set j 0 + + #set lines1 [split $doc1 "\n"] + #set lines2 [split $doc2 "\n"] + + regsub -all \n $doc1 "
" doc1 + regsub -all \n $doc2 "
" doc2 + set lines1 [split $doc1 " "] + set lines2 [split $doc2 " "] + + foreach { x1 x2 } [list::longestCommonSubsequence $lines1 $lines2] { + foreach p $x1 q $x2 { + while { $i < $p } { + set l [lindex $lines1 $i] + incr i + #puts "R\t$i\t\t$l" + append out "$l\n" + } + while { $j < $q } { + set m [lindex $lines2 $j] + incr j + #puts "A\t\t$j\t$m" + append out "$m\n" + } + set l [lindex $lines1 $i] + incr i; incr j + #puts "B\t$i\t$j\t$l" + append out "$l\n" + } + } + while { $i < [llength $lines1] } { + set l [lindex $lines1 $i] + incr i + puts "$i\t\t$l" + append out "$l\n" + } + while { $j < [llength $lines2] } { + set m [lindex $lines2 $j] + incr j + #puts "\t$j\t$m" + append out "$m\n" + } + return $out + } + + +# Page instproc new_name {name} { +# if {$name ne ""} { +# my instvar package_id +# set name [my complete_name $name] +# set name [::$package_id normalize_name $name] +# set suffix ""; set i 0 +# set folder_id [my parent_id] +# while {[CrItem lookup -name $name$suffix -parent_id $folder_id] != 0} { +# set suffix -[incr i] +# } +# set name $name$suffix +# } +# return $name +# } + +# Page instproc create-new {} { +# my instvar package_id +# set name [my new_name [::xo::cc form_parameter name ""]] +# set class [::xo::cc form_parameter class ::xowiki::Page] +# if {[::xotcl::Object isclass $class] && [$class info heritage ::xowiki::Page] ne ""} { +# set class [::xo::cc form_parameter class ::xowiki::Page] +# set f [$class new -destroy_on_cleanup \ +# -name $name \ +# -package_id $package_id \ +# -parent_id [my parent_id] \ +# -publish_status "production" \ +# -title [my title] \ +# -text [list [::xo::cc form_parameter content ""] text/html]] +# $f save_new +# $package_id returnredirect \ +# [my query_parameter "return_url" [$package_id pretty_link $name]?m=edit] +# } +# } + + PageTemplate instproc delete {} { + my instvar package_id item_id name + set count [my count_usages -all true] + #my msg count=$count + if {$count > 0} { + append error_msg \ + [_ xowiki.error-delete_entries_first [list count $count]] \ +

\ + [my include_portlet [list form-usages -all true -form_item_id [my item_id]]] \ +

+ $package_id error_msg $error_msg + } else { + next + } + } + + Form instproc create-new {} { + my instvar package_id + set f [FormPage new -destroy_on_cleanup \ + -package_id $package_id \ + -parent_id [my parent_id] \ + -publish_status "production" \ + -page_template [my item_id]] + + # set some default values if they are provided + foreach key {name title page_order last_page_id} { + if {[$package_id exists_query_parameter $key]} { + $f set $key [$package_id query_parameter $key] + } + } + $f set __title_prefix [my title] + $f save_new + if {[my exists_query_parameter "return_url"]} { + set return_url [my query_parameter "return_url"] + } + $package_id returnredirect \ + [export_vars -base [$package_id pretty_link [$f name]] {{m edit} return_url}] + } + + + if {[apm_version_names_compare [ad_acs_version] 5.3.0] == 1} { + ns_log notice "Zen-state: 5.3.2 or newer" + Form set extraCSS "" + } else { + ns_log notice "Zen-state: pre 5.3.1, use backward compatible form css file" + Form set extraCSS "zen-forms-backward-compatibility.css" + } + Form proc requireFormCSS {} { + #my msg requireFormCSS + set css [my set extraCSS] + if {$css ne ""} { + #my msg "requireCSS $css" + ::xowiki::Page requireCSS $css + } + } + +} \ No newline at end of file Index: openacs-4/packages/xowiki/www/diff.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/diff.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/diff.adp 1 Aug 2007 21:39:25 -0000 1.2.2.2 @@ -0,0 +1,29 @@ + + @title;noquote@ + @context;noquote@ + + + + + +

+ +

Comparing +

version @revision_id1@ modified by @user1@ at @time1@ with +
version @revision_id2@ modified by @user2@ at @time2@ +

+ +@content;noquote@ + Index: openacs-4/packages/xowiki/www/edit.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/Attic/edit.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/edit.adp 1 Aug 2007 21:39:25 -0000 1.3.2.2 @@ -0,0 +1,23 @@ + + @edit_form_page_title;noquote@ + @context;noquote@ + note.title + + + +

+ #xowiki.back# · + + #xowiki.view# · + #xotcl-core.revisions# · + + #xowiki.index# +

+ + Index: openacs-4/packages/xowiki/www/error-template.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/error-template.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/error-template.adp 1 Aug 2007 21:39:25 -0000 1.2.2.2 @@ -0,0 +1,24 @@ + + @title;noquote@ + @context;noquote@ + @header_stuff;noquote@ + + + @header_stuff;noquote@ + + + +

+ #xowiki.back# · + #xowiki.index# +

Error:

+@error_msg;noquote@ +

+

Index: openacs-4/packages/xowiki/www/index.vuh =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/index.vuh,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/index.vuh 1 Aug 2007 21:39:25 -0000 1.5.2.2 @@ -0,0 +1,24 @@ +# -*- tcl -*- +::xowiki::Package initialize -ad_doc { + + This is the resolver for this package. It turns a request into + an object and executes the object with the computed method + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date July, 2006 + @cvs-id $Id: index.vuh,v 1.5.2.2 2007/08/01 21:39:25 gustafn Exp $ + +} -parameter { + {-m view} + {-folder_id:integer 0} +} + +::$package_id log "--starting... [ns_conn url] [ns_conn query] \ + form vars = [ns_set array [ns_getform]]" +#::$package_id exists_form_parameter creator +#::$package_id log "-- [::xo::cc serialize]" + +::$package_id reply_to_user [::$package_id invoke -method $m] + +::$package_id log "--i ::$package_id DONE" +ad_script_abort Index: openacs-4/packages/xowiki/www/oacs-view.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/oacs-view.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/oacs-view.adp 1 Aug 2007 21:39:25 -0000 1.39.2.2 @@ -0,0 +1,85 @@ + + + @title;noquote@ + @context;noquote@ + @header_stuff;noquote@ + + + + + + + @header_stuff;noquote@ + + + + + + + +

+ #xowiki.edit# · + #xotcl-core.revisions# · + #xowiki.new_page# · + #xowiki.delete# · + #xowiki.admin# · + #xowiki.notifications# + @notification_image;noquote@ · + #xowiki.search# · + #xowiki.index# + +

+ +

+@top_portlets;noquote@ +@content;noquote@ +

+ +@footer;noquote@ +

Index: openacs-4/packages/xowiki/www/oacs-view2.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/oacs-view2.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/oacs-view2.adp 1 Aug 2007 21:39:25 -0000 1.18.2.2 @@ -0,0 +1,117 @@ + + + @title;noquote@ + @context;noquote@ + @header_stuff;noquote@ + + + + + + + + @header_stuff;noquote@ + + + + + + + + +

+ +

+@top_portlets;noquote@ +@content;noquote@ +

+ + +

+ +@footer;noquote@ +

Index: openacs-4/packages/xowiki/www/oacs-view3.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/oacs-view3.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/oacs-view3.adp 1 Aug 2007 21:39:25 -0000 1.13.2.2 @@ -0,0 +1,117 @@ + + + @title;noquote@ + @context;noquote@ + @header_stuff;noquote@ + + + + + + + + @header_stuff;noquote@ + + + + + + + + +

+ + +

+ + + +

+ +

+Contributors +

+ +

+ + +

+@top_portlets;noquote@ +@content;noquote@ +

+ +@footer;noquote@ +

Index: openacs-4/packages/xowiki/www/portlet-ajax.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlet-ajax.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlet-ajax.adp 1 Aug 2007 21:39:25 -0000 1.1.2.2 @@ -0,0 +1,24 @@ +

+@title@ +

+ +

+... loading .... +

Index: openacs-4/packages/xowiki/www/portlet-ajax.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlet-ajax.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlet-ajax.tcl 1 Aug 2007 21:39:25 -0000 1.1.2.2 @@ -0,0 +1,8 @@ +# like portlet, except with background loading via ajax +# gustaf neumann, fecit may 2006 +::xowiki::Page requireJS "/resources/xowiki/get-http-object.js" +if {![string match "/*" $portlet]} { + set folder_id [$__including_page set parent_id] + set package_id [$folder_id set package_id] + set portlet [site_node::get_url_from_object_id -object_id $package_id]portlets/$portlet +} Index: openacs-4/packages/xowiki/www/portlet.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlet.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlet.adp 1 Aug 2007 21:39:25 -0000 1.1.2.2 @@ -0,0 +1,6 @@ +

+@title@ +

+ +

Index: openacs-4/packages/xowiki/www/portlet.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlet.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlet.tcl 1 Aug 2007 21:39:25 -0000 1.2.2.2 @@ -0,0 +1,4 @@ +# +if {![string match "/*" $portlet]} { + set portlet /packages/xowiki/www/portlets/$portlet +} Index: openacs-4/packages/xowiki/www/revisions.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/revisions.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/revisions.adp 1 Aug 2007 21:39:25 -0000 1.2.2.2 @@ -0,0 +1,15 @@ + +@title;noquote@ +@title;noquote@ +@context;noquote@ +@page_id;noquote@ + +@content;noquote@ + + +

#file-storage.lt_Comments_on_this_file# +

@gc_comments;noquote@

+ + +

@gc_link;noquote@

+ Index: openacs-4/packages/xowiki/www/view-book.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/view-book.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/view-book.adp 1 Aug 2007 21:39:25 -0000 1.10.2.2 @@ -0,0 +1,93 @@ + + @title;noquote@ + @context;noquote@ + @header_stuff;noquote@ + + + + + + + +

+ +

+@toc;noquote@ +

@top_portlets;noquote@ + + + + + +

+ +

+@footer;noquote@ +

Index: openacs-4/packages/xowiki/www/view-book.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/view-book.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/view-book.tcl 1 Aug 2007 21:39:25 -0000 1.5.2.2 @@ -0,0 +1,22 @@ +set title [[$package_id folder_id] title] +set toc [$page include_portlet [list toc -open_page $name -decoration plain -remove_levels 1]] +set i [$page set __last_includelet] +#my log "--last includelet = $i, class=[$i info class] [$page exists __is_book_page]" + +if {$i ne "" && ![$page exists __is_book_page]} { + set p [$i position] + set count [$i count] + #my log "--toc count=$count size=[$i array size page_name] indices=[lsort -integer [$i array names page_name]]" + if {$count > 0} { + set book_relpos [format %.2f%% [expr {100.0 * $p / $count}]] + + if {$p>1} {set book_prev_link [$package_id pretty_link [$i page_name [expr {$p - 1}]]]} + if {$p<$count} {set book_next_link [$package_id pretty_link [$i page_name [expr {$p + 1}]]]} + #ns_log notice "--p=$p, count=$count, relpos=$book_relpos, {100.0 * $p / $count} next=[info exists next_link], prev=[info exists prev_link]" + set page_title "

[$i current] $title

" + } else { + set book_relpos 0.0% + set page_title "

$title

" + } +} +set header_stuff [::xowiki::Page header_stuff] Index: openacs-4/packages/xowiki/www/view-default.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/view-default.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/view-default.adp 1 Aug 2007 21:39:25 -0000 1.35.2.2 @@ -0,0 +1,67 @@ + + + @title;noquote@ + @context;noquote@ + @header_stuff;noquote@ + + + + @header_stuff;noquote@ + + + + +

+@top_portlets;noquote@ +@content;noquote@ +@footer;noquote@ +

Index: openacs-4/packages/xowiki/www/view-links.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/view-links.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/view-links.adp 1 Aug 2007 21:39:25 -0000 1.25.2.2 @@ -0,0 +1,22 @@ + + +

+@top_portlets;noquote@ +@content;noquote@ + +

Index: openacs-4/packages/xowiki/www/view-page.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/view-page.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/view-page.adp 1 Aug 2007 21:39:25 -0000 1.3.2.2 @@ -0,0 +1,25 @@ +

+ +

@page_title@

+ + +@content;noquote@ +

Index: openacs-4/packages/xowiki/www/view-page.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/view-page.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/view-page.tcl 1 Aug 2007 21:39:25 -0000 1.1.2.2 @@ -0,0 +1 @@ +set page_title "[$page set page_order] [$page set title]" \ No newline at end of file Index: openacs-4/packages/xowiki/www/view-plain.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/view-plain.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/view-plain.adp 1 Aug 2007 21:39:25 -0000 1.21.2.2 @@ -0,0 +1,9 @@ + + +

+ +@top_portlets;noquote@ +@content;noquote@ + +

Index: openacs-4/packages/xowiki/www/admin/delete-type.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/delete-type.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/delete-type.tcl 1 Aug 2007 21:39:25 -0000 1.9.2.2 @@ -0,0 +1,24 @@ +::xowiki::Package initialize -ad_doc { + This deletes a type with all subtypes and instances + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Aug 11, 2006 + @cvs-id $Id: delete-type.tcl,v 1.9.2.2 2007/08/01 21:39:25 gustafn Exp $ + + @param object_type + @param query +} -parameter { + {-object_type ::xowiki::Page} + {-return_url "."} +} + +set sql [$object_type instance_select_query -with_subtypes 0 -folder_id [::$package_id folder_id]] +db_foreach retrieve_instances $sql { + permission::require_write_permission -object_id $item_id + $object_type delete -item_id $item_id +} + +# drop type requires that all pages of all xowiki instances are deleted +#foreach type [$object_type object_types -subtypes_first true] {$type drop_object_type} + +ad_returnredirect $return_url Index: openacs-4/packages/xowiki/www/admin/export.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/export.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/export.tcl 1 Aug 2007 21:39:25 -0000 1.5.2.2 @@ -0,0 +1,49 @@ +::xowiki::Package initialize -ad_doc { + export the objects of the specified type + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Aug 11, 2006 + @cvs-id $Id: export.tcl,v 1.5.2.2 2007/08/01 21:39:25 gustafn Exp $ + + @param object_type +} -parameter { + {-object_type ::xowiki::Page} + {-objects ""} +} + +set folder_id [::$package_id folder_id] +set item_ids [list] + +if {$objects eq ""} { + set sql [$object_type instance_select_query -folder_id $folder_id \ + -with_subtypes true] + db_foreach instance_select $sql { lappend item_ids $item_id } +} else { + foreach o $objects { + if {[set id [CrItem lookup -name $o -parent_id $folder_id]] != 0} { + lappend item_ids $id + } + } +} + +set content "" +foreach item_id $item_ids { + ::Generic::CrItem instantiate -item_id $item_id + # + # if the page belongs to an Form/PageTemplate, include it as well + # + if {[$item_id istype ::xowiki::PageInstance]} { + set template_id [$item_id page_template] + if {[lsearch $item_ids $template_id] == -1 && + ![info exists included($template_id)]} { + ::Generic::CrItem instantiate -item_id $template_id + $template_id volatile + append content [$template_id marshall] \n + set included($template_id) 1 + } + } + $item_id volatile + append content [$item_id marshall] \n +} + +ns_return 200 text/plain $content Index: openacs-4/packages/xowiki/www/admin/import.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/import.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/import.adp 1 Aug 2007 21:39:25 -0000 1.3.2.2 @@ -0,0 +1,29 @@ + + @title;noquote@ + @context;noquote@ + + + + + + + + + + +

+ + +	+ + + + @formerror.upload_file@ + +
+ +

+ +@msg;noquote@ +
Index + Index: openacs-4/packages/xowiki/www/admin/import.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/import.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/import.tcl 1 Aug 2007 21:39:25 -0000 1.10.2.2 @@ -0,0 +1,44 @@ +::xowiki::Package initialize -ad_doc { + import objects in xotcl format + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Aug 11, 2006 + @cvs-id $Id: import.tcl,v 1.10.2.2 2007/08/01 21:39:25 gustafn Exp $ + +} + +set msg "" +ad_form \ + -name upload_form \ + -mode edit \ + -export {fs_package_id folder_id orderby selector_type file_types} \ + -html { enctype multipart/form-data } \ + -form { + {upload_file:file(file) {html {size 30}} } + {ok_btn:text(submit) {label "[_ acs-templating.HTMLArea_SelectUploadBtn]"} + } + } \ + -on_submit { + # check file name + if {$upload_file eq ""} { + template::form::set_error upload_form upload_file \ + [_ acs-templating.HTMLArea_SpecifyUploadFilename] + break + } + + set upload_tmpfile [template::util::file::get_property tmp_filename $upload_file] + set f [open $upload_tmpfile]; set content [read $f]; close $f + + foreach o [::xowiki::Page allinstances] { $o destroy } + if {[catch {namespace eval ::xo::import $content} error]} { + set msg "Error: $error" + } else { + set msg [$package_id import -replace 0] + } + namespace delete ::xo::import + } + + +set title "Import XoWiki Pages" +set context . +ad_return_template Index: openacs-4/packages/xowiki/www/admin/importmsg.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/importmsg.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/importmsg.adp 1 Aug 2007 21:39:25 -0000 1.3.2.2 @@ -0,0 +1,7 @@ + + @title;noquote@ + @context;noquote@ + +@msg;noquote@ +
Index + Index: openacs-4/packages/xowiki/www/admin/index.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/index.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/index.adp 1 Aug 2007 21:39:25 -0000 1.5.2.2 @@ -0,0 +1,24 @@ + + @title;noquote@ + @context;noquote@ + + + +Site-Wide Categories +RSS +@t1;noquote@ + + Index: openacs-4/packages/xowiki/www/admin/index.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/index.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/index.tcl 1 Aug 2007 21:39:25 -0000 1.18.2.2 @@ -0,0 +1,67 @@ +::xowiki::Package initialize -ad_doc { + + This is the admin page for the package. It displays all of the types + of wiki pages provides links to delete them + + @author Gustaf Neumann neumann@wu-wien.ac.at + @cvs-id $Id: index.tcl,v 1.18.2.2 2007/08/01 21:39:25 gustafn Exp $ + +} -parameter { + {-object_type ::xowiki::Page} +} + +set context [list] +set title "Administer all kind of [$object_type set pretty_plural]" + +set object_type_key [$object_type set object_type_key] +set object_types [$object_type object_types] +set return_url [ns_conn url] + +TableWidget t1 -volatile \ + -actions [subst { + Action new -label "all pages" -url list + Action new -label parameters -url \ + [export_vars -base /shared/parameters {package_id return_url}] + Action new -label export -url export + Action new -label import -url import + Action new -label permissions -url [export_vars -base permissions {package_id}] + }] \ + -columns { + Field object_type -label [_ xowiki.page_type] + AnchorField instances -label Instances -html {align center} + ImageField_AddIcon edit -label "Add" -html {align center} + ImageField_DeleteIcon delete -label "Delete All" \ + -html {align center onClick "return(confirm('Delete really all?'));"} + } + +set base [::$package_id package_url] +foreach object_type $object_types { + set return_url [export_vars -base ${base}admin {object_type}] + if {[catch {set n [db_list count [$object_type instance_select_query \ + -folder_id [::$package_id set folder_id] \ + -count 1 -with_subtypes false]]}]} { + set n - + set add_title "" + set add_href "" + set delete_title "Delete all such items of this instance" + } else { + set add_title [_ xotcl-core.add [list type [$object_type pretty_name]]] + set add_href [$package_id make_link $package_id edit-new object_type return_url autoname] + set delete_title "Delete all [$object_type pretty_plural] of this instance" + } + t1 add \ + -object_type $object_type \ + -instances $n \ + -instances.href [export_vars -base ./list {object_type}] \ + -edit.href $add_href \ + -delete.href [export_vars -base delete-type {object_type}] \ + -edit.title $add_title \ + -delete.title $delete_title +} + +set t1 [t1 asHTML] + +# set up categories +set category_map_url [export_vars -base \ + [site_node::get_package_url -package_key categories]cadmin/object-map \ + { { object_id $package_id } }] \ No newline at end of file Index: openacs-4/packages/xowiki/www/admin/list.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/list.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/list.adp 1 Aug 2007 21:39:25 -0000 1.1.2.2 @@ -0,0 +1,24 @@ + + @title;noquote@ + @context;noquote@ + + + + +Site-Wide Categories... +RSS +@t1;noquote@ + Index: openacs-4/packages/xowiki/www/admin/list.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/list.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/list.tcl 1 Aug 2007 21:39:25 -0000 1.15.2.2 @@ -0,0 +1,146 @@ +::xowiki::Package initialize -ad_doc { + This is the admin page for the package. It displays all entries + provides links to create, edit and delete these + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Oct 23, 2005 + @cvs-id $Id: list.tcl,v 1.15.2.2 2007/08/01 21:39:25 gustafn Exp $ + + @param object_type show objects of this class and its subclasses +} -parameter { + {-object_type:optional} + {-orderby:optional "last_modified,desc"} +} + +set context [list index] + +# if object_type is specified, only list entries of this type; +# otherwise show types and subtypes of $supertype +if {![info exists object_type]} { + set per_type 0 + set supertype ::xowiki::Page + set object_types [$supertype object_types] + set title "List of all kind of [$supertype set pretty_plural]" + set with_subtypes true + set object_type $supertype +} else { + set per_type 1 + set object_types [list $object_type] + set title "Index of [$object_type set pretty_plural]" + set with_subtypes false +} + +set return_url [expr {$per_type ? [export_vars -base [::$package_id url] object_type] : + [::$package_id url]}] +# set up categories +set category_map_url [export_vars -base \ + [site_node::get_package_url -package_key categories]cadmin/one-object \ + { { object_id $package_id } }] + +set actions "" +foreach type $object_types { + append actions [subst { + Action new \ + -label "[_ xotcl-core.add [list type [$type pretty_name]]]" \ + -url [export_vars -base [::$package_id package_url] {{edit-new 1} {object_type $type} return_url}] \ + -tooltip "[_ xotcl-core.add_long [list type [$type pretty_name]]]" + }] +} + +set ::individual_permissions [expr {[$package_id set policy] eq "::xowiki::policy3"}] +set ::with_publish_status 1 + +TableWidget t1 -volatile \ + -actions $actions \ + -columns { + BulkAction objects -id name -actions { + Action new -label export -tooltip export -url export + } + ImageField_EditIcon edit -label "" -html {style "padding: 2px;"} + if {$::individual_permissions} { + ImageAnchorField permissions -src /resources/xowiki/permissions.png -width 16 \ + -height 16 -border 0 -title "Manage Individual Permssions for this Item" \ + -alt permsissions -label "" -html {style "padding: 2px;"} + } + if {$::with_publish_status} { + ImageAnchorField publish_status -src "" -width 8 \ + -height 8 -border 0 -title "Toggle Publish Status" \ + -alt "publish status" -label [_ xowiki.publish_status] -html {style "padding: 2px;"} + } + Field syndicated -label "RSS" -html {style "padding: 2px;"} + if {[::xo::db::has_ltree]} { + AnchorField page_order -label [_ xowiki.order] -orderby page_order -html {style "padding: 2px;"} + } + AnchorField name -label [_ xowiki.Page-name] -orderby name -html {style "padding: 2px;"} + AnchorField title -label [_ xowiki.Page-title] -orderby title + Field object_type -label [_ xowiki.page_type] -orderby object_type -html {style "padding: 2px;"} + Field size -label "Size" -orderby size -html {align right style "padding: 2px;"} + Field last_modified -label "Last Modified" -orderby last_modified + Field mod_user -label "By User" -orderby mod_user + ImageField_DeleteIcon delete -label "" ;#-html {onClick "return(confirm('Confirm delete?'));"} + } + +foreach {att order} [split $orderby ,] break +t1 orderby -order [expr {$order eq "asc" ? "increasing" : "decreasing"}] $att + +# -page_size 10 +# -page_number 1 + +set attributes [list revision_id content_length creation_user title \ + "to_char(last_modified,'YYYY-MM-DD HH24:MI:SS') as last_modified"] +if {[::xo::db::has_ltree]} { + lappend attributes page_order +} + +set folder_id [::$package_id folder_id] +foreach i [db_list get_syndicated { + select object_id from syndication s, cr_items ci + where object_id = ci.live_revision and parent_id = :folder_id +}] { set syndicated($i) 1 } + +db_foreach instance_select \ + [$object_type instance_select_query \ + -folder_id $folder_id \ + -with_subtypes $with_subtypes \ + -from_clause ", xowiki_page p" \ + -where_clause "p.page_id = cr.revision_id" \ + -select_attributes $attributes \ + -orderby ci.name \ + ] { + set page_link [::$package_id pretty_link $name] + + t1 add \ + -name $name \ + -title $title \ + -object_type [string map [list "::xowiki::" ""] $object_type] \ + -name.href $page_link \ + -last_modified $last_modified \ + -syndicated [info exists syndicated($revision_id)] \ + -size [expr {$content_length ne "" ? $content_length : 0}] \ + -edit.href [export_vars -base $page_link {{m edit} return_url}] \ + -mod_user [::xo::get_user_name $creation_user] \ + -delete.href [export_vars -base [$package_id package_url] {{delete 1} item_id name return_url}] + if {$::individual_permissions} { + [t1 last_child] set permissions.href \ + [export_vars -base permissions {item_id return_url}] + } + if {$::with_publish_status} { + # TODO: this should get some architectural support + if {$publish_status eq "ready"} { + set image active.png + set state "production" + } else { + set image inactive.png + set state "ready" + } + [t1 last_child] set publish_status.src /resources/xowiki/$image + [t1 last_child] set publish_status.href \ + [export_vars -base [$package_id package_url]admin/set-publish-state \ + {state revision_id return_url}] + } + if {[::xo::db::has_ltree]} { + [t1 last_child] set page_order $page_order + } + } + +set t1 [t1 asHTML] Index: openacs-4/packages/xowiki/www/admin/permissions.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/permissions.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/permissions.adp 1 Aug 2007 21:39:25 -0000 1.2.2.2 @@ -0,0 +1,5 @@ + + @page_title@ + @context@ + + Index: openacs-4/packages/xowiki/www/admin/permissions.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/permissions.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/permissions.tcl 1 Aug 2007 21:39:25 -0000 1.2.2.2 @@ -0,0 +1,26 @@ +::xowiki::Package initialize -ad_doc { + Security management for xowiki pages + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Aug 16, 2006 + @cvs-id $Id: permissions.tcl,v 1.2.2.2 2007/08/01 21:39:25 gustafn Exp $ + +} -parameter { + {-item_id:optional} +} + +if {[info exists item_id]} { + set page [::Generic::CrItem instantiate -item_id $item_id] + $page volatile + set object_id $item_id + set page_title "Manage Permissions for Page: [$page name]" + set return_url [$package_id query_parameter return_url [$package_id package_url]admin/list] +} else { + set object_id $package_id + set page_title "Manage Permissions for Package [apm_instance_name_from_id $package_id]" + set return_url [$package_id query_parameter return_url [$package_id package_url]admin] +} + +set context [list $page_title] + + Index: openacs-4/packages/xowiki/www/admin/portal-element-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/portal-element-add.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/portal-element-add.tcl 1 Aug 2007 21:39:25 -0000 1.5.2.2 @@ -0,0 +1,45 @@ +::xowiki::Package initialize -ad_doc { + Add an element to a given portal + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Oct 23, 2005 + @cvs-id $Id: portal-element-add.tcl,v 1.5.2.2 2007/08/01 21:39:25 gustafn Exp $ + + @param object_type show objects of this class and its subclasses +} -parameter { + {-portal_id} + {-page_name} + {-referer .} +} + + +set page_id [$package_id resolve_request -path $page_name method] +set page_id [::Generic::CrItem lookup -name $page_name -parent_id [$package_id folder_id]] +set page_title [$page_id title] + +# for the time being, we add the portlet on the first page (page 0) +set portal_page_id [portal::get_page_id -portal_id $portal_id -sort_key 0] + +if {[db_string check_unique_name_on_page { + select 1 from portal_element_map + where page_id = :portal_page_id + and pretty_name = :page_title +} -default 0]} { + ad_return_error [_ xowiki.portlet_title_exists_error_short] [_ xowiki.portlet_title_exists_error_long] +} else { + db_transaction { + set element_id [portal::add_element \ + -portal_id $portal_id \ + -portlet_name [xowiki_portlet::get_my_name] \ + -pretty_name $page_title \ + -force_region [parameter::get_from_package_key \ + -parameter "xowiki_portal_content_force_region" \ + -package_key "xowiki-portlet"] + ] + portal::set_element_param $element_id package_id $package_id + portal::set_element_param $element_id page_name [$page_id name] + } + ad_returnredirect $referer +} +ad_script_abort + Index: openacs-4/packages/xowiki/www/admin/portal-element-remove.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/portal-element-remove.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/portal-element-remove.tcl 1 Aug 2007 21:39:25 -0000 1.1.2.2 @@ -0,0 +1,19 @@ +::xowiki::Package initialize -ad_doc { + Add an element to a given portal + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Oct 23, 2005 + @cvs-id $Id: portal-element-remove.tcl,v 1.1.2.2 2007/08/01 21:39:25 gustafn Exp $ + +} -parameter { + {-element_id} + {-portal_id} + {-referer .} +} + +# permissions? +portal::remove_element -element_id $element_id +# redirect and abort +ad_returnredirect $referer +ad_script_abort + Index: openacs-4/packages/xowiki/www/admin/set-publish-state.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/set-publish-state.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/set-publish-state.tcl 1 Aug 2007 21:39:25 -0000 1.7.2.2 @@ -0,0 +1,33 @@ +::xowiki::Package initialize -ad_doc { + Changes the publication state of a content item + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Nov 16, 2006 + @cvs-id $Id: set-publish-state.tcl,v 1.7.2.2 2007/08/01 21:39:25 gustafn Exp $ + + @param object_type + @param query +} -parameter { + {-state:required} + {-revision_id:required} + {-return_url "."} +} + +set item_id [db_string get_item_id \ + {select item_id from cr_revisions where revision_id = :revision_id}] + +ns_cache flush xotcl_object_cache ::$item_id +ns_cache flush xotcl_object_cache ::$revision_id + +::xo::db::sql::content_item set_live_revision \ + -revision_id $revision_id \ + -publish_status $state + +if {$state ne "production"} { + ::xowiki::notification::do_notifications -revision_id $revision_id + ::xowiki::datasource $revision_id +} else { + db_dml flush_syndication {delete from syndication where object_id = :revision_id} +} + +ad_returnredirect $return_url Index: openacs-4/packages/xowiki/www/admin/test.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/test.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/test.tcl 1 Aug 2007 21:39:25 -0000 1.9.2.2 @@ -0,0 +1,514 @@ +# regression test for xowiki +# $Id: test.tcl,v 1.9.2.2 2007/08/01 21:39:25 gustafn Exp $ +Object test +test set passed 0 +test set failed 0 +test proc case msg {ad_return_top_of_page "$msg

$msg

"} +test proc section msg {my reset; ns_write "

$msg

"} +test proc subsection msg {ns_write "

$msg

"} +test proc errmsg msg {ns_write "ERROR: $msg
"; test incr failed} +test proc okmsg msg {ns_write "OK: $msg
"; test incr passed} +test proc code msg {ns_write "

$msg

"} +test proc hint msg {ns_write "$msg
"} +test proc reset {} { + array unset ::xotcl_cleanup + global af_parts af_key_name + array unset af_parts + array unset af_key_name +} +test proc without_ns_form {cmd} { + rename ::ns_queryget ::ns_queryget.orig + rename ::ns_querygetall ::ns_querygetall.orig + rename ::ad_returnredirect ::ad_returnredirect.orig + proc ::ns_queryget key {::xo::cc form_parameter $key ""} + proc ::ns_querygetall key {::xo::cc form_parameter $key {{}} } + proc ::ad_returnredirect url {::xo::cc returnredirect $url} + if {[catch {set r [uplevel $cmd]} errmsg]} { + if {$errmsg ne ""} {test code "error in command: $errmsg [info exists r]"} + set r "" + } + rename ::ns_queryget "" + rename ::ns_queryget.orig ::ns_queryget + rename ::ns_querygetall "" + rename ::ns_querygetall.orig ::ns_querygetall + rename ::ad_returnredirect "" + rename ::ad_returnredirect.orig ::ad_returnredirect + return $r +} + + +proc ? {cmd expected {msg ""}} { + set r [uplevel $cmd] + if {$msg eq ""} {set msg $cmd} + if {$r ne $expected} { + test errmsg "$msg returned '$r' ne '$expected'" + } else { + test okmsg "$msg - passed ([t1 diff] ms)" + } +} + +set instance_name XOWIKI-TEST +set index_vuh_parms { + {-m view} + {-folder_id:integer 0} +} +::xo::Timestamp t1 + +test case "XoWiki Test Cases" + +test section "Basic Setup" + +test hint "Using XOTcl $::xotcl::version$::xotcl::patchlevel" +? {expr {$::xotcl::version < 1.4}} 0 "XOTcl Version $::xotcl::version >= 1.4" + +set ns_cache_version_old [catch {ns_cache names xowiki_cache xxx}] +if {$ns_cache_version_old} { + ? {set x old} new "upgrade ns_cache: cvs -z3 -d:pserver:anonymous@aolserver.cvs.sourceforge.net:/cvsroot/aolserver co nscache" +} else { + ? {set x new} new "ns_cache version seems up to date" +} + +set tdom_version [package require tdom] +if {$tdom_version < "0.8.0"} { + ? {set x old} new "xowiki requires at least tdom 0.8.0 (released Aug 2004), \ + the installed tdom version is to old ($tdom_version).
\ + Please Upgrade tdom from: cvs -z3 -d:pserver:anonymous@cvs.tdom.org:/usr/local/pubcvs co tdom
" +} else { + ? {set x new} new "tdom version $tdom_version is ok" +} +######################################################################## +test section "Create New Package Instance of XoWiki" +# +# create a fresh instance for testing +# +if {[site_node::exists_p -url /$instance_name]} { + # we have already an instance, get rid of it + array set info [site_node::get_from_url -url /$instance_name -exact] + # is the instance mounted? + if {$info(package_id) ne ""} { + site_node::unmount -node_id $info(node_id) + } + site_node::delete -node_id $info(node_id) + #test code [array get info] +} + +? {site_node::exists_p -url /$instance_name} 0 \ + "the test instance does not exist" + +#set root_id [site_node::get_root_node_id] +set root_id [db_string "" {select node_id from site_nodes where parent_id is null}] + +if {[db_0or1row check_broken_site_nodes { + select node_id, name from site_nodes where name = :instance_name and parent_id = :root_id +}]} { + test hint "... site nodes seem broken, since we have an entry, but site_node::exists_p returns false" + test hint "... try to fix anyhow" + db_dml fix_broken_entry { + delete from site_nodes where name = :instance_name and parent_id = :root_id + } +} + +# create a fresh instance +array set node [site_node::get -url /] +site_node::instantiate_and_mount \ + -parent_node_id $node(node_id) \ + -node_name $instance_name \ + -package_name xowiki \ + -package_key xowiki +#test code [array get node] + +? {site_node::exists_p -url /$instance_name} 1 \ + "created test instance /$instance_name" +array set info [site_node::get_from_url -url /$instance_name -exact] +? {expr {$info(package_id) ne ""}} 1 "package is mounted, package_id provided" + + +test subsection "Basic Setup: Package, url= /$instance_name/" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/ \ + -actual_query "" \ + -user_id 0 + +? {info exists package_id} 1 "package_id is exported" +? {set package_id} $info(package_id) "package_id right value" +? {::xotcl::Object isobject ::$package_id} 1 "we have a package_id object" +? {$package_id package_url} /$instance_name/ "package_url" +? {$package_id url} /$instance_name/ +? {$package_id id} $package_id "the id of the package object = package_id" + +test code [$package_id serialize] + +test subsection "Basic Setup: Folder Object" +? {$package_id exists folder_id} 1 "folder_id is set" +set folder_id [::$package_id folder_id] +? {::xotcl::Object isobject ::$folder_id} 1 "we have a folder object" +? {::xotcl::Object isobject ::${folder_id}::payload} 1 "we have a payload" +? {::$folder_id name} ::$folder_id "name of folder object is ::folder_id" +? {::$folder_id parent_id} $folder_id "parent_id of folder object is folder_id" +? {expr {[::$folder_id item_id]>0}} 1 "item_id given" +? {expr {[::$folder_id revision_id]>0}} 1 "revision_id given" +? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 1 \ + "folder contains the folder object" + +test subsection "Create and Render Index Page" +? {$package_id set object} "" "object name parsed" +? {set m} view "method passed from package initialize" +set object [$package_id set object] +set page_item_id [$package_id resolve_page $object $m] +? {expr {$page_item_id ne ""}} 1 "index page resolved" +? {::xotcl::Object isobject ::$page_item_id} 1 "we have a page object" +? {expr {[::$page_item_id item_id]>0}} 1 "item_id given" +? {expr {[::$page_item_id revision_id]>0}} 1 "revision_id given" +? {::$page_item_id parent_id} $folder_id "parent_id of page object is folder_id" +? {::$page_item_id package_id} $package_id "package_id of page object" +? {::$page_item_id name} en:index "name of resolved index page" +? {::$page_item_id istype ::xowiki::Page} 1 "type or subtype of ::xowiki::Page" + +set content [$package_id call $page_item_id $m] +set content_length [string length $content] +? {expr {$content_length > 1000}} 1 \ + "page rendered, content-length $content_length > 1000" +? {string first Error $content} -1 "page contains no error" +? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 2 \ + "folder contains the folder object and the index page" +#test code [$page_item_id serialize] + +test subsection "Check Permissions based on default policy" +? {::xo::cc user_id} 0 "user_id is guest" +? {::$package_id make_link ::$page_item_id delete return_url} "" \ + "the public cannot delete this page" +? {::$package_id make_link -privilege admin -link admin/ $package_id {} {}} "" \ + "the public cannot admin this package" + +######################################################################## +# +# run a new query, use en/index explicitely +# +test section "New Query: /$instance_name/en/index" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/index \ + -actual_query "" \ + -user_id 0 + +? {info exists package_id} 1 "package_id is exported" +? {set package_id} $info(package_id) "package_id right value" +? {::xotcl::Object isobject ::$package_id} 1 "we have a package_id object" +? {$package_id package_url} /$instance_name/ "package_url" +? {$package_id url} /$instance_name/en/index "url" +? {$package_id id} $package_id "the id of the package object = package_id" +set object [::$package_id set object] +set page_item_id [::$package_id resolve_page $object $m] +set folder_id [::$package_id folder_id] +? {::$page_item_id parent_id} $folder_id "parent_id of page object is folder_id" +? {::$page_item_id package_id} $package_id "package_id of page object" +? {::$page_item_id name} en:index "name of resolved index page" + +######################################################################## +# +# run a new query +# +test section "New Query: /$instance_name/" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/ \ + -actual_query "" \ + -user_id 0 + +? {info exists package_id} 1 "package_id is exported" +? {set package_id} $info(package_id) "package_id right value" +? {::xotcl::Object isobject ::$package_id} 1 "we have a package_id object" +? {$package_id package_url} /$instance_name/ "package_url" +? {$package_id url} /$instance_name/ "url" +? {$package_id id} $package_id "the id of the package object = package_id" + +test subsection "Basic Setup: Folder Object (2nd)" +? {$package_id exists folder_id} 1 "folder_id is set" +set folder_id [::$package_id folder_id] +? {::xotcl::Object isobject ::$folder_id} 1 "we have a folder object" +? {::xotcl::Object isobject ::${folder_id}::payload} 1 "we have a payload" +? {::$folder_id name} ::$folder_id "name of folder object is ::folder_id" +? {::$folder_id parent_id} $folder_id "parent_id of folder object is folder_id" +? {expr {[::$folder_id item_id]>0}} 1 "item_id given" +? {expr {[::$folder_id revision_id]>0}} 1 "revision_id given" +? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 2 \ + "folder contains the folder object and index" + +test subsection "Render Index Page (2nd)" +? {$package_id set object} "" "object name parsed" +? {set m} view "method passed from package initialize" +set object [$package_id set object] +set page_item_id [$package_id resolve_page $object $m] +? {expr {$page_item_id ne ""}} 1 "index page resolved" +? {::xotcl::Object isobject ::$page_item_id} 1 "we have a page object" +? {expr {[::$page_item_id item_id]>0}} 1 "item_id given" +? {expr {[::$page_item_id revision_id]>0}} 1 "revision_id given" +? {::$page_item_id parent_id} $folder_id "parent_id of page object is folder_id" +? {::$page_item_id package_id} $package_id "package_id of page object" +? {::$page_item_id name} en:index "name of resolved index page" +? {::$page_item_id istype ::xowiki::Page} 1 "type or subtype of ::xowiki::Page" + +set content [$package_id call $page_item_id $m] +set content_length [string length $content] +? {expr {$content_length > 1000}} 1 \ + "page rendered, content-length $content_length > 1000" +? {string first Error $content} -1 "page contains no error" +#test code [$page_item_id serialize] + +######################################################################## +# +# run a new query +# +test section "New Query: /$instance_name/weblog" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/weblog \ + -actual_query "" \ + -user_id 0 + +? {$package_id package_url} /$instance_name/ "package_url" +? {$package_id url} /$instance_name/weblog "url" +? {$package_id id} $package_id "the id of the package object = package_id" +set folder_id [::$package_id folder_id] + +test subsection "Create and Render Weblog" +set content [::$package_id invoke -method $m] +set content_length [string length $content] +? {expr {$content_length > 1000}} 1 \ + "page rendered, content-length $content_length > 1000" +? {string first Error $content} -1 "page contains no error" + +? {db_string count "select count(*) from cr_items where parent_id = $folder_id"} 5 \ + "folder contains: folder object, index and weblog page (+2 includelets)" + + + +######################################################################## +test section "New Query: /$instance_name/en/weblog" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/weblog \ + -actual_query "" \ + -user_id 0 + +set content [::$package_id invoke -method $m] +set content_length [string length $content] +? {expr {$content_length > 1000}} 1 \ + "page rendered, content-length $content_length > 1000" +? {string first Error $content} -1 "page contains no error" + +set full_weblog_content_length $content_length + + +######################################################################## +test section "New Query: /$instance_name/en/weblog with summary=1" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/weblog \ + -actual_query "summary=1" \ + -user_id 0 + +set content [::$package_id invoke -method $m] +set content_length [string length $content] +? {expr {$content_length > 1000}} 1 \ + "page rendered, content-length $content_length > 1000" +? {string first Error $content} -1 "page contains no error" +? {expr {$full_weblog_content_length > $content_length}} 1 "summary is shorter" + + +######################################################################## +test section "Testing as SWA: query /$instance_name/ " + +set swas [db_list get_swa "select grantee_id from acs_permissions \ + where object_id = -4 and privilege = 'admin'"] + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/ \ + -actual_query "" \ + -user_id [lindex $swas 0] + +set content [::$package_id invoke -method $m] +? {string first Error $content} -1 "page contains no error" + +test subsection "Check Permissions based on default policy" +? {expr {[::xo::cc user_id] != 0}} 1 "user_id [lindex $swas 0] is not guest" +? {expr {[::$package_id make_link ::$page_item_id delete return_url] ne ""}} 1 \ + "SWA sees the delete link" +? {expr {[::$package_id make_link -privilege admin -link admin/ $package_id {} {}] ne ""}} 1 \ + "SWA sees admin link" +? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 5 \ + "folder contains: folder object, index and weblog page (+2 includelets)" + + +######################################################################## +test section "Delete weblog-portlet via weblink" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/weblog-portlet \ + -actual_query "m=delete" \ + -user_id [lindex $swas 0] + +set content [::$package_id invoke -method $m] +? {string first Error $content} -1 "page contains no error" +? {::xo::cc exists __continuation} 1 "continuation exists" +? {::xo::cc set __continuation} "ad_returnredirect /$instance_name/" \ + "redirect to main instance" +? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 4 \ + "folder contains: folder object, index and weblog page (+1 includelet)" + +test subsection "Create a test page named hello" + +set page [::xowiki::Page new \ + -title "Hello World" \ + -name en:hello \ + -package_id $package_id \ + -parent_id [$package_id folder_id] \ + -destroy_on_cleanup \ + -text { + Hello [[Wiki]] World. + }] +$page set_content [string trim [$page text] " \n"] +$page initialize_loaded_object +$page save_new +? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 5 \ + "folder contains: folder object, index and weblog, hello page (+1 includelet)" +? {expr {[$page revision_id]>0}} 1 "revision_id given" +? {expr {[$page item_id]>0}} 1 "item_id given" +set revision_id1 [$page revision_id] +set item_id1 [$page item_id] + +$page append title "- V.2" +$page save +? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 5 \ + "still 5 pages" +? {expr {[$page revision_id]>$revision_id1}} 1 "revision_id > old revision_id" +? {expr {[$page item_id] == $item_id1}} 1 "item id the same" + + + +######################################################################## +test section "Recreate weblog-portlet" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/weblog \ + -actual_query "summary=1" \ + -user_id 0 + +set content [::$package_id invoke -method $m] +set content_length [string length $content] +? {expr {$content_length > 1000}} 1 \ + "page rendered, content-length $content_length > 1000" +? {string first Error $content} -1 "page contains no error" +? {db_string count "select count(*) from cr_items where parent_id=[$package_id folder_id]"} 6 \ + "again, 6 pages" + + +######################################################################## +test section "Query revisions for hello page via weblink" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/hello \ + -actual_query "m=revisions" \ + -user_id [lindex $swas 0] + +set content [::$package_id invoke -method $m] +? {string first Error $content} -1 "page contains no error" +? {expr {[string first 2: $content]>-1}} 1 "page contains two revisions" + + +######################################################################## +test section "Edit hello page via weblink" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/hello \ + -actual_query "m=edit" \ + -user_id [lindex $swas 0] + +set content [::$package_id invoke -method $m] +? {string first Error $content} -1 "page contains no error" +? {expr {[string first "- V.2" $content]>-1}} 1 \ + "form page contains the modified title" + +regexp {name="item_id" value="([^\"]+)"} $content _ returned_item_id +? {info exists returned_item_id} 1 "item_id contained in form" +? {expr {$returned_item_id > 0}} 1 "item_id $returned_item_id > 0" +? {$package_id isobject $returned_item_id} 1 "item is instantiated" + +regexp {name="folder_id" value="([^\"]+)"} $content _ returned_folder_id +? {info exists returned_folder_id} 1 "folder_id contained in form" +? {expr {$returned_folder_id > 0}} 1 "returned folder id $returned_folder_id >0" + +regexp {name="__key_signature" value="([^\"]+)"} $content _ signature +? {info exists signature} 1 "signature contained in form" +? {expr {$signature ne ""}} 1 "signature not empty" + +set title [$returned_item_id title] +set text [lindex [$returned_item_id text] 0] + +######################################################################## +test section "Submit edited hello page via weblink" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/hello \ + -actual_query "m=edit" \ + -user_id [lindex $swas 0] \ + -form_parameter [subst { + form:id f1 + form:mode edit + formbutton:ok { OK } + __refreshing_p 0 + __confirmed_p 0 + __new_p 0 + __key_signature {$signature} + __object_name en:hello + name en:hello + object_type ::xowiki::Page + text.format text/html + creator {Gustaf Neumann} + description {{this is the description}} + text {$text ... just testing ..
} + nls_language en_US + folder_id $returned_folder_id + title {$title} + item_id $returned_item_id }] + +set content [test without_ns_form {::$package_id invoke -method $m}] +? {string first Error $content} -1 "page contains no error" + +? {::xo::cc exists __continuation} 1 "continuation exists" +? {::xo::cc set __continuation} "ad_returnredirect /$instance_name/hello" \ + "redirect to hello page" + +######################################################################## +test section "Query revisions for hello page via weblink" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/en/hello \ + -actual_query "m=revisions" \ + -user_id [lindex $swas 0] + +set content [::$package_id invoke -method $m] +? {string first Error $content} -1 "page contains no error" +? {expr {[string first 3: $content]>-1}} 1 "page contains three revisions" + + +ns_write "

+ Tests passed: [test set passed]
+ Tests failed: [test set failed]
+ Tests Time: [t1 diff -start]ms
+" \ No newline at end of file Index: openacs-4/packages/xowiki/www/admin/samples/ajax-chat.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/samples/ajax-chat.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/samples/ajax-chat.tcl 1 Aug 2007 21:39:25 -0000 1.4.2.2 @@ -0,0 +1,21 @@ +namespace eval ::xowiki::tmp { + ::xowiki::Object create ajax-chat -noinit \ + -set object_type ::xowiki::Object \ + -set lang en \ + -set description {} \ + -set text { + proc content {} { + ::xowiki::Chat login -chat_id 22 + } + } \ + -set nls_language en_US \ + -set mime_type {text/html} \ + -set name en:ajax-chat \ + -set title en:ajax-chat +} + +set title "Import XoWiki Pages" +set context {} +set msg [::xowiki::Page import -objects ::xowiki::tmp::ajax-chat -replace true] +template::set_file "[file dir $__adp_stub]/../importmsg" +ad_return_template Index: openacs-4/packages/xowiki/www/ajax/chat.js =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/ajax/Attic/chat.js,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/ajax/chat.js 1 Aug 2007 21:39:26 -0000 1.4.2.2 @@ -0,0 +1,78 @@ +// simple javascript support for polling ajax based chat interface +// $Id: chat.js,v 1.4.2.2 2007/08/01 21:39:26 gustafn Exp $ +// -gustaf neumann April 2006 + +function receiver1() { + if (http.readyState == 4) { + // alert('status code =' + http.status); + if (http.status != 200) { + alert('Something wrong in HTTP request, status code = ' + http.status); + } + } +} + +function chatReceiver() { + if (http.readyState == 4) { + // alert('status code =' + http.status); + if (http.status == 200) { + appendToMessages(http.responseText); + } else { + clearInterval(); + alert('Something wrong in HTTP request, status code = ' + http.status); + } + } +} + +function appendToMessages(content) { + var xmlobject = (new DOMParser()).parseFromString(content, 'application/xhtml+xml'); + var items = xmlobject.getElementsByTagName('TR'); + //alert('found ' + items.length + ' items'); + //var counter = document.getElementById('chatCounter'); + //counter.innerHTML = parseInt(counter.innerHTML) + 1; + //document.getElementById('chatResponse').innerHTML = 'items = ' + items.length + ' l=' + content.length + ' ' + escape(content); + + //if (items.length > 0) {alert('appending ' + content);} + var doc = frames['ichat'].document; + var tbody = frames['ichat'].document.getElementById('messages').tBodies[0]; + //var tbody = tbodies[tbodies.length -1]; + //for (var i = 0 ; i < items.length ; i++) { + // tbody.appendChild(frames['ichat'].document.importNode(items[i],true)); + //} + var tr, td, e, s; + for (var i = 0 ; i < items.length ; i++) { + tr = doc.createElement('tr'); + e = items[i].getElementsByTagName('TD'); + td = doc.createElement('td'); + td.innerHTML = decodeURIComponent(e[0].firstChild.nodeValue); + td.className = 'timestamp'; + tr.appendChild(td); + + td = doc.createElement('td'); + s = e[1].firstChild.nodeValue; + td.innerHTML = decodeURIComponent(e[1].firstChild.nodeValue.replace(/\+/g,' ')); + td.className = 'user'; + tr.appendChild(td); + + td = doc.createElement('td'); + td.innerHTML = decodeURIComponent(e[2].firstChild.nodeValue.replace(/\+/g,' ')); + td.className = 'message'; + tr.appendChild(td); + + tbody.appendChild(tr); + } + frames['ichat'].window.scrollTo(0,tbody.offsetHeight); +} + + +function chatSendMsg(send_url,handler) { + var msgField = document.getElementById('chatMsg'); + chatSendCmd(send_url + encodeURIComponent(msgField.value),handler); + msgField.value = ''; +} + +var msgcount = 0; // hack to overcome IE +function chatSendCmd(url,handler) { + http.open('GET', url + '&mc=' + msgcount++, true); + http.onreadystatechange = handler; + http.send(null); +} Index: openacs-4/packages/xowiki/www/ajax/chat.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/ajax/Attic/chat.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/ajax/chat.tcl 1 Aug 2007 21:39:26 -0000 1.4.2.2 @@ -0,0 +1,40 @@ +ad_page_contract { + a tiny chat client + + @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) + @creation-date Jan 31, 2006 + @cvs-id $Id: chat.tcl,v 1.4.2.2 2007/08/01 21:39:26 gustafn Exp $ +} -query { + m + id + s + msg:optional + {mode ""} +} + +#ns_log notice "--c m=$m session_id=$s [clock format [lindex [split $s .] 1] -format %H:%M:%S] mode=$mode" +::xowiki::Chat c1 -volatile -chat_id $id -session_id $s -mode $mode +switch -- $m { + add_msg { + #ns_log notice "--c call c1 $m '$msg'" + set _ [c1 $m $msg] + #ns_log notice "--c add_msg returns '$_'" + } + login - + subscribe - + get_new - + get_all {set _ [c1 $m]} + default {ns_log error "--c unknown method $m called."} +} + +ns_return 200 text/html " + + + +$_

+ +" \ No newline at end of file Index: openacs-4/packages/xowiki/www/ajax/scripted-streaming-chat.js =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/ajax/Attic/scripted-streaming-chat.js,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/ajax/scripted-streaming-chat.js 1 Aug 2007 21:39:26 -0000 1.1.2.2 @@ -0,0 +1,73 @@ +// simple javascript support for streaming ajax based chat interface +// $Id: scripted-streaming-chat.js,v 1.1.2.2 2007/08/01 21:39:26 gustafn Exp $ +// -gustaf neumann April 2006 + +function getHttpObject() { + var http_request = false; + if (window.XMLHttpRequest) { // Mozilla, Safari,... + http_request = new XMLHttpRequest(); + } else if (window.ActiveXObject) { // IE + try { + http_request = new ActiveXObject('Msxml2.XMLHTTP'); + } catch (e) { + try { + http_request = new ActiveXObject('Microsoft.XMLHTTP'); + } catch (e) {} + } + } + + if (!http_request) { + alert('Cannot create and instance of XMLHTTP'); + } + return http_request; +} + +function getData(data) { + var messages = document.getElementById('messages'); + for (var i=0;ixowiki-doc +

+ Last modified: Mon Oct 31 13:36:50 CET 2005 + Index: openacs-4/packages/xowiki/www/portlets/calendar-portlet.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/calendar-portlet.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/calendar-portlet.adp 1 Aug 2007 21:39:26 -0000 1.1.2.2 @@ -0,0 +1,5 @@ + + Index: openacs-4/packages/xowiki/www/portlets/calendar-portlet.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/calendar-portlet.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/calendar-portlet.tcl 1 Aug 2007 21:39:26 -0000 1.2.2.2 @@ -0,0 +1,8 @@ +# +::xowiki::Page requireCSS "/resources/calendar/calendar.css" + +set date [dt_sysdate] +proc my_get_url_stub {args} { + return /dotlrn/calendar +} +set url_stub_callback "my_get_url_stub" Index: openacs-4/packages/xowiki/www/portlets/forums-portlet.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/forums-portlet.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/forums-portlet.adp 1 Aug 2007 21:39:26 -0000 1.1.2.2 @@ -0,0 +1,2 @@ + + Index: openacs-4/packages/xowiki/www/portlets/forums-portlet.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/forums-portlet.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/forums-portlet.tcl 1 Aug 2007 21:39:26 -0000 1.1.2.2 @@ -0,0 +1,10 @@ + +set portal_id [dotlrn::get_portal_id -user_id [ad_conn user_id]] +set config(shaded_p) f +set config(package_id) [db_list get_forum_ids " + select value from portal_pages, portal_element_map, portal_element_parameters + where portal_id = $portal_id and portal_pages.page_id = portal_element_map.page_id + and portal_element_parameters.element_id = portal_element_map.element_id + and portal_element_map.name = 'forums_portlet' + and key = 'package_id'"] +set cf [array get config] \ No newline at end of file Index: openacs-4/packages/xowiki/www/portlets/include.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/include.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/include.tcl 1 Aug 2007 21:39:26 -0000 1.3.2.2 @@ -0,0 +1,4 @@ +#ns_log notice "--including_page= $__including_page, portlet=$portlet" +set content [$__including_page include_portlet $portlet] +set header_stuff [::xowiki::Page header_stuff] +template::set_file [file dir $__adp_stub]/plain-include Index: openacs-4/packages/xowiki/www/portlets/plain-include.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/plain-include.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/plain-include.adp 1 Aug 2007 21:39:26 -0000 1.1.2.2 @@ -0,0 +1 @@ +@content;noquote@ Index: openacs-4/packages/xowiki/www/portlets/portlet-skin.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/portlet-skin.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/portlet-skin.adp 1 Aug 2007 21:39:26 -0000 1.1.2.2 @@ -0,0 +1,6 @@ +

+@name@ +

+@content;noquote@ +

Index: openacs-4/packages/xowiki/www/portlets/weblog-mini-calendar.adp =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/weblog-mini-calendar.adp,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/weblog-mini-calendar.adp 1 Aug 2007 21:39:26 -0000 1.1.2.2 @@ -0,0 +1,49 @@ + + + + + + + + +

Index: openacs-4/packages/xowiki/www/portlets/weblog-mini-calendar.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/portlets/weblog-mini-calendar.tcl,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/portlets/weblog-mini-calendar.tcl 1 Aug 2007 21:39:26 -0000 1.8.2.2 @@ -0,0 +1,146 @@ +::xowiki::Page requireCSS "/resources/calendar/calendar.css" +set package_id [::xo::cc package_id] +set folder_id [$__including_page set parent_id] +set including_item_id [$__including_page set item_id] + +if {![exists_and_not_null base_url]} { + if {![info exists page]} {set page [$package_id get_parameter weblog_page]} + set base_url [$package_id pretty_link $page] +} + +set date [ns_queryget date] +if {![exists_and_not_null date]} { + set date [dt_sysdate] +} + +#if {[exists_and_not_null page_num]} { +# set page_num "&page_num=$page_num" +#} else { +# set page_num "" +#} + +array set message_key_array { + list #acs-datetime.List# + day #acs-datetime.Day# + week #acs-datetime.Week# + month #acs-datetime.Month# +} + +# Get the current month, day, and the first day of the month +if {[catch { + dt_get_info $date +} errmsg]} { + set date [dt_sysdate] + dt_get_info $date +} + +set now [clock scan $date] +set date_list [dt_ansi_to_list $date] +set year [dt_trim_leading_zeros [lindex $date_list 0]] +set month [dt_trim_leading_zeros [lindex $date_list 1]] +set day [dt_trim_leading_zeros [lindex $date_list 2]] + +set months_list [dt_month_names] +set curr_month_idx [expr {[dt_trim_leading_zeros [clock format $now -format "%m"]]-1}] + +set curr_month [lindex $months_list $curr_month_idx ] +set prev_month [clock format [clock scan "1 month ago" -base $now] -format "%Y-%m-%d"] +set next_month [clock format [clock scan "1 month" -base $now] -format "%Y-%m-%d"] +set prev_month_url [export_vars -base $base_url {{date $prev_month} page_num summary}] +set next_month_url [export_vars -base $base_url {{date $next_month} page_num summary}] +#set next_month_url "$base_url?date=[ad_urlencode $next_month]${page_num}" + +set first_day_of_week [lc_get firstdayofweek] +set week_days [lc_get abday] +multirow create days_of_week day_short +for {set i 0} {$i < 7} {incr i} { + multirow append days_of_week [lindex $week_days [expr {($i + $first_day_of_week) % 7}]] +} + +db_foreach entries_this_month "select count(ci.item_id) as c, + [::xo::db::sql date_trunc day p.publish_date] as d \ + from xowiki_pagei p, cr_items ci \ + where ci.parent_id = $folder_id \ + and ci.item_id = p.item_id and ci.live_revision = p.page_id \ + and ci.content_type not in ('::xowiki::PageTemplate') \ + and ci.item_id != $including_item_id \ + and ci.publish_status <> 'production' \ + and [::xo::db::sql date_trunc_expression month p.publish_date $year-$month-01] \ + group by [::xo::db::sql date_trunc day p.publish_date]" { + set entries([lindex $d 0]) $c + } + +multirow create days day_number beginning_of_week_p end_of_week_p today_p active_p url count class + +set day_of_week 1 + +# Calculate number of active days +set active_days_before_month [expr {[dt_first_day_of_month $year $month] -1}] +set active_days_before_month [expr {($active_days_before_month + 7 - $first_day_of_week) % 7}] + +set calendar_starts_with_julian_date [expr {$first_julian_date_of_month - $active_days_before_month}] +set day_number [expr {$days_in_last_month - $active_days_before_month + 1}] + +for {set julian_date $calendar_starts_with_julian_date} {$julian_date <= $last_julian_date + 7} {incr julian_date} { + + if {$julian_date > $last_julian_date_in_month && $end_of_week_p eq "t" } { + break + } + set today_p f + set active_p t + + if {$julian_date < $first_julian_date_of_month} { + set active_p f + } elseif {$julian_date > $last_julian_date_in_month} { + set active_p f + } + set ansi_date [dt_julian_to_ansi $julian_date] + + if {$julian_date == $first_julian_date_of_month} { + set day_number 1 + } elseif {$julian_date == $last_julian_date_in_month +1} { + set day_number 1 + } + + if {$julian_date == $julian_date_today} { + set today_p t + } + + if { $day_of_week == 0} { + set beginning_of_week_p t + } else { + set beginning_of_week_p f + } + + if { $day_of_week == 7 } { + set day_of_week 0 + set end_of_week_p t + } else { + set end_of_week_p f + } + + # ns_log notice "--D julian_date = $julian_date [dt_julian_to_ansi $julian_date] //$ansi_date" + set count [expr {[info exists entries($ansi_date)] ? + ([info exists noparens] ? $entries($ansi_date) : "($entries($ansi_date))") + : ""}] + if {$today_p} { + set class today + } elseif {$active_p} { + set class active + } else { + set class inactive + } + multirow append days $day_number $beginning_of_week_p $end_of_week_p $today_p $active_p \ + "[export_vars -base $base_url {{date $ansi_date} summary}]" $count $class + incr day_number + incr day_of_week +} + +set sysdate [dt_sysdate] +set today_url [export_vars -base $base_url {{date $sysdate} page_num}] +if {$sysdate eq $date} { + set today_p t +} else { + set today_p f +} + Index: openacs-4/packages/xowiki/www/prototypes/CGI.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/CGI.page,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/prototypes/CGI.page 1 Aug 2007 21:39:27 -0000 1.1.2.2 @@ -0,0 +1,11 @@ +# -*- tcl-*- +# $Id: CGI.page,v 1.1.2.2 2007/08/01 21:39:27 gustafn Exp $ +::xowiki::Object new -title "CGI" -text { + proc content {} { + return "Hello \[\[Wiki\]\]-World. It is now [clock format [clock seconds]]." + } + +} + + + Index: openacs-4/packages/xowiki/www/prototypes/CGI2.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/CGI2.page,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/prototypes/CGI2.page 1 Aug 2007 21:39:27 -0000 1.2.2.2 @@ -0,0 +1,22 @@ +# -*- tcl-*- +# $Id: CGI2.page,v 1.2.2.2 2007/08/01 21:39:27 gustafn Exp $ +::xowiki::Object new -title "CGI2" -text { + # + # The classes and objects here are all local to the object, + # as long as no absolute class or object names are used (no leading colons) + # + Class CGI + CGI instproc content {} { + set somevar 100 + return "Hello \[\[Wiki\]\]-World. It is now \ + [clock format [clock seconds]]. Somevar=$somevar" + } + + # mixin the Class CGI into the payload object of the ::xowiki::Object + # since the object renderer queries the method content, it picks up the + # above behavior + my mixin add CGI +} + + + Index: openacs-4/packages/xowiki/www/prototypes/CGI3.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/CGI3.page,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/prototypes/CGI3.page 1 Aug 2007 21:39:27 -0000 1.2.2.2 @@ -0,0 +1,40 @@ +# -*- tcl-*- +# $Id: CGI3.page,v 1.2.2.2 2007/08/01 21:39:27 gustafn Exp $ +::xowiki::Object new -title "CGI3" -text { + # + # The parameter declaration sets the context for the + # evaluation. It combines the provided values from an + # includelet with the values provided via the url with + # the specified default values. + # + my initialize -parameter { + {-object_type ::xowiki::Page} + {-text "Hello World"} + {-x:integer} + {-z:integer 100} + } + + # + # The classes and objects here are all local to the object, + # as long as no absolute class or object names are used (no leading colons) + # + + Class CGI + CGI instproc content {} { + my get_parameters + + set vars [info vars] + set somevar 100 + return "Hello \[\[Wiki\]\]-World. It is now \ + [clock format [clock seconds]]. Somevar=$somevar, vars=$vars, + package_id=$package_id, z=3. $text" + } + + # mixin the Class CGI into the payload object of the ::xowiki::Object + # since the object renderer queries the method content, it picks up the + # above behavior + my mixin add CGI +} + + + Index: openacs-4/packages/xowiki/www/prototypes/ajax-chat.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/ajax-chat.page,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/prototypes/ajax-chat.page 1 Aug 2007 21:39:27 -0000 1.1.2.2 @@ -0,0 +1,13 @@ +# -*- tcl-*- +# $Id: ajax-chat.page,v 1.1.2.2 2007/08/01 21:39:27 gustafn Exp $ +::xowiki::Object new -title "Ajax Chat" -text { + + proc content {} { + #::xowiki::Chat login -chat_id 22 -mode polling + ::xowiki::Chat login -chat_id 22 + } + +} + + + Index: openacs-4/packages/xowiki/www/prototypes/announcements.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/Attic/announcements.page,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/prototypes/announcements.page 1 Aug 2007 21:39:27 -0000 1.3.2.2 @@ -0,0 +1,122 @@ +# -*- tcl-*- +# $Id: announcements.page,v 1.3.2.2 2007/08/01 21:39:27 gustafn Exp $ +::xowiki::Object new -title "Announcements" -text { + # + # A sample Announcements object. + # + my initialize -parameter { + {-page_size:integer 10} + {-page_number:integer 1} + {-summary:boolean 0} + {-date ""} + {-tag ""} + {-ptag ""} + {-entries_of en:announcement-entry} + } + + # The name filter is not the most efficient way of selecting + # autonamed entries. However, most times the number of announcements items + # is not overwhelming, so we can live with that for the time being. + # TODO: more efficient selection of autonamed entries + + # + # The following definition is the default rendering per + # announcements entry. This is executed in the context of every displayed page. + # + Class create EntryRenderer -instproc render {} { + my instvar package_id name title creator creation_user pretty_date description publish_date + [my set __parent] instvar weblog_obj + + set link [::$package_id pretty_link $name] + set more [expr {[$weblog_obj summary] ? + " \[#xowiki.weblog-more#\]" : ""}] + append more "

" + set day [lc_time_fmt [my set publish_date] "%x"] + set my_footer [my htmlFooter] + + append content "

" \ + "

$title

" \ + " ($day)
" \ + $description $more $my_footer \n\ + "

" + } + + # + # The following definition is the renderer for the full weblog. + # This is executed in the context of the whole weblog object + # + Class create AnnouncementsRenderer -instproc render {} { + my instvar filter_msg link name prev_page_link next_page_link title + + set filter "" + set prev "" + set next "" + + if {[info exists filter_msg]} { + set filter "

$filter_msg

" + } + if {[info exists prev_page_link]} { + set prev "\ + Previous Page

" + } + if {[info exists next_page_link]} { + set next "\ + Next Page

" + } + set page [my set __page] + [my set __parent] instvar weblog_obj + set rss [$page include_portlet \ + "rss-button -title {[$page title]} -entries_of [$weblog_obj entries_of]"] + #set rss [list [self] [lsort [my info vars]]] + return "

$filter [next] $prev $next
$rss

" + } + + my proc content {} { + my get_parameters + set page [my info parent] + + if {[$page exists __including_page]} { + set i [$page set __including_page] + set exclude_item_ids [$i item_id] + $i set render_adp 0 ;# no double substitutions + #my log "--W including page $i" + } else { + #my log "--W NO including page" + set exclude_item_ids [$page item_id] + $page set __no_footer 1 + } + + # on the announcements page, an edit-new should not create an object + ::xo::cc set_parameter object_type ::xowiki::Page + ::xo::cc set_parameter autoname 1 + + # use the above defined custom renderers + set renderer [self]::AnnouncementsRenderer + set entry_renderer [self]::EntryRenderer + + set w [::xowiki::Weblog new -destroy_on_cleanup \ + -package_id $package_id \ + -page_size $page_size \ + -page_number $page_number \ + -summary $summary \ + -date $date \ + -category_id [ns_queryget category_id] \ + -tag $tag \ + -ptag $ptag \ + -entry_label "Announcements" \ + -exclude_item_ids $exclude_item_ids \ + -entry_renderer $entry_renderer \ + -entry_flag __no_form_page_footer \ + -entries_of $entries_of \ + ] + $w set __page $page + $w mixin add $renderer + return [$w render] + } + +} + + + Index: openacs-4/packages/xowiki/www/prototypes/bib.page =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/prototypes/bib.page,v diff -u -N --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/prototypes/bib.page 1 Aug 2007 21:39:27 -0000 1.2.2.2 @@ -0,0 +1,99 @@ +# -*- tcl -*- +# $Id: bib.page,v 1.2.2.2 2007/08/01 21:39:27 gustafn Exp $ +::xowiki::Object new -title "Bibliography Includelet" -text { + # + # A bibliography interface based on weblog. + # Bibliography entries are typically selected via + # entries_of (PageInstances, FormInstances). + # + # Gustaf Neumann fecit, May 2007 + # + my initialize -parameter { + {-summary:boolean 0} + {-date ""} + {-category_id ""} + {-tag ""} + {-ptag ""} + {-entries_of ""} + } + + # + # The following definition is the default rendering per + # weblog entry. This is executed in the context of every displayed page. + # + Class create EntryRenderer + EntryRenderer instproc render {} { + append content "

URL:
Title (tooltip):
Target:	+	+ + + + + #acs-templating.HTMLArea_OpenFileStorage# + + +
+ + +

#acs-templating.HTMLArea_ImageURL#	+ +
#acs-templating.HTMLArea_ImageAlternateText#
+ + + + + #acs-templating.HTMLArea_OpenFileStorage# +

$title

$my_tree_name

$label

$users$what$when

Error:

[$i current] $title

$title

@page_title@

$msg

$msg

$msg

$title

@title@

$my_tree_name

$title

$title


	'+(o3_textfontclass ? '' : wrapStr(0,o3_textsize,'text'))+text+(o3_textfontclass ? '' : wrapStr(1,o3_textsize))+'


	'+text+'