Index: openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl,v diff -u -N -r1.22.4.2 -r1.22.4.3 --- openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl 2 Oct 2013 08:42:38 -0000 1.22.4.2 +++ openacs-4/packages/acs-content-repository/tcl/content-item-procs.tcl 13 Sep 2014 15:24:28 -0000 1.22.4.3 @@ -106,7 +106,7 @@ # because the magic revision creation of the pl/sql proc does # not create a proper subtype of content revision, also it # can't set attributes of an extended type - + # the content type is not the object type of the cr_item so we pass in # the cr_item subtype here and content_type as part of # var_list @@ -116,39 +116,39 @@ # # db_dml lock_objects "LOCK TABLE acs_objects IN SHARE ROW EXCLUSIVE MODE" - set item_id [package_exec_plsql \ - -var_list $var_list \ - content_item new] - # if we have attributes we pass in everything - # and create a revision with all subtype attributes that were - # passed in - - # since we can't rely on content_item__new to create a revision - # we have to pass is_live to content::revision::new and - # set the live revision there - if {([info exists title] && $title ne "") - || ([info exists text] && $text ne "") - || ([info exists data] && $data ne "") - || ([info exists tmp_filename] && $tmp_filename ne "") - || [llength $attributes] - } { - content::revision::new \ - -item_id $item_id \ - -title $title \ - -description $description \ - -content $text \ - -mime_type $mime_type \ - -content_type $content_type \ - -is_live $is_live \ - -package_id $package_id \ - -creation_user $creation_user \ - -creation_ip $creation_ip \ - -creation_date $creation_date \ - -nls_language $nls_language \ - -tmp_filename $tmp_filename \ - -attributes $attributes - } - } + set item_id [package_exec_plsql \ + -var_list $var_list \ + content_item new] + # if we have attributes we pass in everything + # and create a revision with all subtype attributes that were + # passed in + + # since we can't rely on content_item__new to create a revision + # we have to pass is_live to content::revision::new and + # set the live revision there + if {([info exists title] && $title ne "") + || ([info exists text] && $text ne "") + || ([info exists data] && $data ne "") + || ([info exists tmp_filename] && $tmp_filename ne "") + || [llength $attributes] + } { + content::revision::new \ + -item_id $item_id \ + -title $title \ + -description $description \ + -content $text \ + -mime_type $mime_type \ + -content_type $content_type \ + -is_live $is_live \ + -package_id $package_id \ + -creation_user $creation_user \ + -creation_ip $creation_ip \ + -creation_date $creation_date \ + -nls_language $nls_language \ + -tmp_filename $tmp_filename \ + -attributes $attributes + } + } return $item_id } @@ -204,7 +204,7 @@ [list item_id $item_id] \ [list target_folder_id $target_folder_id] ] if {[info exists name] && $name ne ""} { - lappend var_list [list name $name] + lappend var_list [list name $name] } return [package_exec_plsql \ -var_list $var_list \ @@ -241,7 +241,7 @@ return [db_0or1row get_item_folder "" -column_array local_array] } set table_name [db_string get_table_name "select table_name from acs_object_types where object_type=:content_type"] - set table_name "${table_name}x" + set table_name "${table_name}x" # get attributes of the content_item use the content_typex view return [db_0or1row get_item "" -column_array local_array] } @@ -272,25 +272,25 @@ set update_text "" foreach {attribute_list} $attributes { - set attribute [lindex $attribute_list 0] - set value [lindex $attribute_list 1] - if {$attribute in $valid_attributes} { + set attribute [lindex $attribute_list 0] + set value [lindex $attribute_list 1] + if {$attribute in $valid_attributes} { - # create local variable to use for binding + # create local variable to use for binding - set $attribute $value - if {$update_text ne ""} { - append update_text "," - } - append update_text " ${attribute} = :${attribute} " - } + set $attribute $value + if {$update_text ne ""} { + append update_text "," + } + append update_text " ${attribute} = :${attribute} " } + } if {$update_text ne ""} { - # we have valid attributes, update them + # we have valid attributes, update them - set query_text "update cr_items set ${update_text} where item_id=:item_id" - db_dml item_update $query_text + set query_text "update cr_items set ${update_text} where item_id=:item_id" + db_dml item_update $query_text } } @@ -308,8 +308,8 @@ item exists } { return [package_exec_plsql \ - -var_list [list [list item_id $item_id]] \ - content_item get_content_type] + -var_list [list [list item_id $item_id]] \ + content_item get_content_type] } @@ -375,12 +375,12 @@ revisions, returns an empty string. @param item_id The item_id of the content item - + @return The best revision_id for the item, or an empty string if no revisions exist @see content::revision::item_id - @see content::item::get_live_revision + @see content::item::get_live_revision @see content::item::get_latest_revision } { return [package_exec_plsql -var_list [list \ @@ -393,15 +393,15 @@ } { Retrieves the latest revision for the item. If the item has no live revision, returns an empty string. - + @param item_id The item_id of the content item - + @return The latest revision_id for the item, or an empty string if no revisions exist @see content::revision::item_id @see content::item::get_best_revision - @see content::item::get_live_revision + @see content::item::get_live_revision } { return [package_exec_plsql -var_list [list \ [list item_id $item_id ] \ @@ -414,15 +414,15 @@ } { Retrieves the live revision for the item. If the item has no live revision, returns an empty string. - + @param item_id The item_id of the content item - + @return The live revision_id for the item, or an empty string if no live revision exists @see content::revision::item_id - @see content::item::get_best_revision - @see content::item::get_latest_revision + @see content::item::get_best_revision + @see content::item::get_latest_revision } { return [package_exec_plsql -var_list [list \ [list item_id $item_id ] \ @@ -509,10 +509,10 @@ a template registered directly to the item, returns the id of that template. Otherwise, returns the id of the default template registered to the item's content_type. Returns an empty string on failure. - + @param item_id The item_id @param context The context in which the template will be used (e.g. public) - + @return The template_id of the template which can be used to render the item, or an empty string on failure } { @@ -529,12 +529,12 @@ } { Get the title for the item. If a live revision for the item exists, use the live revision. Otherwise, use the latest revision. - + @param item_id The item_id of the content item @param is_live - + @return The title of the item - + @see content::item::get_best_revision @see content::item::get_title } { @@ -550,8 +550,8 @@ {-root_folder_id ""} } { Retrieves the relative path to the item. The path is relative to the - page root, and has no extension (Example: "/foo/bar/baz"). - + page root, and has no extension (Example: "/foo/bar/baz"). + @param item_id The item_id for the item, for which the path is computed @param root_folder_id Starts path resolution from this folder. Defaults to the root of the sitemap (when null). @@ -592,11 +592,11 @@ (according to min_n and max_n)
  • The workflow (if any) for the item is finished
    • - + @param item_id The item_id of the content item @see content::item::is_publishable - + @return 't' if the item is publishable, 'f' otherwise } { return [package_exec_plsql -var_list [list \ @@ -778,7 +778,7 @@ @param item_id - item_id of the content to be copied from. source content item @param target_folder_id - destination folder where the new content item is be passed - @param creation_user - + @param creation_user - @param creation_ip - @param name - the name of the new item, useful if you are copying in the same folder. @@ -800,55 +800,57 @@ {-package_id ""} } { Store the file uploaded under the parent_id if a file was uploaded - + @author Malte Sussdorff (sussdorff@sussdorff.de) @creation-date 2005-06-21 - + @param upload_file @param parent_id @return the revision_id of the generated item - - @error + + @error } { set filename [template::util::file::get_property filename $upload_file] if {$filename ne "" } { - set tmp_filename [template::util::file::get_property tmp_filename $upload_file] - set mime_type [template::util::file::get_property mime_type $upload_file] - set tmp_size [file size $tmp_filename] - set extension [file extension $filename] - # GN: where is the title supposed to come from? missing nonpos arg? - if {![info exists title] || $title eq ""} { + set tmp_filename [template::util::file::get_property tmp_filename $upload_file] + set mime_type [template::util::file::get_property mime_type $upload_file] + set tmp_size [file size $tmp_filename] + set extension [file extension $filename] + # GN: where is the title supposed to come from? missing nonpos arg? + if {![info exists title] || $title eq ""} { - # maltes: The following regsub garbles the title and consequently the filename as well. - # "info_c+w.zip" will become "info_c+" - # This is bad, first of all because a letter is missing entirely. Additionally - # the title in itself should be the original filename, after all this is what - # the user uploaded, not something stripped of its extension. - # So I commented this out until someone can either fix the regsub but more importantly - # can explain why the title should not contain the extension. + # maltes: The following regsub garbles the title and consequently the filename as well. + # "info_c+w.zip" will become "info_c+" + # This is bad, first of all because a letter is missing entirely. Additionally + # the title in itself should be the original filename, after all this is what + # the user uploaded, not something stripped of its extension. + # So I commented this out until someone can either fix the regsub but more importantly + # can explain why the title should not contain the extension. # DRB: removing the explicit "." isn't sufficient because the "." in the # extension also matches any char unless it is escaped. Like Malte, I # see no reason to get rid of the extension in the title anyway ... - # regsub -all ".${extension}\$" $filename "" title - set title $filename - } - - set existing_filenames [db_list get_parent_existing_filenames {}] - set filename [util_text_to_url \ - -text ${title} -existing_urls "$existing_filenames" -replacement "_"] + # regsub -all ".${extension}\$" $filename "" title + set title $filename + } + set existing_filenames [db_list get_parent_existing_filenames {}] + set filename [util_text_to_url \ + -text ${title} -existing_urls "$existing_filenames" -replacement "_"] + set revision_id [cr_import_content \ - -storage_type "file" -title $title -package_id $package_id $parent_id $tmp_filename $tmp_size $mime_type $filename] + -storage_type "file" -title $title \ + -package_id $package_id \ + $parent_id $tmp_filename $tmp_size $mime_type $filename] - content::item::set_live_revision -revision_id $revision_id + content::item::set_live_revision -revision_id $revision_id - return $revision_id - } + return $revision_id + } } ad_proc -public content::item::get_id_by_name { @@ -869,24 +871,24 @@ # # -ad_proc -public ::content::item::get_publish_status { +ad_proc -public ::content::item::get_publish_status { -item_id:required } { Get the publish status of the item. The publish status will be one of - the following: + the following: - + @param item_id The item_id of the content item - + @return The publish status of the item, or the empty string on failure - + @see proc content::item::is_publishable } { @@ -895,4 +897,248 @@ "select publish_status from cr_items where item_id = :item_id"] return $publish_status -} \ No newline at end of file +} + + +# +# +# + +ad_proc -public ::content::item::content_is_null { revision_id } { + + Determines if the content for the revision is null (not mereley + zero-length) + @param revision_id The revision id + + @return 1 if the content is null, 0 otherwise + +} { + set content_test [db_string cin_get_content ""] + + return [expr {$content_test eq ""}] +} + +# +# +# + +ad_proc -public ::content::item::content_methods_by_type { + -get_labels:boolean + content_type +} { + + Determines all the valid content methods for instantiating + a content type. + Possible choices are text_entry, file_upload, no_content and + xml_import. Currently, this proc merely removes the text_entry + method if the item does not have a text mime type registered to + it. In the future, a more sophisticated mechanism will be + implemented. + + @param content_type The content type + + @param get_labels Return not just a list of types, + but a list of name-value pairs, as in the -options + ATS switch for form widgets + + @return A Tcl list of all possible content methods + +} { + + set types [db_list cmbt_get_content_mime_types { + select mime_type from cr_content_mime_type_map + where content_type = :content_type + and lower(mime_type) like 'text/%' + }] + + set need_text [expr {[llength $types] > 0}] + + if { [info exists $get_label)] } { + set methods [list \ + [list "No Content" no_content] \ + [list "File Upload" file_upload]] + + if { $need_text } { + lappend methods [list "Text Entry" text_entry] + } + + lappend methods [list "XML Import" xml_import] + } else { + set methods [list no_content file_upload] + if { $need_text } { + lappend methods text_entry + } + lappend methods xml_import + } + + return $methods +} + +# +# +# + +ad_proc -public content::item::get_content { + {-revision_id ""} + {-item_id ""} + {-array:required} +} { + + Create a onerow datasource called content in the calling frame + which contains all attributes for the revision (including inherited + ones).

    + The datasource will contain a column called "text", representing the + main content (blob) of the revision, but only if the revision has a + textual mime-type. + + @param revision_id The revision whose attributes are to be retrieved + + @param item_id The item_id of the + corresponding item. You can provide this as an optimization. + If you don't provide revision_id, you must provide item_id, + and the item must have a live revision. + + @return 1 on success (and set the array in the calling frame), + 0 on failure + + @see proc content::item::get_content_type + +} { + upvar 1 $array content + + if { $item_id eq "" } { + set item_id [::content::revision::item_id -revision_id $revision_id] + if { $item_id eq "" } { + ns_log notice "item::get_content: no such revision: $revision_id" + return 0 + } + } elseif { $revision_id eq "" } { + set revision_id [::content::item::get_live_revision -item_id $item_id] + } + if { $revision_id eq "" } { + error "You must supply revision_id, or the item must have a live revision." + } + + return [content::item::get_revision_content -revision_id $revision_id -item_id $item_id] +} + +# +# +# +ad_proc -public content::item::get_revision_content { -revision_id:required -item_id } { + + Create a onerow datasource called content in the calling frame + which contains all attributes for the revision (including inherited + ones). + + The datasource will contain a column called "text", representing the + main content (blob) of the revision, but only if the revision has a + textual mime-type. + + @param revision_id The revision whose attributes are to be retrieved + @param item_id The item_id of the corresponding item. + + @return 1 on success (and create a content array in the calling frame), + 0 on failure + + @see content::item::get_content_type + +} { + + if { ![info exists item_id] } { + # Get the item id + set item_id [::content::revision::item_id -revision_id $revision_id] + + if { $item_id eq "" } { + ns_log warning "item::get_revision_content: No such revision: $revision_id" + return 0 + } + } + + # Get the mime type, decide if we want the text + content::item::get -item_id $item_id -array_name item_info + + if { [info exists item_info(mime_type)] + && $item_info(mime_type) ne "" + && [string match "text/*" $item_info(mime_type)] + } { + set text_sql [db_map grc_get_all_content_1] + } else { + set text_sql "" + } + + # Get the content type + set content_type $item_info(content_type) + + # Get the table name + set table_name [db_string grc_get_table_names { + select table_name from acs_object_types + where object_type = :content_type + }] + + upvar content content + + # Get (all) the content (note this is really dependent on file type) + db_0or1row grc_get_all_content [subst { + select x.*, + :item_id as item_id $text_sql, + :content_type as content_type + from cr_revisions r, ${table_name}x x + where r.revision_id = :revision_id + and x.revision_id = r.revision_id + }] -column_array content + + if { ![array exists content] } { + ns_log warning "item::get_revision_content: No data found for item $item_id, revision $revision_id" + return 0 + } + + return 1 +} + +# +# +# +ad_proc -public content::item::publish { + {-item_id:required} + {-revision_id ""} +} { + Publish a content item. Updates the live_revision and publish_date attributes, and + sets publish_status to live. + + @param item_id The id of the content item + @param revision_id The id of the revision to publish. Defaults to the latest revision. + + @author Peter Marklund +} { + if { $revision_id eq "" } { + set revision_id [::content::item::get_latest_revision -item_id $item_id] + } + ::content::item::set_live_revision -revision_id $revision_id -publish_status "live" +} + +# +# +# +ad_proc -public content::item::unpublish { + {-item_id:required} + {-publish_status "production"} +} { + Unpublish a content item. + + @param item_id The id of the content item + @param publish_status The publish_status to put the item in after unpublishing it. + + @author Peter Marklund +} { + ::content::item::set_live_revision -item_id $item_id + ::content::item::update -item_id $item_id -attributes [list [list publish_status $publish_status]] +} + + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/acs-content-repository/tcl/content-keyword-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/content-keyword-procs.tcl,v diff -u -N -r1.4.16.2 -r1.4.16.3 --- openacs-4/packages/acs-content-repository/tcl/content-keyword-procs.tcl 13 Sep 2014 11:09:29 -0000 1.4.16.2 +++ openacs-4/packages/acs-content-repository/tcl/content-keyword-procs.tcl 13 Sep 2014 15:24:28 -0000 1.4.16.3 @@ -1,4 +1,3 @@ - ad_library { Procedures for content_keywords @@ -243,10 +242,10 @@ Returns the empty string if none exists. } { return [db_string select_keyword_id { - select keyword_id - from cr_keywords - where parent_id = :parent_id - and heading = :heading + select keyword_id + from cr_keywords + where parent_id = :parent_id + and heading = :heading } -default {}] } @@ -256,10 +255,10 @@ Returns a flat options list of the keywords with the given parent_id. } { return [db_list_of_lists select_keyword_options [subst { - select heading, keyword_id - from cr_keywords - where [ad_decode $parent_id "" "parent_id is null" "parent_id = :parent_id"] - order by lower(heading)}]] + select heading, keyword_id + from cr_keywords + where [ad_decode $parent_id "" "parent_id is null" "parent_id = :parent_id"] + order by lower(heading)}]] } ad_proc -public content::keyword::item_get_assigned { @@ -279,12 +278,12 @@ where km.item_id = :item_id and kw.parent_id = :parent_id and kw.keyword_id = km.keyword_id - }] + }] } else { set keyword_list [db_list get_keywords { select keyword_id from cr_item_keyword_map where item_id = :item_id - }] + }] } return $keyword_list @@ -301,11 +300,18 @@ Returns the supplied item_id for convenience. } { db_dml item_unassign_children { - delete from cr_item_keyword_map - where item_id = :item_id - and keyword_id in (select p.keyword_id - from cr_keywords p - where p.parent_id = :parent_id) + delete from cr_item_keyword_map + where item_id = :item_id + and keyword_id in (select p.keyword_id + from cr_keywords p + where p.parent_id = :parent_id) } return $item_id } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/acs-content-repository/tcl/item-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/Attic/item-procs.tcl,v diff -u -N -r1.28.4.3 -r1.28.4.4 --- openacs-4/packages/acs-content-repository/tcl/item-procs.tcl 10 Sep 2014 14:01:49 -0000 1.28.4.3 +++ openacs-4/packages/acs-content-repository/tcl/item-procs.tcl 13 Sep 2014 15:24:28 -0000 1.28.4.4 @@ -12,7 +12,7 @@ namespace eval item {} -ad_proc -public item::get_content { +ad_proc -public -deprecated item::get_content { {-revision_id ""} {-array:required} {-item_id ""} @@ -37,8 +37,7 @@ @return 1 on success (and set the array in the calling frame), 0 on failure - @see proc item::get_mime_info - @see proc item::get_content_type + @see content::item::get_content } { upvar 1 $array content @@ -59,7 +58,7 @@ return [item::get_revision_content $revision_id $item_id] } -ad_proc -public item::content_is_null { revision_id } { +ad_proc -public -deprecated item::content_is_null { revision_id } { @public content_is_null @@ -69,13 +68,15 @@ @return 1 if the content is null, 0 otherwise + @see content::item::content_is_null + } { set content_test [db_string cin_get_content ""] return [template::util::is_nil content_test] } -ad_proc -public item::get_revision_content { revision_id args } { +ad_proc -public -deprecated item::get_revision_content { revision_id args } { @public get_revision_content @@ -94,8 +95,7 @@ @return 1 on success (and create a content array in the calling frame), 0 on failure - @see proc item::get_mime_info - @see proc item::get_content_type + @see content::item::get_revision_content } { @@ -145,7 +145,7 @@ } -ad_proc -public item::content_methods_by_type { content_type args } { +ad_proc -public -deprecated item::content_methods_by_type { content_type args } { @public content_methods_by_type @@ -164,6 +164,7 @@ ATS switch for form widgets @return A Tcl list of all possible content methods + @see content::item::content_methods_by_type } { @@ -329,7 +330,7 @@ return $row($element) } -ad_proc -public item::publish { +ad_proc -public -deprecated item::publish { {-item_id:required} {-revision_id ""} } { @@ -340,14 +341,12 @@ @param revision_id The id of the revision to publish. Defaults to the latest revision. @author Peter Marklund + @see content::item::publish } { - if { $revision_id eq "" } { - set revision_id [::content::item::get_latest_revision -item_id $item_id] - } - ::content::item::set_live_revision -revision_id $revision_id -publish_status "live" + ::content::item::unpublish -item_id $item_id -revision_id $revision_id } -ad_proc -public item::unpublish { +ad_proc -public -deprecated item::unpublish { {-item_id:required} {-publish_status "production"} } { @@ -357,9 +356,9 @@ @param publish_status The publish_status to put the item in after unpublishing it. @author Peter Marklund + @see content::item::unpublish } { - ::content::item::set_live_revision -item_id $item_id - ::content::item::update -item_id $item_id -attributes [list [list publish_status $publish_status]] + ::content::item::unpublish -item_id $item_id -publish_status $publish_status } ####################################################### Index: openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl,v diff -u -N -r1.10.2.7 -r1.10.2.8 --- openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 10 Sep 2014 14:02:18 -0000 1.10.2.7 +++ openacs-4/packages/acs-content-repository/tcl/publish-procs.tcl 13 Sep 2014 15:24:28 -0000 1.10.2.8 @@ -1093,7 +1093,7 @@ # Determine if the blob is null. If it is, give up (or else the # ns_ora blob_get_file will crash). - if { [item::content_is_null $revision_id] } { + if { [content::item::content_is_null $revision_id] } { ns_log warning "publish::write_content: No content supplied for revision $revision_id" return "" } Index: openacs-4/packages/acs-content-repository/tcl/test/content-image-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/test/content-image-test-procs.tcl,v diff -u -N -r1.4.10.1 -r1.4.10.2 --- openacs-4/packages/acs-content-repository/tcl/test/content-image-test-procs.tcl 17 Oct 2013 08:56:37 -0000 1.4.10.1 +++ openacs-4/packages/acs-content-repository/tcl/test/content-image-test-procs.tcl 13 Sep 2014 15:24:28 -0000 1.4.10.2 @@ -11,92 +11,96 @@ content image test } { - aa_run_with_teardown \ - -rollback \ - -test_code { + aa_run_with_teardown -rollback -test_code { - # create a cr_folder - set first_folder_id [db_nextval "acs_object_id_seq"] - set returned_first_folder_id [content::folder::new \ - -folder_id $first_folder_id \ - -name "test_folder_${first_folder_id}"] - aa_true "Folder created" [expr {$first_folder_id == $returned_first_folder_id}] + # create a cr_folder + set first_folder_id [db_nextval "acs_object_id_seq"] + set returned_first_folder_id [content::folder::new \ + -folder_id $first_folder_id \ + -name "test_folder_${first_folder_id}"] + aa_true "Folder created" \ + [expr {$first_folder_id == $returned_first_folder_id}] - content::folder::register_content_type \ - -folder_id $first_folder_id \ - -content_type "image" \ + content::folder::register_content_type \ + -folder_id $first_folder_id \ + -content_type "image" \ - # create a cr_item - set first_item_id [db_nextval "acs_object_id_seq"] - set returned_first_item_id [content::item::new \ - -name "test_item_one" \ - -item_id $first_item_id \ - -parent_id $first_folder_id \ - -content_type "image" \ - -storage_type "file"] + # create a cr_item + set first_item_id [db_nextval "acs_object_id_seq"] + set returned_first_item_id [content::item::new \ + -name "test_item_one" \ + -item_id $first_item_id \ + -parent_id $first_folder_id \ + -content_type "image" \ + -storage_type "file"] - aa_true "First item created $first_item_id" [expr {$first_item_id == $returned_first_item_id}] + aa_true "First item created $first_item_id" \ + [expr {$first_item_id == $returned_first_item_id}] - # create an image - set image_id [db_nextval "acs_object_id_seq"] + # create an image + set image_id [db_nextval "acs_object_id_seq"] - set returned_image_id [content::revision::new \ - -revision_id $image_id \ - -item_id $first_item_id \ - -title "Test Title" \ - -description "Test Description"] - aa_true "Basic Image created revision_id $image_id returned_revision_id $returned_image_id " [expr {$image_id == $returned_image_id}] + set returned_image_id [content::revision::new \ + -revision_id $image_id \ + -item_id $first_item_id \ + -title "Test Title" \ + -description "Test Description"] + aa_true "Basic Image created revision_id $image_id returned_revision_id $returned_image_id " \ + [expr {$image_id == $returned_image_id}] - ::item::get_content -revision_id $returned_image_id -array revision_content - aa_true "Revision contains correct content" [expr \ - [string equal $revision_content(title) "Test Title"] \ - && $image_id == $revision_content(revision_id)] - - content::item::delete -item_id $first_item_id + ::content::item::get_content -revision_id $returned_image_id -array revision_content + aa_true "Revision contains correct content" \ + [expr {$revision_content(title) eq "Test Title" + && $image_id == $revision_content(revision_id)}] - content::folder::unregister_content_type \ - -folder_id $first_folder_id \ - -content_type "image" \ + content::item::delete -item_id $first_item_id - content::folder::delete -folder_id $first_folder_id - } + content::folder::unregister_content_type \ + -folder_id $first_folder_id \ + -content_type "image" \ + + content::folder::delete -folder_id $first_folder_id + } } aa_register_case -cats {api smoke db} image_new { } { - aa_run_with_teardown \ - -rollback \ - -test_code \ - { - # create a cr_folder - set first_folder_id [db_nextval "acs_object_id_seq"] - set returned_first_folder_id [content::folder::new \ - -folder_id $first_folder_id \ - -name "test_folder_${first_folder_id}"] - aa_true "Folder created" [expr {$first_folder_id == $returned_first_folder_id}] + aa_run_with_teardown -rollback -test_code { + # create a cr_folder + set first_folder_id [db_nextval "acs_object_id_seq"] + set returned_first_folder_id [content::folder::new \ + -folder_id $first_folder_id \ + -name "test_folder_${first_folder_id}"] + aa_true "Folder created" \ + [expr {$first_folder_id == $returned_first_folder_id}] - content::folder::register_content_type \ - -folder_id $first_folder_id \ - -content_type "image" \ + content::folder::register_content_type \ + -folder_id $first_folder_id \ + -content_type "image" - set tmp_filename "$::acs::rootdir/packages/acs-content-repository/tcl/test/test-image-1.jpg" - set image_item_id_orig [db_nextval "acs_object_id_seq"] - set image_name [ns_mktemp "XXXXXX"] - set image_item_id [image::new \ - -item_id $image_item_id_orig \ - -parent_id $first_folder_id \ - -name $image_name \ - -tmp_filename $tmp_filename] - - aa_true "Image Created" [expr {$image_item_id_orig eq $image_item_id}] - aa_true "Image CR Item Exists" \ - [expr \ - {$image_item_id eq \ - [content::item::get_id \ - -item_path $image_name \ - -root_folder_id $first_folder_id]}] - - } + set tmp_filename "$::acs::rootdir/packages/acs-content-repository/tcl/test/test-image-1.jpg" + set image_item_id_orig [db_nextval "acs_object_id_seq"] + set image_name [ns_mktemp "XXXXXX"] + set image_item_id [image::new \ + -item_id $image_item_id_orig \ + -parent_id $first_folder_id \ + -name $image_name \ + -tmp_filename $tmp_filename] + + aa_true "Image Created" [expr {$image_item_id_orig eq $image_item_id}] + aa_true "Image CR Item Exists" \ + [expr {$image_item_id eq [content::item::get_id \ + -item_path $image_name \ + -root_folder_id $first_folder_id]}] + + } } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: Index: openacs-4/packages/acs-content-repository/tcl/test/content-revision-test-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/test/content-revision-test-procs.tcl,v diff -u -N -r1.5 -r1.5.10.1 --- openacs-4/packages/acs-content-repository/tcl/test/content-revision-test-procs.tcl 10 Jan 2007 21:22:03 -0000 1.5 +++ openacs-4/packages/acs-content-repository/tcl/test/content-revision-test-procs.tcl 13 Sep 2014 15:24:28 -0000 1.5.10.1 @@ -1,5 +1,5 @@ ad_library { - Procedures to test content::revision tcl API + Procedures to test content::revision Tcl API @author Dave Bauer (dave@thedesignexperience.org) @creation-date 2004-06-05 @@ -12,55 +12,63 @@ content revision test } { - aa_run_with_teardown \ - -rollback \ - -test_code { + aa_run_with_teardown -rollback -test_code { - # create a cr_folder - set first_folder_id [db_nextval "acs_object_id_seq"] - set returned_first_folder_id [content::folder::new \ - -folder_id $first_folder_id \ - -name "test_folder_${first_folder_id}"] - aa_true "Folder created" [expr {$first_folder_id == $returned_first_folder_id}] + # create a cr_folder + set first_folder_id [db_nextval "acs_object_id_seq"] + set returned_first_folder_id [content::folder::new \ + -folder_id $first_folder_id \ + -name "test_folder_${first_folder_id}"] + aa_true "Folder created" \ + [expr {$first_folder_id == $returned_first_folder_id}] - content::folder::register_content_type \ - -folder_id $first_folder_id \ - -content_type "content_revision" \ + content::folder::register_content_type \ + -folder_id $first_folder_id \ + -content_type "content_revision" \ - # create a cr_item - set first_item_id [db_nextval "acs_object_id_seq"] - set returned_first_item_id [content::item::new \ - -name "test_item_one" \ - -item_id $first_item_id \ - -parent_id $first_folder_id \ - -storage_type "text"] + # create a cr_item + set first_item_id [db_nextval "acs_object_id_seq"] + set returned_first_item_id [content::item::new \ + -name "test_item_one" \ + -item_id $first_item_id \ + -parent_id $first_folder_id \ + -storage_type "text"] - aa_true "First item created $first_item_id" [expr {$first_item_id == $returned_first_item_id}] + aa_true "First item created $first_item_id" \ + [expr {$first_item_id == $returned_first_item_id}] - # create a revision - set revision_id [db_nextval "acs_object_id_seq"] + # create a revision + set revision_id [db_nextval "acs_object_id_seq"] - set returned_revision_id [content::revision::new \ - -revision_id $revision_id \ - -item_id $first_item_id \ - -title "Test Title" \ - -description "Test Description" \ - -content "Test Content"] - aa_true "Basic Revision created revision_id $revision_id returned_revision_id $returned_revision_id " [expr {$revision_id == $returned_revision_id}] + set returned_revision_id [content::revision::new \ + -revision_id $revision_id \ + -item_id $first_item_id \ + -title "Test Title" \ + -description "Test Description" \ + -content "Test Content"] + aa_true "Basic Revision created revision_id $revision_id returned_revision_id $returned_revision_id " \ + [expr {$revision_id == $returned_revision_id}] - ::item::get_content -revision_id $returned_revision_id -array revision_content - set revision_content(content) [cr_write_content -revision_id $returned_revision_id -string] - aa_true "Revision contains correct content" [expr { - $revision_content(title) eq "Test Title" - && $revision_content(content) eq "Test Content" - && $revision_id == $revision_content(revision_id)}] - - content::item::delete -item_id $first_item_id + content::item::get_content -revision_id $returned_revision_id -array revision_content + set revision_content(content) [cr_write_content -revision_id $returned_revision_id -string] + aa_true "Revision contains correct content" \ + [expr { $revision_content(title) eq "Test Title" + && $revision_content(content) eq "Test Content" + && $revision_id == $revision_content(revision_id)}] - content::folder::unregister_content_type \ - -folder_id $first_folder_id \ - -content_type "content_revision" \ + content::item::delete -item_id $first_item_id - content::folder::delete -folder_id $first_folder_id - } + content::folder::unregister_content_type \ + -folder_id $first_folder_id \ + -content_type "content_revision" \ + + content::folder::delete -folder_id $first_folder_id + } } + +# +# Local variables: +# mode: tcl +# tcl-indent-level: 4 +# indent-tabs-mode: nil +# End: