Index: openacs-4/packages/file-storage/file-storage.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/file-storage.info,v diff -u -r1.24 -r1.25 --- openacs-4/packages/file-storage/file-storage.info 11 Dec 2003 21:40:03 -0000 1.24 +++ openacs-4/packages/file-storage/file-storage.info 15 Dec 2003 11:21:02 -0000 1.25 @@ -19,6 +19,9 @@ + + + Index: openacs-4/packages/file-storage/catalog/file-storage.en_US.ISO-8859-1.xml =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/catalog/file-storage.en_US.ISO-8859-1.xml,v diff -u -r1.16 -r1.17 --- openacs-4/packages/file-storage/catalog/file-storage.en_US.ISO-8859-1.xml 11 Dec 2003 21:40:04 -0000 1.16 +++ openacs-4/packages/file-storage/catalog/file-storage.en_US.ISO-8859-1.xml 15 Dec 2003 11:21:04 -0000 1.17 @@ -7,7 +7,7 @@ Add File Add %pretty_name% Author - <a href="%folder_view_url%">Back</a> to folder view + Back to folder view Change Name Copy Create @@ -105,7 +105,7 @@ Size Size (bytes) <strong>Note:</strong> This may take a while, please be patient. - Title: + Title Title : Type Update Index: openacs-4/packages/file-storage/sql/postgresql/file-storage-drop.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/sql/postgresql/file-storage-drop.sql,v diff -u -r1.9 -r1.10 --- openacs-4/packages/file-storage/sql/postgresql/file-storage-drop.sql 7 Jul 2003 12:37:39 -0000 1.9 +++ openacs-4/packages/file-storage/sql/postgresql/file-storage-drop.sql 15 Dec 2003 11:21:04 -0000 1.10 @@ -38,14 +38,27 @@ drop function inline_0(); \i file-storage-views-drop.sql; - -drop function fs_package_items_delete_trig(); drop trigger fs_package_items_delete_trig on fs_root_folders; +drop function fs_package_items_delete_trig(); -drop function fs_root_folder_delete_trig(); drop trigger fs_root_folder_delete_trig on fs_root_folders; +drop function fs_root_folder_delete_trig(); +select content_type__drop_type ( + 'file_storage_object', -- content_type + 'f', -- drop_children_p + 'f' -- drop_table_p +); + +-- this content type is created incorrectly tying the file_storage_root_folders +-- table to file_storage_object +-- so we drop these directly + +drop view file_storage_root_foldersi; +drop view file_storage_root_foldersx; + drop table fs_root_folders; + select drop_package('file_storage'); -- Unregister the content template @@ -57,8 +70,3 @@ -- Remove subtype of content_revision so that site-wide-search -- can distinguish file-storage items in the search results -select content_type__drop_type ( - 'file_storage_object', -- content_type - 'f', -- drop_children_p - 'f' -- drop_table_p -); Index: openacs-4/packages/file-storage/sql/postgresql/file-storage-package-create.sql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/sql/postgresql/file-storage-package-create.sql,v diff -u -r1.14 -r1.15 --- openacs-4/packages/file-storage/sql/postgresql/file-storage-package-create.sql 11 Dec 2003 21:40:04 -0000 1.14 +++ openacs-4/packages/file-storage/sql/postgresql/file-storage-package-create.sql 15 Dec 2003 11:21:04 -0000 1.15 @@ -6,7 +6,7 @@ -- @cvs-id $Id$ -- -create function file_storage__get_root_folder ( +create or replace function file_storage__get_root_folder ( -- -- Returns the root folder corresponding to a particular -- package instance. @@ -37,7 +37,7 @@ end;' language 'plpgsql' stable; -create function file_storage__get_package_id ( +create or replace function file_storage__get_package_id ( integer -- cr_items.item_id%TYPE ) returns integer as ' -- fs_root_folders.package_id%TYPE declare @@ -63,7 +63,7 @@ end;' language 'plpgsql' stable; -create function file_storage__new_root_folder ( +create or replace function file_storage__new_root_folder ( -- -- Creates a new root folder -- @@ -73,13 +73,15 @@ -- integer, -- apm_packages.package_id%TYPE varchar, -- cr_folders.label%TYPE - varchar -- cr_folders.description%TYPE + varchar, -- cr_folders.description%TYPE + varchar -- cr_items.name%TYPE ) returns integer as ' -- fs_root_folders.folder_id%TYPE declare new_root_folder__package_id alias for $1; new_root_folder__folder_name alias for $2; new_root_folder__description alias for $3; + new_root_folder__url alias for $4; v_folder_id fs_root_folders.folder_id%TYPE; v_package_name apm_packages.instance_name%TYPE; v_package_key apm_packages.package_key%TYPE; @@ -107,7 +109,7 @@ end if; v_folder_id := content_folder__new ( - v_package_key || ''_'' || new_root_folder__package_id, -- name + coalesce (new_root_folder__url, v_package_key || ''_'' || new_root_folder__package_id), -- name v_folder_name, -- label v_description, -- description null -- parent_id (default) @@ -160,7 +162,7 @@ end;' language 'plpgsql'; -create function file_storage__new_file( +create or replace function file_storage__new_file( -- -- Create a file in CR in preparation for actual storage -- Wrapper for content_item__new @@ -175,7 +177,7 @@ integer -- cr_items.item_id%TYPE, ) returns integer as ' -- cr_items.item_id%TYPE declare - new_file__title alias for $1; + new_file__name alias for $1; new_file__folder_id alias for $2; new_file__user_id alias for $3; new_file__creation_ip alias for $4; @@ -187,7 +189,7 @@ if new_file__indb_p then v_item_id := content_item__new ( - new_file__title, -- name + new_file__name, -- name new_file__folder_id, -- parent_id new_file__item_id, -- item_id (default) null, -- locale (default) @@ -205,7 +207,7 @@ ); else v_item_id := content_item__new ( - new_file__title, -- name + new_file__name, -- name new_file__folder_id, -- parent_id new_file__item_id, -- item_id (default) null, -- locale (default) @@ -232,23 +234,23 @@ end;' language 'plpgsql'; -create function file_storage__new_file( +create or replace function file_storage__new_file( varchar, -- cr_items.name%TYPE, integer, -- cr_items.parent_id%TYPE, integer, -- acs_objects.creation_user%TYPE, varchar, -- acs_objects.creation_ip%TYPE, boolean -- store in db? ) returns integer as ' -- cr_items.item_id%TYPE declare - new_file__title alias for $1; + new_file__name alias for $1; new_file__folder_id alias for $2; new_file__user_id alias for $3; new_file__creation_ip alias for $4; new_file__indb_p alias for $5; begin return file_storage__new_file( - new_file__title, + new_file__name, new_file__folder_id, new_file__user_id, new_file__creation_ip, @@ -259,7 +261,7 @@ end;' language 'plpgsql'; -create function file_storage__delete_file ( +create or replace function file_storage__delete_file ( -- -- Delete a file and all its version -- Wrapper to content_item__delete @@ -275,7 +277,7 @@ end;' language 'plpgsql'; -create function file_storage__rename_file ( +create or replace function file_storage__rename_file ( -- -- Rename a file and all -- Wrapper to content_item__rename @@ -285,19 +287,19 @@ ) returns integer as ' declare rename_file__file_id alias for $1; - rename_file__title alias for $2; + rename_file__name alias for $2; begin return content_item__rename( rename_file__file_id, -- item_id - rename_file__title -- name + rename_file__name -- name ); end;' language 'plpgsql'; -create function file_storage__copy_file( +create or replace function file_storage__copy_file( -- -- Copy a file, but only copy the live_revision -- @@ -311,7 +313,7 @@ copy_file__target_folder_id alias for $2; copy_file__creation_user alias for $3; copy_file__creation_ip alias for $4; - v_title cr_items.name%TYPE; + v_name cr_items.name%TYPE; v_live_revision cr_items.live_revision%TYPE; v_filename cr_revisions.title%TYPE; v_description cr_revisions.description%TYPE; @@ -332,7 +334,7 @@ then true else false end) - into v_title,v_live_revision,v_filename,v_description,v_mime_type,v_content_length,v_indb_p + into v_name,v_live_revision,v_filename,v_description,v_mime_type,v_content_length,v_indb_p from cr_items i, cr_revisions r where r.item_id = i.item_id and r.revision_id = i.live_revision @@ -341,7 +343,7 @@ -- We should probably use the copy functions of CR -- when we optimize this function v_new_file_id := file_storage__new_file( - v_title, -- title + v_name, -- name copy_file__target_folder_id, -- folder_id copy_file__creation_user, -- creation_user copy_file__creation_ip, -- creation_ip @@ -399,7 +401,7 @@ end;' language 'plpgsql'; -create function file_storage__move_file ( +create or replace function file_storage__move_file ( -- -- Move a file (ans all its versions) to a different folder. -- Wrapper for content_item__move @@ -427,16 +429,13 @@ end;' language 'plpgsql'; -create function file_storage__get_title ( +create or replace function file_storage__get_title ( -- - -- Unfortunately, title in the file-storage context refers - -- to the name attribute in cr_items, not the title attribute in - -- cr_revisions integer -- cr_items.item_id%TYPE ) returns varchar as ' declare get_title__item_id alias for $1; - v_title cr_items.name%TYPE; + v_title cr_revisions.title%TYPE; v_content_type cr_items.content_type%TYPE; begin @@ -454,17 +453,18 @@ select label into v_title from cr_symlinks where symlink_id = get_title__item_id; else - select name into v_title - from cr_items - where item_id = get_title__item_id; + select title into v_title + from cr_revisions, cr_items + where revision_id=live_revision + and cr_items.item_id=get_title__item_id; end if; end if; return v_title; end;' language 'plpgsql'; -create function file_storage__get_parent_id ( +create or replace function file_storage__get_parent_id ( integer -- item_id in cr_items.item_id%TYPE ) returns integer as ' -- cr_items.item_id%TYPE declare @@ -482,7 +482,7 @@ end;'language 'plpgsql'; -create function file_storage__get_content_type ( +create or replace function file_storage__get_content_type ( -- -- Wrapper for content_item__get_content_type integer -- cr_items.item_id%TYPE @@ -498,7 +498,7 @@ -create function file_storage__get_folder_name ( +create or replace function file_storage__get_folder_name ( -- -- Wrapper for content_folder__get_label integer -- cr_folders.folder_id%TYPE @@ -513,7 +513,7 @@ end;' language 'plpgsql'; -create function file_storage__new_version ( +create or replace function file_storage__new_version ( -- -- Create a new version of a file -- Wrapper for content_revision__new @@ -559,14 +559,19 @@ where cr_items.item_id = new_version__item_id; perform acs_object__update_last_modified(v_folder_id,new_version__creation_user,new_version__creation_ip); +<<<<<<< file-storage-package-create.sql perform acs_object__update_last_modified(new_version__item_id,new_version__creation_user,new_version__creation_ip); + return v_revision_id; +======= + perform acs_object__update_last_modified(new_version__item_id,new_version__creation_user,new_version__creation_ip); return v_revision_id; +>>>>>>> 1.13 end;' language 'plpgsql'; -create function file_storage__delete_version ( +create or replace function file_storage__delete_version ( -- -- Delete a version of a file -- @@ -606,7 +611,7 @@ end;' language 'plpgsql'; -create function file_storage__new_folder( +create or replace function file_storage__new_folder( -- -- Create a folder -- @@ -676,7 +681,7 @@ end;' language 'plpgsql'; -create function file_storage__delete_folder( +create or replace function file_storage__delete_folder( -- -- Delete a folder -- @@ -694,7 +699,7 @@ -- JS: BEFORE DELETE TRIGGER to clean up CR entries (except root folder) -create function fs_package_items_delete_trig () returns opaque as ' +create or replace function fs_package_items_delete_trig () returns opaque as ' declare v_rec record; @@ -757,7 +762,7 @@ -- JS: AFTER DELETE TRIGGER to clean up last CR entry -create function fs_root_folder_delete_trig () returns opaque as ' +create or replace function fs_root_folder_delete_trig () returns opaque as ' begin PERFORM content_folder__delete(old.folder_id); return null; Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/packages/file-storage/tcl/file-storage-dav-install-procs.tcl'. Fisheye: No comparison available. Pass `N' to diff? Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/packages/file-storage/tcl/file-storage-dav-procs.tcl'. Fisheye: No comparison available. Pass `N' to diff? Index: openacs-4/packages/file-storage/tcl/file-storage-init.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/file-storage-init.tcl,v diff -u -r1.5 -r1.6 --- openacs-4/packages/file-storage/tcl/file-storage-init.tcl 5 Nov 2002 17:19:58 -0000 1.5 +++ openacs-4/packages/file-storage/tcl/file-storage-init.tcl 15 Dec 2003 11:21:04 -0000 1.6 @@ -7,6 +7,8 @@ @cvs-id $Id$ } +# unused after mount callback handles this now + # JS: proc to execute every time a new package instance is created. # This avoids the ugly hack in the original version that checks for # the existence of a root folder every time fs_get_root_folder is called @@ -20,13 +22,13 @@ # "post_instantiation". The parameter passed is always # package_id. The name of the proc is thus: -ad_proc file_storage_post_instantiation { - package_id -} { - Post package instantiation procedure to insert a package_id, - folder_id pair in fs_root_folders -} { - # We should probably just define this function here, and remove from the fs namespace - return [fs::new_root_folder -package_id $package_id] -} +# ad_proc file_storage_post_instantiation { +# package_id +# } { +# Post package instantiation procedure to insert a package_id, +# folder_id pair in fs_root_folders +# } { +# # We should probably just define this function here, and remove from the fs namespace +# return [fs::new_root_folder -package_id $package_id] +# } Index: openacs-4/packages/file-storage/tcl/file-storage-procs-oracle.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/file-storage-procs-oracle.xql,v diff -u -r1.21 -r1.22 --- openacs-4/packages/file-storage/tcl/file-storage-procs-oracle.xql 17 May 2003 10:39:21 -0000 1.21 +++ openacs-4/packages/file-storage/tcl/file-storage-procs-oracle.xql 15 Dec 2003 11:21:04 -0000 1.22 @@ -56,7 +56,7 @@ fs_objects.name, fs_objects.live_revision, fs_objects.type, - to_char(fs_objects.last_modified, 'Month DD YYYY HH24:MI') as last_modified, + to_char(fs_objects.last_modified, 'YYYY-MM-DD HH24:MI:SS') as last_modified_ansi, fs_objects.content_size, fs_objects.url, fs_objects.key, @@ -149,4 +149,34 @@ + + + + select content_item__get_id ( :name, :folder_id, 'f' ) + + + + + + + select file_storage.new_file ( + :name, + :parent_id, + :creation_user, + :creation_ip, + :indbp, + :item_id + ) + + + + + + begin + acs_object.update_last_modified(:parent_id,:creation_user,:creation_ip); + acs_object.update_last_modified(:item_id,:creation_user,:creation_ip); + end; + + + Index: openacs-4/packages/file-storage/tcl/file-storage-procs-postgresql.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/file-storage-procs-postgresql.xql,v diff -u -r1.34 -r1.35 --- openacs-4/packages/file-storage/tcl/file-storage-procs-postgresql.xql 13 Aug 2003 13:30:53 -0000 1.34 +++ openacs-4/packages/file-storage/tcl/file-storage-procs-postgresql.xql 15 Dec 2003 11:21:04 -0000 1.35 @@ -8,7 +8,8 @@ select file_storage__new_root_folder( :package_id, :pretty_name, - :description + :description, + :name ); @@ -108,7 +109,7 @@ - select file_storage__get_title(:item_id) + select name from cr_items where item_id=:item_id @@ -136,4 +137,36 @@ + + + select content_item__get_id ( :name, :folder_id, 'f' ) + + + + + + + select file_storage__new_file ( + :name, + :parent_id, + :creation_user, + :creation_ip, + :indbp, + :item_id + ) + + + + + + begin + perform acs_object__update_last_modified + (:parent_id,:creation_user,:creation_ip); + perform + acs_object__update_last_modified(:item_id,:creation_user,:creation_ip); + return null; + end; + + + Index: openacs-4/packages/file-storage/tcl/file-storage-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/file-storage-procs.tcl,v diff -u -r1.33 -r1.34 --- openacs-4/packages/file-storage/tcl/file-storage-procs.tcl 25 Sep 2003 12:30:22 -0000 1.33 +++ openacs-4/packages/file-storage/tcl/file-storage-procs.tcl 15 Dec 2003 11:21:04 -0000 1.34 @@ -181,393 +181,525 @@ return $context_bar } -namespace eval fs { +namespace eval fs {} - ad_proc -public new_root_folder { - {-package_id ""} - {-pretty_name ""} - {-description ""} - } { - Create a root folder for a package instance. +ad_proc -public fs::after_mount { + -package_id + -node_id +} { + Create root folder for package instance + via tcl callback. - @param package_id Package instance associated with this root folder + This sets the cr_items.name to the url of the site + node. +} { + array set sn [site_node::get -node_id $node_id] + regsub -all {/} $sn(name) {} name + fs::new_root_folder \ + -package_id $package_id \ + -pretty_name $sn(instance_name) \ + -name $name +} - @return folder_id of the new root folder - } { - if {[empty_string_p $package_id]} { - set package_id [ad_conn package_id] - } +ad_proc -public fs::new_root_folder { + {-package_id ""} + {-pretty_name ""} + {-name ""} + {-description ""} +} { + Create a root folder for a package instance. - return [db_exec_plsql new_root_folder {}] + @param package_id Package instance associated with this root folder + + @return folder_id of the new root folder +} { + if {[empty_string_p $package_id]} { + set package_id [ad_conn package_id] } - ad_proc -public get_root_folder { - {-package_id ""} - } { - Get the root folder of a package instance. + return [db_exec_plsql new_root_folder {}] +} - @param package_id Package instance of the root folder to retrieve +ad_proc -public fs::get_root_folder { + {-package_id ""} +} { + Get the root folder of a package instance. - @return folder_id of the root folder retrieved - } { - if {[empty_string_p $package_id]} { - set package_id [ad_conn package_id] - } + @param package_id Package instance of the root folder to retrieve - return [db_exec_plsql get_root_folder {}] + @return folder_id of the root folder retrieved +} { + if {[empty_string_p $package_id]} { + set package_id [ad_conn package_id] } - ad_proc -public new_folder { - {-name:required} - {-pretty_name:required} - {-parent_id:required} - {-creation_user ""} - {-creation_ip ""} - } { - Create a new folder. + return [db_exec_plsql get_root_folder {}] +} - @param name Internal name of the folder, must be unique under a given - parent_id - @param pretty_name What we show to users of the system - @param parent_id Where we create this folder - @param creation_user Who created this folder - @param creation_ip What is the ip address of the creation_user +ad_proc -public fs::new_folder { + {-name:required} + {-pretty_name:required} + {-parent_id:required} + {-creation_user ""} + {-creation_ip ""} +} { + Create a new folder. - @return folder_id of the newly created folder - } { - if {[empty_string_p $creation_user]} { - set creation_user [ad_conn user_id] - } + @param name Internal name of the folder, must be unique under a given + parent_id + @param pretty_name What we show to users of the system + @param parent_id Where we create this folder + @param creation_user Who created this folder + @param creation_ip What is the ip address of the creation_user - if {[empty_string_p $creation_ip]} { - set creation_ip [ns_conn peeraddr] - } - - return [db_exec_plsql new_folder {}] + @return folder_id of the newly created folder +} { + if {[empty_string_p $creation_user]} { + set creation_user [ad_conn user_id] } - ad_proc -public rename_folder { - {-folder_id:required} - {-name:required} - } { - rename the given folder - } { - db_exec_plsql rename_folder {} + if {[empty_string_p $creation_ip]} { + set creation_ip [ns_conn peeraddr] } - ad_proc -public object_p { - {-object_id:required} - } { - is this a file storage object - } { - return [db_string select_object_p {}] - } + return [db_exec_plsql new_folder {}] +} - ad_proc -public get_object_name { - {-object_id:required} - } { - Select the name of this object. - } { - return [db_string select_object_name {} -default $object_id] - } +ad_proc -public fs::rename_folder { + {-folder_id:required} + {-name:required} +} { + rename the given folder +} { + db_exec_plsql rename_folder {} +} - ad_proc -public get_file_system_safe_object_name { - {-object_id:required} - } { - get the name of a file storage object and make it safe for writing to - the file system - } { - return [remove_special_file_system_characters -string [get_object_name -object_id $object_id]] - } +ad_proc -public fs::object_p { + {-object_id:required} +} { + is this a file storage object +} { + return [db_string select_object_p {}] +} - ad_proc -public remove_special_file_system_characters { - {-string:required} - } { - remove unsafe file system characters. useful if you want to use $string - as the name of an object to write to disk. - } { - regsub -all {[<>:\"|/@\#%&+\\]} $string {_} string - return [string trim $string] - } +ad_proc -public fs::get_object_name { + {-object_id:required} +} { + Select the name of this object. +} { + return [db_string select_object_name {} -default $object_id] +} - ad_proc -public folder_p { - {-object_id:required} - } { - Is this object a folder? +ad_proc -public fs::get_file_system_safe_object_name { + {-object_id:required} +} { + get the name of a file storage object and make it safe for writing to + the file system +} { + return [remove_special_file_system_characters -string [get_object_name -object_id $object_id]] +} - @return true if object_id is a folder - } { - return [db_string select_folder_p {} -default 0] - } +ad_proc -public fs::remove_special_file_system_characters { + {-string:required} +} { + remove unsafe file system characters. useful if you want to use $string + as the name of an object to write to disk. +} { + regsub -all {[<>:\"|/@\#%&+\\]} $string {_} string + return [string trim $string] +} - ad_proc -public get_folder { - {-name:required} - {-parent_id:required} - } { - Retrieve the folder_id of a folder given it's name and parent folder. +ad_proc -public fs::folder_p { + {-object_id:required} +} { + Is this object a folder? - @param name Internal name of the folder, must be unique under a given - parent_id - @param parent_id The parent folder to look under + @return true if object_id is a folder +} { + return [db_string select_folder_p {} -default 0] +} - @return folder_id of the folder, or null if no folder was found by that - name - } { - return [db_string select_folder {} -default ""] - } +ad_proc -public fs::get_folder { + {-name:required} + {-parent_id:required} +} { + Retrieve the folder_id of a folder given it's name and parent folder. - ad_proc -public get_folder_objects { - -folder_id:required - -user_id:required - } { - Return a list the object_ids contained by a file storage folder. + @param name Internal name of the folder, must be unique under a given + parent_id + @param parent_id The parent folder to look under - @param folder_id The folder for which to retrieve contents - @param user_id The viewer of the contents (to make sure they have - permission) + @return folder_id of the folder, or null if no folder was found by that + name +} { + return [db_string select_folder {} -default ""] +} - } { - return [db_list select_folder_contents {}] +ad_proc -public fs::get_folder_objects { + -folder_id:required + -user_id:required +} { + Return a list the object_ids contained by a file storage folder. + + @param folder_id The folder for which to retrieve contents + @param user_id The viewer of the contents (to make sure they have + permission) + +} { + return [db_list select_folder_contents {}] +} + +ad_proc -public fs::get_folder_contents { + {-folder_id ""} + {-user_id ""} + {-n_past_days "99999"} +} { + WARNING: This proc is not scalable because it does too many permission checks. + + DRB: Not so true now that permissions are fast. However it is now only used + to clone files in dotLRN and for the somewhat brain-damaged syllabus package. + At minimum the permission checks returned by the code can be removed. Most of + the other fields as well. Oh well ... + + REMOVE WHEN SYLLABUS IS REWRITTEN TO FIND ITS FILE INTELLIGENTLY + + Retrieve the contents of the specified folder in the form of a list + of ns_sets, one for each row returned. The keys for each row are as + follows: + + object_id, name, live_revision, type, + last_modified, new_p, content_size, file_upload_name + write_p, delete_p, admin_p, + + @param folder_id The folder for which to retrieve contents + @param user_id The viewer of the contents (to make sure they have + permission) + @param n_past_days Mark files that are newer than the past N days as new +} { + if {[empty_string_p $folder_id]} { + set folder_id [get_root_folder -package_id [ad_conn package_id]] } - ad_proc -public get_folder_contents { - {-folder_id ""} - {-user_id ""} - {-n_past_days "99999"} - } { - WARNING: This proc is not scalable because it does too many permission checks. + if {[empty_string_p $user_id]} { + set user_id [acs_magic_object the_public] + } - DRB: Not so true now that permissions are fast. However it is now only used - to clone files in dotLRN and for the somewhat brain-damaged syllabus package. - At minimum the permission checks returned by the code can be removed. Most of - the other fields as well. Oh well ... + set list_of_ns_sets [db_list_of_ns_sets select_folder_contents {}] - REMOVE WHEN SYLLABUS IS REWRITTEN TO FIND ITS FILE INTELLIGENTLY + foreach set $list_of_ns_sets { + # in plain Tcl: + # set last_modified_ansi [lc_time_system_to_conn $last_modified_ansi] + ns_set put $set last_modified_ansi [lc_time_system_to_conn [ns_set get $set last_modifed_ansi]] - Retrieve the contents of the specified folder in the form of a list - of ns_sets, one for each row returned. The keys for each row are as - follows: + # in plain Tcl: + # set last_modified [lc_time_fmt $last_modified_ansi "%x %X"] + ns_set put $set last_modified [lc_time_fmt [ns_set get $set last_modified_ansi] "%x %X"] - object_id, name, live_revision, type, - last_modified, new_p, content_size, file_upload_name - write_p, delete_p, admin_p, + # set content_size_pretty [lc_numeric $content_size] + ns_set put $set content_size_pretty [lc_numeric [ns_set get $set content_size]] + } - @param folder_id The folder for which to retrieve contents - @param user_id The viewer of the contents (to make sure they have - permission) - @param n_past_days Mark files that are newer than the past N days as new - } { - if {[empty_string_p $folder_id]} { - set folder_id [get_root_folder -package_id [ad_conn package_id]] - } + return $list_of_ns_sets +} - if {[empty_string_p $user_id]} { - set user_id [acs_magic_object the_public] - } +ad_proc -public fs::get_folder_contents_count { + {-folder_id ""} + {-user_id ""} +} { + Retrieve the count of contents of the specified folder. - set list_of_ns_sets [db_list_of_ns_sets select_folder_contents {}] + @param folder_id The folder for which to retrieve contents + @param user_id The viewer of the contents (to make sure they have + permission) +} { + if {[empty_string_p $folder_id]} { + set folder_id [get_root_folder -package_id [ad_conn package_id]] + } - foreach set $list_of_ns_sets { - # in plain Tcl: - # set last_modified_ansi [lc_time_system_to_conn $last_modified_ansi] - ns_set put $set last_modified_ansi [lc_time_system_to_conn [ns_set get $set last_modifed_ansi]] + if {[empty_string_p $user_id]} { + set user_id [acs_magic_object the_public] + } - # in plain Tcl: - # set last_modified [lc_time_fmt $last_modified_ansi "%x %X"] - ns_set put $set last_modified [lc_time_fmt [ns_set get $set last_modified_ansi] "%x %X"] + return [db_string select_folder_contents_count {}] +} - # set content_size_pretty [lc_numeric $content_size] - ns_set put $set content_size_pretty [lc_numeric [ns_set get $set content_size]] - } +ad_proc -public fs::publish_object_to_file_system { + {-object_id:required} + {-path ""} + {-file_name ""} + {-user_id ""} +} { + publish a file storage object to the file system +} { + if {[empty_string_p $path]} { + set path [ns_tmpnam] + } - return $list_of_ns_sets + db_1row select_object_info {} + + if {[string equal folder $type]} { + set result [publish_folder_to_file_system -folder_id $object_id -path $path -folder_name $name -user_id $user_id] + } elseif {[string equal url $type]} { + set result [publish_url_to_file_system -object_id $object_id -path $path -file_name $file_name] + } else { + set result [publish_versioned_object_to_file_system -object_id $object_id -path $path] } - ad_proc -public get_folder_contents_count { - {-folder_id ""} - {-user_id ""} - } { - Retrieve the count of contents of the specified folder. + return $result +} - @param folder_id The folder for which to retrieve contents - @param user_id The viewer of the contents (to make sure they have - permission) - } { - if {[empty_string_p $folder_id]} { - set folder_id [get_root_folder -package_id [ad_conn package_id]] - } +ad_proc -public fs::publish_folder_to_file_system { + {-folder_id:required} + {-path ""} + {-folder_name ""} + {-user_id ""} +} { + publish the contents of a file storage folder to the file system +} { + if {[empty_string_p $path]} { + set path [ns_tmpnam] + } - if {[empty_string_p $user_id]} { - set user_id [acs_magic_object the_public] - } + if {[empty_string_p $folder_name]} { + set folder_name [get_object_name -object_id $folder_id] + } + set folder_name [remove_special_file_system_characters -string $folder_name] - return [db_string select_folder_contents_count {}] + set dir [file join ${path} ${folder_name}] + file mkdir $dir + + foreach object [get_folder_contents -folder_id $folder_id -user_id $user_id] { + publish_object_to_file_system \ + -object_id [ns_set get $object object_id] \ + -path $dir \ + -file_name [remove_special_file_system_characters -string [ns_set get $object name]] \ + -user_id $user_id } - ad_proc -public publish_object_to_file_system { - {-object_id:required} - {-path ""} - {-file_name ""} - {-user_id ""} - } { - publish a file storage object to the file system - } { - if {[empty_string_p $path]} { - set path [ns_tmpnam] - } + return $dir +} - db_1row select_object_info {} +ad_proc -public fs::publish_url_to_file_system { + {-object_id:required} + {-path ""} + {-file_name ""} +} { + publish a url object to the file system as a Windows shortcut + (which at least KDE also knows how to handle) +} { + if {[empty_string_p $path]} { + set path [ns_tmpnam] + file mkdir $path + } - if {[string equal folder $type]} { - set result [publish_folder_to_file_system -folder_id $object_id -path $path -folder_name $name -user_id $user_id] - } elseif {[string equal url $type]} { - set result [publish_url_to_file_system -object_id $object_id -path $path -file_name $file_name] - } else { - set result [publish_versioned_object_to_file_system -object_id $object_id -path $path] - } + db_1row select_object_metadata {} - return $result + if {[empty_string_p $file_name]} { + set file_name $label } + set file_name "${file_name}.url" + set file_name [remove_special_file_system_characters -string $file_name] - ad_proc -public publish_folder_to_file_system { - {-folder_id:required} - {-path ""} - {-folder_name ""} - {-user_id ""} - } { - publish the contents of a file storage folder to the file system - } { - if {[empty_string_p $path]} { - set path [ns_tmpnam] - } + set fp [open [file join ${path} ${file_name}] w] + puts $fp {[InternetShortcut]} + puts $fp URL=$url + close $fp - if {[empty_string_p $folder_name]} { - set folder_name [get_object_name -object_id $folder_id] - } - set folder_name [remove_special_file_system_characters -string $folder_name] + return [file join ${path} ${file_name}] +} - set dir [file join ${path} ${folder_name}] - file mkdir $dir +ad_proc -public fs::publish_versioned_object_to_file_system { + {-object_id:required} + {-path ""} + {-file_name ""} +} { + publish an object to the file system +} { + if {[empty_string_p $path]} { + set path [ns_tmpnam] + file mkdir $path + } - foreach object [get_folder_contents -folder_id $folder_id -user_id $user_id] { - publish_object_to_file_system \ - -object_id [ns_set get $object object_id] \ - -path $dir \ - -file_name [remove_special_file_system_characters -string [ns_set get $object name]] \ - -user_id $user_id - } + db_1row select_object_metadata {} - return $dir + if {[empty_string_p $file_name]} { + set file_name $title } + set file_name [remove_special_file_system_characters -string $file_name] - ad_proc -public publish_url_to_file_system { - {-object_id:required} - {-path ""} - {-file_name ""} - } { - publish a url object to the file system as a Windows shortcut - (which at least KDE also knows how to handle) - } { - if {[empty_string_p $path]} { - set path [ns_tmpnam] - file mkdir $path - } + switch $storage_type { + lob { - db_1row select_object_metadata {} + # FIXME: db_blob_get_file is failing when i use bind variables - if {[empty_string_p $file_name]} { - set file_name $label - } - set file_name "${file_name}.url" - set file_name [remove_special_file_system_characters -string $file_name] + # DRB: you're out of luck - the driver doesn't support them and while it should + # be fixed it will be a long time before we'll want to require an updated + # driver. I'm substituting the Tcl variable value directly in the query due to + # this. It's safe because we've pulled the value ourselves from the database, + # don't need to worry about SQL smuggling etc. - set fp [open [file join ${path} ${file_name}] w] - puts $fp {[InternetShortcut]} - puts $fp URL=$url - close $fp + db_blob_get_file select_object_content {} -file [file join ${path} ${file_name}] + } + text { + set content [db_string select_object_content {}] - return [file join ${path} ${file_name}] + set fp [open [file join ${path} ${file_name}] w] + puts $fp $content + close $fp + } + file { + set cr_path [cr_fs_path $storage_area_key] + set cr_file_name [db_string select_file_name {}] + + file copy -- "${cr_path}${cr_file_name}" [file join ${path} ${file_name}] + } } - ad_proc -public publish_versioned_object_to_file_system { - {-object_id:required} - {-path ""} - {-file_name ""} - } { - publish an object to the file system - } { - if {[empty_string_p $path]} { - set path [ns_tmpnam] - file mkdir $path - } + return [file join ${path} ${file_name}] +} - db_1row select_object_metadata {} +ad_proc -public fs::get_archive_command { + {-in_file ""} + {-out_file ""} +} { + return the archive command after replacing {in_file} and {out_file} with + their respective values. +} { + set cmd [parameter::get -parameter ArchiveCommand -default "cat `find {in_file} -type f` > {out_file}"] - if {[empty_string_p $file_name]} { - set file_name $title - } - set file_name [remove_special_file_system_characters -string $file_name] + regsub -all {(\W)} $in_file {\\\1} in_file + regsub -all {\\/} $in_file {/} in_file + regsub -all {\\\.} $in_file {.} in_file - switch $storage_type { - lob { + regsub -all {(\W)} $out_file {\\\1} out_file + regsub -all {\\/} $out_file {/} out_file + regsub -all {\\\.} $out_file {.} out_file - # FIXME: db_blob_get_file is failing when i use bind variables + regsub -all {{in_file}} $cmd $in_file cmd + regsub -all {{out_file}} $cmd $out_file cmd - # DRB: you're out of luck - the driver doesn't support them and while it should - # be fixed it will be a long time before we'll want to require an updated - # driver. I'm substituting the Tcl variable value directly in the query due to - # this. It's safe because we've pulled the value ourselves from the database, - # don't need to worry about SQL smuggling etc. + return $cmd +} - db_blob_get_file select_object_content {} -file [file join ${path} ${file_name}] - } - text { - set content [db_string select_object_content {}] +ad_proc -public fs::get_archive_extension {} { + return the archive extension that should be added to the output file of + an archive command +} { + return [parameter::get -parameter ArchiveExtension -default "txt"] +} - set fp [open [file join ${path} ${file_name}] w] - puts $fp $content - close $fp - } - file { - set cr_path [cr_fs_path $storage_area_key] - set cr_file_name [db_string select_file_name {}] +ad_proc -public fs::get_item_id { + -name + {-folder_id ""} +} { + Get the item_id of a file +} { + if {[empty_string_p $folder_id]} { + set package_id [ad_conn package_id] + set folder_id [fs_get_root_folder -package_id $package_id] + } + return [db_exec_plsql get_item_id ""] +} - file copy -- "${cr_path}${cr_file_name}" [file join ${path} ${file_name}] - } - } +ad_proc -public fs::add_file { + -name + -parent_id + -tmp_filename + -package_id + {-item_id ""} + {-creation_user ""} + {-creation_ip ""} + {-title ""} + {-description ""} +} { + Create a new file storage item or add a new revision if + an item with the same name and parent folder already exists - return [file join ${path} ${file_name}] + @returns revision_id +} { + + if {[ad_parameter "StoreFilesInDatabaseP" -package_id $package_id]} { + set indbp "t" + } else { + set indpb "f" } - ad_proc -public get_archive_command { - {-in_file ""} - {-out_file ""} - } { - return the archive command after replacing {in_file} and {out_file} with - their respective values. - } { - set cmd [parameter::get -parameter ArchiveCommand -default "cat `find {in_file} -type f` > {out_file}"] + set mime_type [cr_filename_to_mime_type -create $name] + switch [cr_registered_type_for_mime_type $mime_type] { + image { + set content_type "image" + } + default { + set content_type "file_storage_object" + } + } - regsub -all {(\W)} $in_file {\\\1} in_file - regsub -all {\\/} $in_file {/} in_file - regsub -all {\\\.} $in_file {.} in_file + db_transaction { + if {[empty_string_p $item_id] || ![db_string item_exists ""]} { + set item_id [db_exec_plsql create_item ""] - regsub -all {(\W)} $out_file {\\\1} out_file - regsub -all {\\/} $out_file {/} out_file - regsub -all {\\\.} $out_file {.} out_file + if {![empty_string_p $creation_user]} { + permission::grant -party_id $creation_user -object_id $item_id -privilege admin + } + } - regsub -all {{in_file}} $cmd $in_file cmd - regsub -all {{out_file}} $cmd $out_file cmd - return $cmd + set revision_id [fs::add_version \ + -name $name \ + -parent_id $parent_id \ + -tmp_filename $tmp_filename \ + -package_id $package_id \ + -item_id $item_id \ + -creation_user $creation_user \ + -creation_ip $creation_ip \ + -title $title \ + -description $description + ] } + return $revision_id +} - ad_proc -public get_archive_extension {} { - return the archive extension that should be added to the output file of - an archive command - } { - return [parameter::get -parameter ArchiveExtension -default "txt"] +ad_proc fs::add_version { + -name + -parent_id + -tmp_filename + -package_id + {-item_id ""} + {-creation_user ""} + {-creation_ip ""} + {-title ""} + {-description ""} + +} { + Create a new version of a file storage item + @returns revision_id +} { + + if {[ad_parameter "StoreFilesInDatabaseP" -package_id $package_id]} { + set storage_type "lob" + } else { + set storage_type "file" } -} + set mime_type [cr_filename_to_mime_type -create $name] + set tmp_size [file size $tmp_filename] + set revision_id [cr_import_content \ + -item_id $item_id \ + -storage_type $storage_type \ + -creation_user $creation_user \ + -creation_ip $creation_ip \ + -other_type "file_storage_object" \ + -title $title \ + -description $description \ + $parent_id \ + $tmp_filename \ + $tmp_size \ + $mime_type \ + $name] + + db_dml set_live_revision "" + db_exec_plsql update_last_modified "" + + return $revision_id +} Index: openacs-4/packages/file-storage/tcl/file-storage-procs.xql =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/file-storage/tcl/file-storage-procs.xql,v diff -u -r1.13 -r1.14 --- openacs-4/packages/file-storage/tcl/file-storage-procs.xql 11 Dec 2003 21:40:04 -0000 1.13 +++ openacs-4/packages/file-storage/tcl/file-storage-procs.xql 15 Dec 2003 11:21:04 -0000 1.14 @@ -117,5 +117,18 @@ + + + select count(*) from cr_items + where name=:name + and parent_id=:parent_id + + + + + update cr_items set live_revision=:revision_id + where item_id=:item_id + +