Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -N -r1.131 -r1.132 --- openacs-4/packages/xowiki/xowiki.info 17 Jun 2010 10:45:12 -0000 1.131 +++ openacs-4/packages/xowiki/xowiki.info 18 Jun 2010 10:24:59 -0000 1.132 @@ -10,11 +10,11 @@ t xowiki - + Gustaf Neumann A more generic xotcl-based wikis example with object types and subtypes based on the content repository (with category support) - 2010-06-17 + 2010-06-18 Gustaf Neumann, WU Wien <pre> XoWiki is a Wiki implementation for OpenACS in XOTcl. Instead of @@ -61,7 +61,7 @@ - + Index: openacs-4/packages/xowiki/tcl/package-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/package-procs.tcl,v diff -u -N -r1.219 -r1.220 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 17 Jun 2010 10:45:12 -0000 1.219 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 18 Jun 2010 10:24:59 -0000 1.220 @@ -122,7 +122,6 @@ set lang $default_lang } - } elseif {[regexp {^(..):(.*)$} $path _ lang local_name]} { } elseif {[regexp {^(file|image|swf|download/file|tag)/(.*)$} $path _ lang local_name]} { } else { set local_name $path @@ -143,20 +142,30 @@ } } - Package instproc get_parent_and_name {-path:required -lang:required -folder_id:required vparent vlocal_name} { + Package instproc get_parent_and_name {-path:required -lang:required -parent_id:required vparent vlocal_name} { my upvar $vparent parent $vlocal_name local_name - #my log "path=$path folder_id=$folder_id" + #my log "path=$path parent_id=$parent_id" if {[regexp {^([^/]+)/(.+)$} $path _ parent local_name]} { - # pages are stored with a lang prefix - set p [::xo::db::CrClass lookup -name ${lang}:$parent -parent_id $folder_id] - #my log "check '$parent' returned $p" + + # try without a prefix + set p [::xo::db::CrClass lookup -name $parent -parent_id $parent_id] + my log "check '$parent' returned $p" + if {$p == 0} { - # folders are stored without a lang prefix - set p [::xo::db::CrClass lookup -name $parent -parent_id $folder_id] + # pages are stored with a lang prefix + set p [::xo::db::CrClass lookup -name ${lang}:$parent -parent_id $parent_id] + my log "check '${lang}:$parent' returned $p" } + + if {$p == 0 && $lang ne "en"} { + # try again with prefix "en" + set p [::xo::db::CrClass lookup -name en:$parent -parent_id $parent_id] + my log "check 'en:$parent' returned $p" + } + if {$p != 0} { if {[regexp {^([^/]+)/(.+)$} $local_name _ parent2 local_name2]} { - set p2 [my get_parent_and_name -path $local_name -lang $lang -folder_id $p parent local_name] + set p2 [my get_parent_and_name -path $local_name -lang $lang -parent_id $p parent local_name] #my log "recursive call for '$local_name' parent_id=$p returned $p2" if {$p2 != 0} { set p $p2 @@ -170,7 +179,7 @@ set parent "" # a trailing slash indicates a directory, remove it from the path set local_name [string trimright $path /] - return $folder_id + return $parent_id } Package instproc get_page_from_name {{-parent_id ""} -name:required} { @@ -187,30 +196,25 @@ # # handle different parent_ids # - if {$parent_id ne "" && $parent_id != [my folder_id]} { - # The item might be in a folder along the folder path. so it - # will be found by the object resolver. For the time being, we - # do nothing more about this. - - set path "" - while {1} { - # TODO: on the longer range, this should not be required, but we have - # to solve the folder object problem first... - if {[::xo::db::sql::content_folder is_folder -item_id $parent_id]} { - set queryClass ::xo::db::CrFolder - } else { - set queryClass ::xo::db::CrClass - } - set fo [$queryClass get_instance_from_db -item_id $parent_id] - set path [$fo name]/$path - if {[my folder_id] == [$fo parent_id]} break - if {[$fo parent_id]<0} break - set parent_id [$fo parent_id] - } - return $path + if {$parent_id eq "" || $parent_id == [my folder_id]} { + return "" } - - return "" + # + # The item might be in a folder along the folder path. so it + # will be found by the object resolver. For the time being, we + # do nothing more about this. + # + set path "" + while {1} { + set fo [::xo::db::CrClass get_instance_from_db -item_id $parent_id] + #my get_lang_and_name -name [$fo name] lang stripped_name + #set path $stripped_name/$path + set path [$fo name]/$path + if {[my folder_id] == [$fo parent_id]} break + if {[$fo parent_id]<0} break + set parent_id [$fo parent_id] + } + return $path } @@ -227,8 +231,8 @@ if {$folder ne ""} { # Return the stripped name for sub-items, the parent has already # the language prefix - my get_lang_and_name -name $name lang stripped_name - return $folder$stripped_name + #my get_lang_and_name -name $name lang stripped_name + return $folder$name } return $name @@ -1286,7 +1290,7 @@ if {$lang eq "download/file" || $lang eq "file"} { # handle subitems, currently only for files set parent_id [my get_parent_and_name -lang $lang \ - -path $stripped_name -folder_id $folder_id \ + -path $stripped_name -parent_id $folder_id \ parent local_name] #my log "get_parent_and_name returned parent_id=$parent_id, name='$local_name'" set item_id [::xo::db::CrClass lookup -name file:$local_name -parent_id $parent_id] @@ -1317,7 +1321,7 @@ if {$item_id == 0} { set parent_id [my get_parent_and_name -lang $lang \ - -path $stripped_name -folder_id $folder_id \ + -path $stripped_name -parent_id $folder_id \ parent local_name] #my log "get_parent_and_name returned parent=$parent, parent_id=$parent_id, deflang $lang name='$local_name'" my get_lang_and_name -default_lang $lang -path $local_name lang stripped_name Index: openacs-4/packages/xowiki/tcl/weblog-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/weblog-procs.tcl,v diff -u -N -r1.52 -r1.53 --- openacs-4/packages/xowiki/tcl/weblog-procs.tcl 17 Jun 2010 10:45:12 -0000 1.52 +++ openacs-4/packages/xowiki/tcl/weblog-procs.tcl 18 Jun 2010 10:24:59 -0000 1.53 @@ -60,6 +60,7 @@ set folder_id [::$package_id folder_id] set filter_msg "" set query_parm "" + set query [ns_conn query] # set up filters set extra_from_clause "" @@ -70,6 +71,7 @@ set date_clause "and [::xo::db::sql date_trunc_expression day bt.publish_date $date]" set filter_msg "Filtered by date $date" set query_parm "&date=$date" + set query [::xo::update_query $query date $date] } else { set date_clause "" } @@ -85,6 +87,7 @@ append extra_from_clause "" set filter_msg "Filtered by category [join $cnames {, }]" set query_parm "&category_id=$category_id" + set query [::xo::update_query $query category_id $category_id] } #my msg "tag=$tag" if {$tag ne ""} { @@ -100,6 +103,7 @@ append extra_from_clause ",xowiki_tags tags " append extra_where_clause "and tags.item_id = ci.item_id and tags.tag = :ptag " set query_parm "&ptag=[ad_urlencode $ptag]" + set query [::xo::update_query $query ptag $ptag] } #my msg filter_msg=$filter_msg if {$name_filter ne ""} { @@ -234,9 +238,13 @@ } array set smsg {1 full 0 summary} - set weblog_href [$package_id package_url][$package_id get_parameter weblog_page] - set flink "$smsg($summary)" + set query [::xo::update_query $query summary [expr {!$summary}]] + set weblog_href [::xo::cc url]?$query + #set weblog_href [$package_id package_url][$package_id get_parameter weblog_page] + #set flink "$smsg($summary)" + set flink "$smsg($summary)" + if {$page_number ne ""} { set nr [llength [$items children]] set from [expr {($page_number-1)*$page_size+1}] @@ -253,12 +261,12 @@ set prev_p [expr {$page_number > 1}] if {$next_p} { - set query [::xo::update_query_variable [ns_conn query] page_number [expr {$page_number+1}]] - set next_page_link [export_vars -base [::xo::cc url] $query] + set query [::xo::update_query $query page_number [expr {$page_number+1}]] + set next_page_link [::xo::cc url]?$query } if {$prev_p} { - set query [::xo::update_query_variable [ns_conn query] page_number [expr {$page_number-1}]] - set prev_page_link [export_vars -base [::xo::cc url] $query] + set query [::xo::update_query $query page_number [expr {$page_number-1}]] + set prev_page_link [::xo::cc url]?$query } } #my proc destroy {} {my log "--W"; next} Index: openacs-4/packages/xowiki/tcl/xowiki-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-callback-procs.tcl,v diff -u -N -r1.62 -r1.63 --- openacs-4/packages/xowiki/tcl/xowiki-callback-procs.tcl 17 Jun 2010 10:45:12 -0000 1.62 +++ openacs-4/packages/xowiki/tcl/xowiki-callback-procs.tcl 18 Jun 2010 10:24:59 -0000 1.63 @@ -551,7 +551,29 @@ $package_id import-prototype-page weblog-portlet $package_id import-prototype-page news } - } + } + set v 0.131 + if {[apm_version_names_compare $from_version_name $v] == -1 && + [apm_version_names_compare $to_version_name $v] > -1} { + ns_log notice "-- upgrading to $v" + foreach pp [::xo::PackageMgr info instances] { + foreach package_id [$pp instances] { + ::xo::Package initialize -package_id $package_id + if {![$package_id istype ::xowiki::Package]} continue + # strip language prefix from folder pages + set ff [::xowiki::Weblog instantiate_forms -forms en:folder.form -package_id $package_id] + set e [::xowiki::FormPage get_form_entries -form_fields "" \ + -base_item_ids $ff -package_id $package_id \ + -always_queried_attributes *] + foreach fp [$e children] { + set n [$fp name] + regexp {^..:(.+)$} $n . n + $fp rename -old_name [$fp name] -new_name $n + } + } + } + } + } } Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -N -r1.401 -r1.402 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 17 Jun 2010 10:45:12 -0000 1.401 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 18 Jun 2010 10:24:59 -0000 1.402 @@ -581,12 +581,17 @@ # If we import from an old database without page_order, provide a # default value if {![my exists page_order]} {my set page_order ""} - # Check, if nls_language and lang are aligned. - if {[regexp {^(..):} [my name] _ lang]} { - if {[string range [my nls_language] 0 1] ne $lang} { - set old_nls_language [my nls_language] - my nls_language [my get_nls_language_from_lang $lang] - ns_log notice "nls_language for item [my name] set from $old_nls_language to [my nls_language]" + if {[my is_folder_page]} { + # reset names if necessary (e.g. import from old releases) + my build_name + } else { + # Check, if nls_language and lang are aligned. + if {[regexp {^(..):} [my name] _ lang]} { + if {[string range [my nls_language] 0 1] ne $lang} { + set old_nls_language [my nls_language] + my nls_language [my get_nls_language_from_lang $lang] + ns_log notice "nls_language for item [my name] set from $old_nls_language to [my nls_language]" + } } } # in the general case, no more actions required @@ -864,6 +869,12 @@ return "" } + Page instproc is_folder_page {} { + if {![my istype ::xowiki::FormPage]} {return 0} + if {[[my page_template] name] ne "en:folder"} {return 1} + return 0 + } + Page instproc build_name {{-nls_language ""}} { # # Build the name of the page, based on the provided nls_language @@ -878,17 +889,15 @@ # prepend the language prefix only, if the entry is not empty if {$stripped_name ne ""} { - #if {[my istype ::xowiki::PageInstance]} { + if {[my is_folder_page]} { # - # Do not add a language prefix to anonymous pages + # Do not add a language prefix to folder pages # - #set anon_instances [my get_from_template anon_instances f] - #if {$anon_instances} { - # return $stripped_name - #} - #} - if {$nls_language ne ""} {my nls_language $nls_language} - set name [my lang]:$stripped_name + set name $stripped_name + } else { + if {$nls_language ne ""} {my nls_language $nls_language} + set name [my lang]:$stripped_name + } } return $name } @@ -1849,8 +1858,6 @@ {render_adp 0} } File instproc build_name {name {fn ""}} { - my instvar mime_type package_id - set type file if {$name ne ""} { set stripped_name $name regexp {^(.*):(.*)$} $name _ _t stripped_name @@ -1860,7 +1867,7 @@ # filename. Just use the last part in such cases as name. regexp {[/\\]([^/\\]+)$} $stripped_name _ stripped_name } - return ${type}:[::$package_id normalize_name $stripped_name] + return file:[[my $package_id] normalize_name $stripped_name] } File instproc full_file_name {} { if {![my exists full_file_name]} { @@ -2466,6 +2473,9 @@ # provided via package_id, "*" means from all # packages. Forthermore, a list of package_ids can be given. # + # "-always_queried_attributes *" means to obtain enough attributes + # to allow a save operatons etc. on the instances. + # set sql_atts [list ci.parent_id bt.revision_id bt.instance_attributes \ bt.creation_date bt.creation_user bt.last_modified \