Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -r1.27 -r1.28 --- openacs-4/packages/xowiki/xowiki.info 12 Sep 2006 12:05:24 -0000 1.27 +++ openacs-4/packages/xowiki/xowiki.info 15 Sep 2006 16:44:59 -0000 1.28 @@ -8,37 +8,38 @@ f xowiki - + Gustaf Neumann A more generic xotcl-based wikis example with object types and subtypes based on the content repository (with category support) - 2006-08-16 + 2006-09-15 XoWiki is a wiki implementation for OpenACS in xotcl. Instead of trying to implement the full set of wiki markup commands of systems like MediaWiki, XoWiki is based on a rich text editor and focuses more on integration with oacs (e.g categories, general comments, adp-includes). XoWiki combines aspects of wikis (ease of page-creation) with aspects of a content management system (revisions, re-usable items, multiple languages). Furthermore, XoWiki allows to define different types of links such -one could define book-structures (where a navigation structure could be built on the fly) or glossaries with differnt kind of word relationships (like synonyms, etc.). XoWiki supports pages in multiple languages and is localized (currently only for English and German). Currently, richtext and plaintext type entries are supported. Included support for adp-substitution in wiki pages and a file-selector. 0.13 supports page templates and uses the new generic form interface. Use of the oo layer for the content repository, reduced number of database interactions.0.18 supports text/enhanced, nice page names, import/export. Support for search (::xowiki::Page and ::xowiki::PlainPage); 0.20 support ::xowiki::Object, directory object, rss generation into syndication table, improved admin pages; 0.21: ajax-ased chat added, new attributes creator and page_title for all xowiki::Pages; 0.22 improved permission checking. 0.24 provides link-types, more includeletes (most-recently viewed, most frequently accessed pages). 0.26 provides Weblog support. 0.27: alignment with xotcl-core 0.38 (use cr_item.name instead of cr_revisions.title), change page_title to title (potential incompatibility) to rely more strictly to the CR data model (most files are effected). 0.28: tag and improved weblog support. 0.30: symbolic oo interface, nicer links, permission management. 0.31: per package search. 0.32: new class ::xowiki::File for [[file:readme.pdf]] and [[image:picture.jpg]] 0.33: direct inclusion of xowiki pages via {{en:mypage}}, simpler default pages (see xowiki/www/default-pages). 0.34: notifications; 0.36: prototypes, direct includes, context handling +one could define book-structures (where a navigation structure could be built on the fly) or glossaries with differnt kind of word relationships (like synonyms, etc.). XoWiki supports pages in multiple languages and is localized (currently only for English and German). Currently, richtext and plaintext type entries are supported. Included support for adp-substitution in wiki pages and a file-selector. 0.13 supports page templates and uses the new generic form interface. Use of the oo layer for the content repository, reduced number of database interactions.0.18 supports text/enhanced, nice page names, import/export. Support for search (::xowiki::Page and ::xowiki::PlainPage); 0.20 support ::xowiki::Object, directory object, rss generation into syndication table, improved admin pages; 0.21: ajax-ased chat added, new attributes creator and page_title for all xowiki::Pages; 0.22 improved permission checking. 0.24 provides link-types, more includeletes (most-recently viewed, most frequently accessed pages). 0.26 provides Weblog support. 0.27: alignment with xotcl-core 0.38 (use cr_item.name instead of cr_revisions.title), change page_title to title (potential incompatibility) to rely more strictly to the CR data model (most files are effected). 0.28: tag and improved weblog support. 0.30: symbolic oo interface, nicer links, permission management. 0.31: per package search. 0.32: new class ::xowiki::File for [[file:readme.pdf]] and [[image:picture.jpg]] 0.33: direct inclusion of xowiki pages via {{en:mypage}}, simpler default pages (see xowiki/www/default-pages). 0.34: notifications; 0.36: prototypes, direct includes, context handling; 0.37: initial reqression testing (118 tests) BSD-Style 0 - + - + + 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 -r1.11 -r1.12 --- openacs-4/packages/xowiki/tcl/package-procs.tcl 8 Sep 2006 21:49:45 -0000 1.11 +++ openacs-4/packages/xowiki/tcl/package-procs.tcl 15 Sep 2006 16:45:00 -0000 1.12 @@ -91,9 +91,17 @@ return [my call $page $method] } else { return [my error_msg "No page '[my set object]' available."] - #ad_returnredirect "[my package_url]admin/list" } } + Package instproc reply_to_user {text} { + if {[::xo::cc exists __continuation]} { + eval [::co::cc set __continuation] + } else { + if {[string length $text] > 1} { + [my set delivery] 200 [my set mime_type] $text + } + } + } Package instproc error_msg {error_msg} { my instvar id @@ -229,7 +237,7 @@ Package instproc require_folder_object { } { my instvar id folder_id - my log "--f [::xotcl::Object isobject ::$folder_id] folder_id=$folder_id" + #my log "--f [::xotcl::Object isobject ::$folder_id] folder_id=$folder_id" if {$folder_id == 0} { set folder_id [::xowiki::Page require_folder -name xowiki -package_id $id] @@ -343,7 +351,7 @@ if {$item_id ne ""} { my log "--D trying to delete $item_id $name" ::Generic::CrItem delete -item_id $item_id - ns_cache flush xotcl_object_cache ::$item_id + #ns_cache flush xotcl_object_cache ::$item_id;;; done by generic # we should probably flush as well cached revisions if {$name eq "::$folder_id"} { my log "--D deleting folder object ::$folder_id" @@ -356,7 +364,7 @@ } else { my log "--D nothing to delete!" } - ad_returnredirect [my query_parameter "return_url" [$id package_url]] + my returnredirect [my query_parameter "return_url" [$id package_url]] } Package instproc condition {method attr value} { Index: openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl,v diff -u -r1.13 -r1.14 --- openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl 17 Aug 2006 01:44:26 -0000 1.13 +++ openacs-4/packages/xowiki/tcl/xowiki-form-procs.tcl 15 Sep 2006 16:45:00 -0000 1.14 @@ -122,8 +122,9 @@ proc ::xowiki::validate_name {} { upvar name name nls_language nls_language folder_id folder_id \ object_type object_type mime_type mime_type - #my log "--F validate_name ot=$object_type data=[my exists data]" my instvar data + #my log "--F validate_name ot=$object_type data=[my exists data]" + $data instvar package_id if {$object_type eq "::xowiki::File" && [$data exists mime_type]} { #my get_uploaded_file switch -glob -- [$data set mime_type] { @@ -136,21 +137,19 @@ } else { set stripped_name [$data set upload_file] } - set name ${type}:[::[ad_conn package_id] normalize_name $stripped_name] + set name ${type}:[::$package_id normalize_name $stripped_name] } else { if {![regexp {^..:} $name]} { if {![info exists nls_language]} {set nls_language ""} if {$nls_language eq ""} {set nls_language [lang::conn::locale]} set name [string range $nls_language 0 1]:$name } - set name [::[ad_conn package_id] normalize_name $name] + set name [::$package_id normalize_name $name] } # check, if we try to create a new item with an existing name - #my log "--form vars = [ns_set array [ns_getform] ]" - #my log "--form comparing '[ns_set get [ns_getform] __object_name]' w '$name'" - if {[ns_set get [ns_getform] __new_p] - || [ns_set get [ns_getform] __object_name] ne $name + if {[$data form_parameter __new_p] + || [$data form_parameter __object_name] ne $name } { return [expr {[CrItem lookup -name $name -parent_id $folder_id] == 0}] } @@ -159,9 +158,8 @@ WikiForm instproc handle_enhanced_text_from_form {} { my instvar data - array set __tmp [ns_set array [ns_getform]] - if {[info exists __tmp(text.format)]} { - $data set mime_type $__tmp(text.format) + if {[$data exists_form_parameter text.format]} { + $data set mime_type [$data form_parameter text.format] } } WikiForm instproc update_references {} { @@ -176,7 +174,8 @@ # could be made more intelligent to delete entries is more rare cases, like # in case the file was renamed my instvar folder_id - ##### why is ns_cache names xowiki_cache *pattern* not working??? upgrade ns_cache to 1.5! + ##### why is ns_cache names xowiki_cache *pattern* not working??? + ##### upgrade ns_cache from CVS ! foreach entry [ns_cache names xowiki_cache link-*-$folder_id] { array set tmp [ns_cache get xowiki_cache $entry] if {$tmp(item_id) == [$data set item_id]} { @@ -355,12 +354,10 @@ set object_type [[$data info class] object_type] #my log "-- data=$data cl=[$data info class] ot=$object_type" set item_id [$data set item_id] - set page_template [ns_set get [ns_getform] page_template] - set f [ns_getform] + set page_template [$data form_parameter page_template] if {[$data exists_query_parameter return_url]} { set return_url [$data query_parameter return_url] } - #if {[ns_set find $f return_url]} {set return_url [ns_set get $f return_url]} set link [::[$data set package_id] pretty_link [$data set name]] #my submit_link [export_vars -base edit {folder_id object_type item_id page_template return_url}] my submit_link [export_vars -base $link {{m edit} page_template return_url item_id}] @@ -395,7 +392,7 @@ set __vars {folder_id item_id page_template return_url} set object_type [[$data info class] object_type] #my log "-- cl=[[my set data] info class] ot=$object_type $__vars" - foreach __v $__vars {set $__v [ns_queryget $__v]} + foreach __v $__vars {set $__v [$data from_parameter $__v] ""} set item_id [next] set link [::[$data set package_id] pretty_link [$data set name]] @@ -432,8 +429,8 @@ PageInstanceEditForm instproc init {} { my instvar data page_instance_form_atts - set item_id [ns_queryget item_id] - set page_template [ns_queryget page_template] + set item_id [$data form_parameter item_id] + set page_template [$data form_parameter page_template ""] if {$page_template eq ""} { set page_template [$data set page_template] #my log "-- page_template = $page_template" Index: openacs-4/packages/xowiki/tcl/xowiki-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/xowiki-procs.tcl,v diff -u -r1.51 -r1.52 --- openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 12 Sep 2006 12:04:36 -0000 1.51 +++ openacs-4/packages/xowiki/tcl/xowiki-procs.tcl 15 Sep 2006 16:45:00 -0000 1.52 @@ -456,7 +456,6 @@ Page instproc initialize_loaded_object {} { my instvar title creator if {[info exists title] && $title eq ""} {set title [my set name]} - #if {$creator eq ""} {set creator [::xo::get_user_name [my set creation_user]]} next } @@ -861,13 +860,12 @@ my instvar page_template #my log "-- fetching page_template = $page_template" ::Generic::CrItem instantiate -item_id $page_template - uplevel #0 [list $page_template volatile] - #return [my substitute_markup [my adp_subst [$page_template set text]]] - if {[my set instance_attributes] eq ""} { - return [my adp_subst [lindex [$page_template set text] 0]] - } + $page_template destroy_on_cleanup + #if {[my set instance_attributes] eq ""} { + # set T [my adp_subst [$page_template set text]] + # return [my substitute_markup $T] + #} set T [my adp_subst [$page_template set text]] - #my log T=$T return [my substitute_markup $T] } PageInstance instproc adp_subst {content} { 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 -r1.13 -r1.14 --- openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 12 Sep 2006 12:04:36 -0000 1.13 +++ openacs-4/packages/xowiki/tcl/xowiki-www-procs.tcl 15 Sep 2006 16:45:00 -0000 1.14 @@ -291,19 +291,18 @@ db_exec_plsql make_live {select content_item__set_live_revision(:revision_id)} set page_id [my query_parameter "page_id"] ns_cache flush xotcl_object_cache ::$item_id - ad_returnredirect [my query_parameter "return_url" \ - [export_vars -base [$package_id url] {{m revisions}}]] + ::$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 - my log "--M delete revision($revision_id)" db_exec_plsql delete_revision {select content_revision__del(:revision_id)} ns_cache flush xotcl_object_cache ::$item_id ns_cache flush xotcl_object_cache ::$revision_id - ad_returnredirect [my query_parameter "return_url" \ - [export_vars -base [$package_id url] {{m revisions}}]] + ::$package_id returnredirect [my query_parameter "return_url" \ + [export_vars -base [$package_id url] {{m revisions}}]] } Page instproc delete {} { @@ -315,7 +314,8 @@ 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 tags] - ad_returnredirect [my query_parameter "return_url" [$package_id url]] + ::$package_id returnredirect \ + [my query_parameter "return_url" [$package_id url]] } Page instproc popular-tags {} { Index: openacs-4/packages/xowiki/www/index.vuh =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/index.vuh,v diff -u -r1.4 -r1.5 --- openacs-4/packages/xowiki/www/index.vuh 17 Aug 2006 01:44:26 -0000 1.4 +++ openacs-4/packages/xowiki/www/index.vuh 15 Sep 2006 16:45:00 -0000 1.5 @@ -13,12 +13,12 @@ {-folder_id:integer 0} } -::$package_id log "--starting... [ns_conn url] [ns_conn query] form vars = [ns_set array [ns_getform]]" -set text [::$package_id invoke -method $m] -if {[string length $text] > 1} { - #::$package_id log "--delivery [::$package_id set delivery] 200 [::$package_id set mime_type] \ - [string length $text] bytes" - [::$package_id set delivery] 200 [::$package_id set mime_type] $text -} +::$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/admin/regression_test.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/admin/Attic/regression_test.tcl,v diff -u --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ openacs-4/packages/xowiki/www/admin/regression_test.tcl 15 Sep 2006 16:45:00 -0000 1.1 @@ -0,0 +1,545 @@ + +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 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" + +? {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" +} +######################################################################## +test section "New Instance" +# +# 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" + +# 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/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" + +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 [::xowiki::Page select_query \ + -folder_id $folder_id -count true]} 1 \ + "folder contains the folder object" + +test subsection "Create and Render Index Page" +? {$package_id set object} en/index "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 [::xowiki::Page select_query \ + -folder_id $folder_id -count true]} 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" +? {::$page_item_id make_link ::$page_item_id delete return_url} "" \ + "the public cannot delete this page" +? {::$page_item_id make_link -privilege admin -url admin/ $package_id {} {}} "" \ + "the public cannot admin this package" + +######################################################################## +# +# 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 [::xowiki::Page select_query \ + -folder_id $folder_id -count true]} 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" + +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 [::xowiki::Page select_query \ + -folder_id [$package_id folder_id] \ + -count true]} 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 {[::$page_item_id make_link ::$page_item_id delete return_url] ne ""}} 1 \ + "SWA sees the delete link" +? {expr {[::$page_item_id make_link -privilege admin -url admin/ $package_id {} {}] ne ""}} 1 \ + "SWA sees admin link" +? {db_string count [::xowiki::Page select_query \ + -folder_id [$package_id folder_id] \ + -count true]} 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 [::xowiki::Page select_query \ + -folder_id [$package_id folder_id] \ + -count true]} 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 [::xowiki::Page select_query \ + -folder_id [$package_id folder_id] \ + -count true]} 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 [::xowiki::Page select_query \ + -folder_id [$package_id folder_id] \ + -count true]} 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 [::xowiki::Page select_query \ + -folder_id [$package_id folder_id] \ + -count true]} 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/en/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" + + +######################################################################## +test section "Edit new ::xowiki::PlainPage via weblink" + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/ \ + -actual_query "object%5ftype=%3a%3axowiki%3a%3aPlainPage&edit%2dnew=1" \ + -user_id [lindex $swas 0] + +set content [::$package_id invoke -method $m] +? {string first Error $content} -1 "page contains no error" +? {expr {[string first "Plain Page" $content]>-1}} 1 \ + "page contains Plain Page" + +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} 0 "item is not 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" + + +######################################################################## +test section "Submit edited ::xowiki::PlainPage via weblink" + +set return_url /$instance_name/admin + +::xowiki::Package initialize -parameter $index_vuh_parms \ + -package_id $info(package_id) \ + -url /$instance_name/ \ + -actual_query "object%5ftype=%3a%3axowiki%3a%3aPlainPage&edit%2dnew=1" \ + -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 1 + __key_signature {$signature} + __object_name {} + name en:plain_page_1 + object_type ::xowiki::PlainPage + text.format text/html + creator {Gustaf Neumann} + description {{this is the description}} + text {{Content of Plain Page}} + nls_language en_US + folder_id $returned_folder_id + title {{Plain Page 1}} + 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" +? {expr {[string first "Content of Plain Page" $content]>-1}} 1 \ + "page contains specified content" + +? {::xo::cc exists __continuation} 1 "continuation exists" +? {::xo::cc set __continuation} \ + "ad_returnredirect /$instance_name/en/plain_page_1" \ + "redirect to PlainPage" + +ns_write "

+

+ Tests passed: [test set passed]
+ Tests failed: [test set failed]
+ Tests Time: [t1 diff -start]ms
+" \ No newline at end of file Fisheye: Tag 1.9 refers to a dead (removed) revision in file `openacs-4/packages/xowiki/www/portlets/weblog.tcl'. Fisheye: No comparison available. Pass `N' to diff? Index: openacs-4/packages/xowiki/www/resources/xowiki.css =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/resources/xowiki.css,v diff -u -r1.5 -r1.6 --- openacs-4/packages/xowiki/www/resources/xowiki.css 18 Aug 2006 14:05:32 -0000 1.5 +++ openacs-4/packages/xowiki/www/resources/xowiki.css 15 Sep 2006 16:45:00 -0000 1.6 @@ -46,7 +46,7 @@ color: silver; background-color: silver; } #page-body {background: #fff; font: 10pt Arial, Helvetica, sans-serif;} -table, td {font: 10px 'Lucida Grande', Geneva, Verdana, Arial, sans-serif; color: #000;} +/* table, td {font: 10px 'Lucida Grande', Geneva, Verdana, Arial, sans-serif; color: #000;}*/ #main div.column {text-align: left; margin-bottom: 1em;} #content {float: left; width: 70%} #page-body h1 {font-size: 24px; margin: 0 0 .5em 0;}