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
+}