Index: openacs-4/packages/acs-content-repository/tcl/revision-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-content-repository/tcl/revision-procs.tcl,v diff -u -r1.8 -r1.9 --- openacs-4/packages/acs-content-repository/tcl/revision-procs.tcl 16 Jan 2003 13:29:27 -0000 1.8 +++ openacs-4/packages/acs-content-repository/tcl/revision-procs.tcl 17 May 2003 09:43:54 -0000 1.9 @@ -1,24 +1,5 @@ # upload an item revision from a file -ad_proc -public cr_revision_upload { title item_id path } { - - set revision_id [db_exec_plsql get_revision_id "begin - :1 := content_revision.new(title => :title, - item_id => :item_id, - v_content => null); - end;"] - - db_dml dml_revision_from_file "update - cr_revisions - set - content = empty_blob() - where - revision_id = :revision_id - returning content into :1" -blob_files [list $path] - - return $revision_id -} - ad_proc -public cr_write_content { -item_id -revision_id @@ -280,3 +261,90 @@ } { return [db_string registered_type_for_mime_type "" -default ""] } + + +ad_proc -public cr_filename_to_mime_type { + -create:boolean + filename +} { + given a filename, returns the mime type. If the -create flag is + given the mime type will be created; this assumes there is some + other way such as ns_guesstype to find the filename + + @param create flag whether to create the mime type the routine picks for filename + @param filename the filename to try to guess a mime type for (the file need not + exist, the routine does not attempt to access the file in any way) + + @return mimetype (or */* of unknown) + + @author Jeff Davis (davis@xarg.net) +} { + set extension [string tolower [string trimleft [file extension $filename] "."]] + + if {[empty_string_p $extension]} { + return "*/*" + } + + if {[db_0or1row lookup_mimetype { select mime_type from cr_extension_mime_type_map where extension = :extension }]} { + return $mime_type + } else { + set mime_type [string tolower [ns_guesstype $filename]] + ns_log Debug "guessed mime \"$mime_type\" create_p $create_p" + if {(!$create_p) || [string equal $mime_type "*/*"] || [empty_string_p $mime_type]} { + # we don't have anything meaningful for this mimetype + # so just */* it. + + return "*/*" + } + + # We guessed a type but there was no mapping + # create it and map it. We know the extension + cr_create_mime_type -extension $extension -mime_type $mime_type -description {} + + return $mime_type + } +} + +ad_proc -public cr_create_mime_type { + -extension + -mime_type + -description +} { + + Creates a mime type if it does not exist. Also maps extension to + mime_type (unless the extension is already mapped to another mime + type). + + @param extension the default extension for the given mime type + @param mime_type the mime_type to create + @param a plain text description of the mime type (< 200 characters) + + @author Jeff Davis (davis@xarg.net) +} { + # make both lower since that is the convention. + # should never pass in anything that is not lower cased + # already but just be safe. + + set mime_type [string tolower $mime_type] + set extension [string tolower $extension] + + db_dml maybe_create_mime { + insert into cr_mime_types (label, mime_type, file_extension) + select :description, :mime_type, :extension + from dual + where not exists (select 1 + from cr_mime_types + where mime_type = :mime_type) + } + + db_dml maybe_map_extension { + insert into cr_extension_mime_type_map (extension, mime_type) + select :extension, :mime_type + from dual + where not exists (select 1 + from cr_extension_mime_type_map + where extension = :extension) + } +} + +