Index: openacs-4/packages/file-storage/tcl/file-storage-callback-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/file-storage-callback-procs.tcl,v diff -u -N -r1.16 -r1.17 --- openacs-4/packages/file-storage/tcl/file-storage-callback-procs.tcl 17 Sep 2018 14:15:59 -0000 1.16 +++ openacs-4/packages/file-storage/tcl/file-storage-callback-procs.tcl 17 Sep 2018 14:23:17 -0000 1.17 @@ -1,7 +1,7 @@ ad_library { - + Callback procs for file storage - + @author Malte Sussdorff (sussdorff@sussdorff.de) @creation-date 2005-06-15 @cvs-id $Id$ @@ -85,7 +85,7 @@ @param parent_id Usually the folder the file was uploaded to. @param creation_user User_id of the user creating the revision @param creation_ip IP of the creation -} - +} - # Our callback implementations @@ -103,7 +103,7 @@ } { # We probably don't need the whole big query here. TODO: Review. db_0or1row dbqd.file-storage.tcl.file-storage-callback-procs.fs_datasource {} -column_array datasource - + return [list object_id $object_id \ title $datasource(title) \ content $datasource(content) \ @@ -136,7 +136,7 @@ set new_folder_id [fs_folder_copy -old_folder_id $object_id -new_parent_id $parent_id -mode $mode] return $new_folder_id - + } ad_proc -public -callback pm::project_new -impl file_storage { @@ -148,48 +148,48 @@ set pm_name [pm::project::name -project_item_id $project_id] foreach fs_package_id [application_link::get_linked -from_package_id $package_id -to_package_key "file-storage"] { - set root_folder_id [fs::get_root_folder -package_id $fs_package_id] + set root_folder_id [fs::get_root_folder -package_id $fs_package_id] - set folder_id [fs::new_folder \ - -name $root_folder_id \ - -pretty_name $pm_name \ - -parent_id $root_folder_id \ - -no_callback] + set folder_id [fs::new_folder \ + -name $root_folder_id \ + -pretty_name $pm_name \ + -parent_id $root_folder_id \ + -no_callback] - application_data_link::new -this_object_id $project_id -target_object_id $folder_id + application_data_link::new -this_object_id $project_id -target_object_id $folder_id } } #Callbacks for application-track -ad_proc -callback application-track::getApplicationName -impl file_storage {} { - Callback implementation +ad_proc -callback application-track::getApplicationName -impl file_storage {} { + Callback implementation } { - return "file_storage" -} + return "file_storage" +} -ad_proc -callback application-track::getGeneralInfo -impl file_storage {} { - Callback implementation +ad_proc -callback application-track::getGeneralInfo -impl file_storage {} { + Callback implementation } { - + db_1row my_query { select count(1) as result from acs_objects a, acs_objects b where b.object_id = :comm_id and a.tree_sortkey between b.tree_sortkey - and tree_right(b.tree_sortkey) + and tree_right(b.tree_sortkey) and a.object_type = 'file_storage_object' } - - + + return "$result" -} +} -ad_proc -callback application-track::getSpecificInfo -impl file_storage {} { - Callback implementation +ad_proc -callback application-track::getSpecificInfo -impl file_storage {} { + Callback implementation } { - upvar $query_name my_query + upvar $query_name my_query upvar $elements_name my_elements set my_query { @@ -214,41 +214,41 @@ set my_elements { name { label "Name" - display_col name - html {align center} + display_col name + html {align center} } type { label "Type" - display_col type - html {align center} + display_col type + html {align center} } folder { label "Folder" - display_col folder_name - html {align center} + display_col folder_name + html {align center} } size { label "Size (bytes)" display_col size - html {align center} + html {align center} } last_modification_date { label "Last_Modification_Date" - display_col last_modified - html {align center} + display_col last_modified + html {align center} } post_date { label "Post_Date" display_col creation_date - html {align center} + html {align center} - } + } } -} +} # Local variables: # mode: tcl Index: openacs-4/packages/file-storage/tcl/test/file-storage-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/test/file-storage-procs.tcl,v diff -u -N -r1.9 -r1.10 --- openacs-4/packages/file-storage/tcl/test/file-storage-procs.tcl 15 Aug 2018 16:35:22 -0000 1.9 +++ openacs-4/packages/file-storage/tcl/test/file-storage-procs.tcl 17 Sep 2018 14:23:17 -0000 1.10 @@ -1,6 +1,6 @@ ad_library { Automated tests. - + @author Simon Carstensen @creation-date 14 November 2003 @cvs-id $Id$ @@ -10,57 +10,57 @@ -cats {api db smoke} \ -procs {fs::new_root_folder} \ fs_new_root_folder { - Test the fs::new_root_folder proc. - } { + Test the fs::new_root_folder proc. +} { - aa_run_with_teardown \ + aa_run_with_teardown \ -rollback \ -test_code { set package_id [subsite::main_site_id] - + # Create folder set folder_id [fs::new_root_folder \ - -package_id $package_id \ - -pretty_name "Foobar" \ - -description "Foobar"] - + -package_id $package_id \ + -pretty_name "Foobar" \ + -description "Foobar"] + set success_p [db_string success_p { select 1 from fs_root_folders where folder_id = :folder_id } -default "0"] - + aa_equals "folder was created successfully" $success_p 1 - } } +} aa_register_case \ -cats {web smoke} \ -libraries tclwebtest \ -procs {file_storage::twt::create_new_folder file_storage::twt::call_fs_page} \ fs_create_folder { - + Test Load File. - + @author Mounir Lallali } { aa_run_with_teardown -test_code { - - tclwebtest::cookies clear - - # Login user - array set user_info [twt::user::create -admin] - twt::user::login $user_info(email) $user_info(password) - - file_storage::twt::call_fs_page - - # Create a new folder - set folder_name [ad_generate_random_string] - set folder_description [ad_generate_random_string] - set response [file_storage::twt::create_new_folder $folder_name $folder_description] - - aa_display_result -response $response -explanation {for creating a new folder} - - twt::user::logout + + tclwebtest::cookies clear + + # Login user + array set user_info [twt::user::create -admin] + twt::user::login $user_info(email) $user_info(password) + + file_storage::twt::call_fs_page + + # Create a new folder + set folder_name [ad_generate_random_string] + set folder_description [ad_generate_random_string] + set response [file_storage::twt::create_new_folder $folder_name $folder_description] + + aa_display_result -response $response -explanation {for creating a new folder} + + twt::user::logout } } @@ -73,32 +73,32 @@ file_storage::twt::delete_folder } \ fs_delete_folder { - + Test Delete a Folder. - + @author Mounir Lallali } { aa_run_with_teardown -test_code { - + tclwebtest::cookies clear - + # Login user array set user_info [twt::user::create -admin] twt::user::login $user_info(email) $user_info(password) - - file_storage::twt::call_fs_page - - # Create a new folder + file_storage::twt::call_fs_page + + + # Create a new folder set folder_name [ad_generate_random_string] set folder_description [ad_generate_random_string] file_storage::twt::create_new_folder $folder_name $folder_description - - # Delete a folder + + # Delete a folder set response [file_storage::twt::delete_folder] - - aa_display_result -response $response -explanation {for deleting a folder} - + + aa_display_result -response $response -explanation {for deleting a folder} + twt::user::logout } } @@ -112,32 +112,32 @@ file_storage::twt::edit_folder } \ fs_edit_folder { - + Test Edit a Folder. - + @author Mounir Lallali } { aa_run_with_teardown -test_code { - + tclwebtest::cookies clear - + # Login user array set user_info [twt::user::create -admin] twt::user::login $user_info(email) $user_info(password) - file_storage::twt::call_fs_page - - # Create a new folder + file_storage::twt::call_fs_page + + # Create a new folder set folder_name [ad_generate_random_string] set folder_description [ad_generate_random_string] file_storage::twt::create_new_folder $folder_name $folder_description - # Edit a folder - set new_folder_name [ad_generate_random_string] + # Edit a folder + set new_folder_name [ad_generate_random_string] set response [file_storage::twt::edit_folder $new_folder_name] - - aa_display_result -response $response -explanation {for editing a folder} - + + aa_display_result -response $response -explanation {for editing a folder} + twt::user::logout } } @@ -154,31 +154,31 @@ fs_add_file_to_folder { Test Upload a File in a Folder. - + @author Mounir Lallali } { aa_run_with_teardown -test_code { - + tclwebtest::cookies clear # Login user array set user_info [twt::user::create -admin] twt::user::login $user_info(email) $user_info(password) - - file_storage::twt::call_fs_page - - # Create a new folder + + file_storage::twt::call_fs_page + + # Create a new folder set folder_name [ad_generate_random_string] set folder_description [ad_generate_random_string] file_storage::twt::create_new_folder $folder_name $folder_description - - # Add a file to folder + + # Add a file to folder set uploaded_file_name [file_storage::twt::create_file [ad_generate_random_string]] set uploaded_file_description [ad_generate_random_string] set response [file_storage::twt::add_file_to_folder $folder_name $uploaded_file_name $uploaded_file_description] - + aa_display_result -response $response -explanation {for uploadding a file in a folder} - + file_storage::twt::delete_file $uploaded_file_name twt::user::logout } @@ -191,29 +191,29 @@ file_storage::twt::call_fs_page file_storage::twt::create_url_in_folder } fs_create_url_in_folder { - + Test Create a URL in a Folder. - + @author Mounir Lallali } { aa_run_with_teardown -test_code { - + tclwebtest::cookies clear - + # Login user array set user_info [twt::user::create -admin] twt::user::login $user_info(email) $user_info(password) - file_storage::twt::call_fs_page - - # Create a URL in a folder + file_storage::twt::call_fs_page + + # Create a URL in a folder set url_title [ad_generate_random_string] set url "e-lane.org" set url_description [ad_generate_random_string] - set response [file_storage::twt::create_url_in_folder $url_title $url $url_description] - - aa_display_result -response $response -explanation {for creating a URL in a folder} + set response [file_storage::twt::create_url_in_folder $url_title $url $url_description] + aa_display_result -response $response -explanation {for creating a URL in a folder} + twt::user::logout } } @@ -226,34 +226,33 @@ file_storage::twt::create_url } \ fs_create_url { - + Test Create a URL. - + @author Mounir Lallali } { aa_run_with_teardown -test_code { - + tclwebtest::cookies clear - + # Login user array set user_info [twt::user::create -admin] twt::user::login $user_info(email) $user_info(password) - file_storage::twt::call_fs_page - - # Create a URL + file_storage::twt::call_fs_page + + # Create a URL set url_title [ad_generate_random_string] set url "e-lane.org" set url_description [ad_generate_random_string] - set response [file_storage::twt::create_url $url_title $url $url_description] - - aa_display_result -response $response -explanation {for creating a URL} - + set response [file_storage::twt::create_url $url_title $url $url_description] + + aa_display_result -response $response -explanation {for creating a URL} + twt::user::logout } } - aa_register_case \ -cats {web smoke} \ -libraries tclwebtest \ @@ -270,29 +269,27 @@ @author Mounir Lallali } { aa_run_with_teardown -test_code { - + tclwebtest::cookies clear - + # Login user array set user_info [twt::user::create -admin] twt::user::login $user_info(email) $user_info(password) - file_storage::twt::call_fs_page - - # Upload a File - set uploaded_file_name [file_storage::twt::create_file [ad_generate_random_string]] - set uploaded_file_description [ad_generate_random_string] + file_storage::twt::call_fs_page + + # Upload a File + set uploaded_file_name [file_storage::twt::create_file [ad_generate_random_string]] + set uploaded_file_description [ad_generate_random_string] set response [file_storage::twt::upload_file $uploaded_file_name $uploaded_file_description] - - aa_display_result -response $response -explanation {for uploadding a file} - - file_storage::twt::delete_file $uploaded_file_name + + aa_display_result -response $response -explanation {for uploadding a file} + + file_storage::twt::delete_file $uploaded_file_name twt::user::logout } } - - # Local variables: # mode: tcl # tcl-indent-level: 4 Index: openacs-4/packages/file-storage/www/file-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/www/file-add.tcl,v diff -u -N -r1.22 -r1.23 --- openacs-4/packages/file-storage/www/file-add.tcl 7 Apr 2018 19:13:11 -0000 1.22 +++ openacs-4/packages/file-storage/www/file-add.tcl 17 Sep 2018 14:23:17 -0000 1.23 @@ -23,23 +23,23 @@ instructions:onevalue } -validate { file_id_or_folder_id { - if {[info exists file_id] && ![info exists folder_id]} { - set folder_id [content::item::get_parent_folder -item_id $file_id] - if {$folder_id eq ""} { - ad_complain "The specified file_id is not valid." - return - } - } + if {[info exists file_id] && ![info exists folder_id]} { + set folder_id [content::item::get_parent_folder -item_id $file_id] + if {$folder_id eq ""} { + ad_complain "The specified file_id is not valid." + return + } + } if {![info exists folder_id] || ![fs_folder_p $folder_id]} { - ad_complain "The specified parent folder is not valid." - } + ad_complain "The specified parent folder is not valid." + } } max_size -requires {upload_file} { - set n_bytes [file size ${upload_file.tmpfile}] - set max_bytes [parameter::get -parameter "MaximumFileSize"] - if { $n_bytes > $max_bytes } { - ad_complain "Your file is larger than the maximum file size allowed on this system ([util_commify_number $max_bytes] bytes)" - } + set n_bytes [file size ${upload_file.tmpfile}] + set max_bytes [parameter::get -parameter "MaximumFileSize"] + if { $n_bytes > $max_bytes } { + ad_complain "Your file is larger than the maximum file size allowed on this system ([util_commify_number $max_bytes] bytes)" + } } } @@ -55,11 +55,11 @@ if {![ad_form_new_p -key file_id]} { permission::require_permission \ - -object_id $file_id \ - -party_id $user_id \ - -privilege "write" + -object_id $file_id \ + -party_id $user_id \ + -privilege "write" set context [fs_context_bar_list -final "[_ file-storage.Add_Revision]" $folder_id] - + } else { set context [fs_context_bar_list -final "[_ file-storage.Add_File]" $folder_id] } @@ -72,13 +72,13 @@ } if {[parameter::get -parameter AllowTextEdit -default 0]} { - if {[ad_form_new_p -key file_id]} { - + if {[ad_form_new_p -key file_id]} { + # To allow the creation of files ad_form -extend -form { - {content_body:richtext(richtext),optional - {label "Create a file"} - {html "rows 20 cols 70" } + {content_body:richtext(richtext),optional + {label "Create a file"} + {html "rows 20 cols 70" } {htmlarea_p 1} } } @@ -90,12 +90,12 @@ }] if {$mime_type eq "text/html"} { ad_form -extend -form { - {edit_content:richtext(richtext),optional - {label "Content"} - {html "rows 20 cols 70" } + {edit_content:richtext(richtext),optional + {label "Content"} + {html "rows 20 cols 70" } {htmlarea_p 1} } - {mime_type:text(hidden) + {mime_type:text(hidden) {value $mime_type} } } @@ -105,17 +105,17 @@ if {[info exists return_url] && $return_url ne ""} { ad_form -extend -form { - {return_url:text(hidden) {value $return_url}} + {return_url:text(hidden) {value $return_url}} } } if {$lock_title_p} { ad_form -extend -form { - {title:text(hidden) {value $title}} + {title:text(hidden) {value $title}} } -} else { +} else { ad_form -extend -form { - {title:text,optional {label \#file-storage.Title\#} {html {size 30}} } + {title:text,optional {label \#file-storage.Title\#} {html {size 30}} } } } ad_form -extend -form { @@ -131,7 +131,7 @@ if {[ad_form_new_p -key file_id] && $unpack_bin_installed } { ad_form -extend -form { - {unpack_p:boolean(checkbox),optional \ + {unpack_p:boolean(checkbox),optional \ {label \#file-storage.Multiple_files\#} \ {options { {\#file-storage.lt_This_is_a_ZIP\# t} }} } @@ -144,43 +144,43 @@ # pre-populate with categories from the folder set categorized_object_id $folder_id } - + category::ad_form::add_widgets \ -container_object_id $package_id \ -categorized_object_id $categorized_object_id \ -form_name file-add } ad_form -extend -form {} -select_query_name get_file -new_data { - + if {![info exists unpack_p] || $unpack_p eq ""} { set unpack_p f } if { $unpack_p && $unpack_binary ne "" && [file extension [template::util::file::get_property filename $upload_file]] eq ".zip" - } { - + } { + set path [ad_tmpnam] file mkdir $path - - + + catch { exec $unpack_binary -jd $path ${upload_file.tmpfile} } errmsg - + # More flexible parameter design could be: - # zip {unzip -jd {out_path} {in_file}} tar {tar xf {in_file} {out_path}} tgz {tar xzf {in_file} {out_path}} + # zip {unzip -jd {out_path} {in_file}} tar {tar xf {in_file} {out_path}} tgz {tar xzf {in_file} {out_path}} set upload_files [list] set upload_tmpfiles [list] - + foreach file [glob -nocomplain "$path/*"] { lappend upload_files [file tail $file] - lappend upload_tmpfiles $file - } - + lappend upload_tmpfiles $file + } + } else { - set upload_files [list [template::util::file::get_property filename $upload_file]] - set upload_tmpfiles [list [template::util::file::get_property tmp_filename $upload_file]] + set upload_files [list [template::util::file::get_property filename $upload_file]] + set upload_tmpfiles [list [template::util::file::get_property tmp_filename $upload_file]] } set mime_type "" if { [lindex $upload_files 0] eq ""} { @@ -192,36 +192,36 @@ set content_body [template::util::richtext::get_property html_value $content_body] set mime_type text/html set tmp_filename [ad_tmpnam] - set fd [open $tmp_filename w] + set fd [open $tmp_filename w] puts $fd $content_body close $fd set upload_files [list $title] set upload_tmpfiles [list $tmp_filename] } - # ns_log notice "file_add mime_type='${mime_type}'" + # ns_log notice "file_add mime_type='${mime_type}'" set i 0 set number_upload_files [llength $upload_files] foreach upload_file $upload_files tmpfile $upload_tmpfiles { - set this_file_id $file_id - set this_title $title - set mime_type [cr_filename_to_mime_type -create -- $upload_file] - # upload a new file - # if the user choose upload from the folder view - # and the file with the same name already exists - # we create a new revision - - if {$this_title eq ""} { - set this_title $upload_file - } - - if {$name ne ""} { - set upload_file $name - } + set this_file_id $file_id + set this_title $title + set mime_type [cr_filename_to_mime_type -create -- $upload_file] + # upload a new file + # if the user choose upload from the folder view + # and the file with the same name already exists + # we create a new revision - set existing_item_id [fs::get_item_id -name $upload_file -folder_id $folder_id] - - if {$existing_item_id ne ""} { - # file with the same name already exists in this folder + if {$this_title eq ""} { + set this_title $upload_file + } + + if {$name ne ""} { + set upload_file $name + } + + set existing_item_id [fs::get_item_id -name $upload_file -folder_id $folder_id] + + if {$existing_item_id ne ""} { + # file with the same name already exists in this folder if { [parameter::get -parameter "BehaveLikeFilesystemP" -package_id [ad_conn package_id]] } { # create a new revision -- in effect, replace the existing file set this_file_id $existing_item_id @@ -237,24 +237,24 @@ append new_name $root "-$this_file_id" $extension set upload_file $new_name } - } + } - fs::add_file \ - -name $upload_file \ - -item_id $this_file_id \ - -parent_id $folder_id \ - -tmp_filename $tmpfile\ - -creation_user $user_id \ - -creation_ip [ad_conn peeraddr] \ - -title $this_title \ - -description $description \ - -package_id $package_id \ + fs::add_file \ + -name $upload_file \ + -item_id $this_file_id \ + -parent_id $folder_id \ + -tmp_filename $tmpfile\ + -creation_user $user_id \ + -creation_ip [ad_conn peeraddr] \ + -title $this_title \ + -description $description \ + -package_id $package_id \ -mime_type $mime_type - if { [parameter::get -parameter CategoriesP -package_id $package_id -default 0] } { - category::map_object -remove_old -object_id $this_file_id [category::ad_form::get_categories \ - -container_object_id $package_id \ - -element_name category_id] + if { [parameter::get -parameter CategoriesP -package_id $package_id -default 0] } { + category::map_object -remove_old -object_id $this_file_id [category::ad_form::get_categories \ + -container_object_id $package_id \ + -element_name category_id] } file delete -- $tmpfile @@ -268,30 +268,30 @@ set this_title $title set filename [template::util::file::get_property filename $upload_file] if {$this_title eq ""} { - set this_title $filename + set this_title $filename } - + fs::add_version \ - -name $filename \ - -tmp_filename [template::util::file::get_property tmp_filename $upload_file] \ + -name $filename \ + -tmp_filename [template::util::file::get_property tmp_filename $upload_file] \ -item_id $file_id \ - -creation_user $user_id \ - -creation_ip [ad_conn peeraddr] \ - -title $this_title \ - -description $description \ - -package_id $package_id - + -creation_user $user_id \ + -creation_ip [ad_conn peeraddr] \ + -title $this_title \ + -description $description \ + -package_id $package_id + if { [parameter::get -parameter CategoriesP -package_id $package_id -default 0] } { - category::map_object -remove_old -object_id $file_id [category::ad_form::get_categories \ - -container_object_id $package_id \ - -element_name category_id] + category::map_object -remove_old -object_id $file_id [category::ad_form::get_categories \ + -container_object_id $package_id \ + -element_name category_id] } } -after_submit { if {[info exists return_url] && $return_url ne ""} { - ad_returnredirect $return_url + ad_returnredirect $return_url } else { - ad_returnredirect [export_vars -base ./ {folder_id}] + ad_returnredirect [export_vars -base ./ {folder_id}] } ad_script_abort @@ -319,9 +319,9 @@ if (document.forms[form_name] == null) return; if (elm.checked == true) { - document.forms[form_name].elements["title"].disabled = true; + document.forms[form_name].elements["title"].disabled = true; //document.getElementById('fs_title_msg').innerHTML= 'The title you entered will not be used if you upload multiple files at once'; - + } else { document.forms[form_name].elements["title"].disabled = false; //document.getElementById('fs_title_msg').innerHTML= ''; @@ -333,7 +333,6 @@ } } - ad_return_template # Local variables: Index: openacs-4/packages/file-storage/www/folder-add.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/www/folder-add.tcl,v diff -u -N -r1.8 -r1.9 --- openacs-4/packages/file-storage/www/folder-add.tcl 17 Sep 2018 14:15:59 -0000 1.8 +++ openacs-4/packages/file-storage/www/folder-add.tcl 17 Sep 2018 14:23:17 -0000 1.9 @@ -17,9 +17,9 @@ lock_title_p:onevalue } -validate { folder { - if {![fs_folder_p $folder_id]} { - ad_complain "The specified parent folder is not valid." - } + if {![fs_folder_p $folder_id]} { + ad_complain "The specified parent folder is not valid." + } } } @@ -47,109 +47,108 @@ if {[info exists return_url] && $return_url ne ""} { ad_form -extend -name file_add -form { - {return_url:text(hidden) {value $return_url}} + {return_url:text(hidden) {value $return_url}} } } ad_form -extend -name file_add -form {} -on_submit { - + foreach file [ad_find_all_files "$upload_folder"] { - lappend upload_files [regsub "^$upload_folder\/" $file {}] - lappend upload_tmpfiles $file + lappend upload_files [regsub "^$upload_folder\/" $file {}] + lappend upload_tmpfiles $file } - + if { [lindex $upload_files 0] eq ""} { - ad_return_complaint 1 "You have to upload a file" - ad_script_abort + ad_return_complaint 1 "You have to upload a file" + ad_script_abort } - + set i 0 set number_upload_files [llength $upload_files] foreach upload_file $upload_files tmpfile $upload_tmpfiles { - # upload a new file - # if the user chose upload from the folder view - # and the file with the same name already exists - # we create a new revision - - # check if this is in a folder inside the zip and create - # the folders if they don't exist - set p_f_id $folder_id - set file_paths [file split [file dirname $upload_file]] + # upload a new file + # if the user chose upload from the folder view + # and the file with the same name already exists + # we create a new revision - if {"." ne $file_paths && [llength $file_paths]} { - # make sure every folder exists - set path "" - foreach p $file_paths { - append path /${p} - if {![info exists paths($path)]} { - set f_id [content::item::get_id -item_path $path -root_folder_id $p_f_id] - if {$f_id eq ""} { - set p_f_id [content::folder::new -parent_id $p_f_id -name $p -label $p] - set paths($path) $p_f_id - } - } else { - set p_f_id $paths($path) - } - - } - set upload_file [file tail $upload_file] - } - - set this_folder_id $p_f_id - set this_title $upload_file - - set existing_item_id [fs::get_item_id -name $upload_file -folder_id $this_folder_id] - - if {$existing_item_id ne ""} { - # file with the same name already exists - # in this folder, create a new revision - set this_file_id $existing_item_id - permission::require_permission \ - -object_id $this_file_id \ - -party_id $user_id \ - -privilege write - } - - set rev_id [fs::add_file \ - -name $upload_file \ - -parent_id $this_folder_id \ - -tmp_filename $tmpfile \ - -creation_user $user_id \ - -creation_ip [ad_conn peeraddr] \ - -title $this_title \ - -package_id $package_id] - - incr i + # check if this is in a folder inside the zip and create + # the folders if they don't exist + set p_f_id $folder_id + set file_paths [file split [file dirname $upload_file]] - if {$rev_id ne ""} { - set this_file_id [db_string get_item_id { - select item_id - from cr_revisions - where revision_id = :rev_id - } -default 0] - } - - if {$i < $number_upload_files} { - set file_id [db_nextval "acs_object_id_seq"] - } - + if {"." ne $file_paths && [llength $file_paths]} { + # make sure every folder exists + set path "" + foreach p $file_paths { + append path /${p} + if {![info exists paths($path)]} { + set f_id [content::item::get_id -item_path $path -root_folder_id $p_f_id] + if {$f_id eq ""} { + set p_f_id [content::folder::new -parent_id $p_f_id -name $p -label $p] + set paths($path) $p_f_id + } + } else { + set p_f_id $paths($path) + } + + } + set upload_file [file tail $upload_file] + } + + set this_folder_id $p_f_id + set this_title $upload_file + + set existing_item_id [fs::get_item_id -name $upload_file -folder_id $this_folder_id] + + if {$existing_item_id ne ""} { + # file with the same name already exists + # in this folder, create a new revision + set this_file_id $existing_item_id + permission::require_permission \ + -object_id $this_file_id \ + -party_id $user_id \ + -privilege write + } + + set rev_id [fs::add_file \ + -name $upload_file \ + -parent_id $this_folder_id \ + -tmp_filename $tmpfile \ + -creation_user $user_id \ + -creation_ip [ad_conn peeraddr] \ + -title $this_title \ + -package_id $package_id] + + incr i + + if {$rev_id ne ""} { + set this_file_id [db_string get_item_id { + select item_id + from cr_revisions + where revision_id = :rev_id + } -default 0] + } + + if {$i < $number_upload_files} { + set file_id [db_nextval "acs_object_id_seq"] + } } - + } -after_submit { - + if {[info exists return_url] && $return_url ne ""} { - ad_returnredirect $return_url + ad_returnredirect $return_url } else { - ad_returnredirect [export_vars -base ./ {folder_id}] + ad_returnredirect [export_vars -base ./ {folder_id}] } ad_script_abort - } set unpack_available_p [expr {[string trim [parameter::get -parameter UnzipBinary]] ne ""}] ad_return_template + # Local variables: # mode: tcl # tcl-indent-level: 4