REBOL [
    Author: "Brett Handley"
    Title: "Mime Types"
    Purpose: "Provide some functions based on mime type."
    Date: 7-Sep-2000
    Email: brett@codeconscious.com
    Comment: {
        mime-write and mime-read allow to do writes and reads without worrying
        about the type of the file. Of course
    }
]

;
; Support scripts
;

if not :use-script [use-script: :do]   ; Use-script is my script manager
use-script %import-rebol-datatypes.r

;
; Set up some fixed info.
;

; types
mime-type-mapping: [
    text ["text" "html" "cgi" "clb" "css" "js" "r"]
    image ["jpeg" "gif" "png" "bmp"]
]

; equivalences
mime-normalise-list:[
    "htm" "html"
    "txt" "text"
    "jpg" "jpeg"
    "jpe" "jpeg"
]


;
; Support scripts
;

if not :use-script [use-script: :do]   ; Use-script is my script manager
use-script %import-rebol-datatypes.r

;
; An extension of my file object.
;

import-location-with-mime: func [
    location [file! url!]
][
    either equal? type? location file! [
        import-file-with-mime location
    ][
        import-url-with-mime location
    ]
]

import-file-with-mime: function [
    location [file! url!]
] [
    file-object
    the-file
] [
    either equal? type? location url! [
        the-file: to-file get in import-url location 'path
    ][ the-file: location ]

    ; Turn it into an object.
    file-object: make (import-file the-file) [
        mime-type: func[][
            get-mime-for-ext extension
        ]
    ]

    file-object
]

import-url-with-mime: function [
    location [url!]
] [
    url-object
] [
    ; Turn it into an object.
    url-object: make (import-url location) [
        mime-type: func[][
            get-mime-for-ext get in import-file-with-mime location 'extension
        ]
    ]

    url-object
]


;
; Define a function that produces mime like types.
;

get-mime-for-ext: function [
    extension
    ; This function assumes that if there is more than one "." in the
    ; extension then that indicates that the subextension is a special
    ; mime-type Used by this script.
] [mime-ext] [

    ; Translate the extension into a mime type.

    mime-ext: head reverse parse extension "."
    mime-ext: copy/part mime-ext subtract length? mime-ext 1

    ; Normalise odd types.
    foreach [o n] mime-normalise-list [
        if equal? mime-ext/1 o [
            mime-ext/1: n
        ]
    ]

    ;
    ; If mime-ext is one long then it is not one our special mime types
    ; so fill in the correct type.
    ;

    if equal? 1 length? mime-ext [

        foreach [mime-type mime-ext-list] mime-type-mapping [
            if find mime-ext-list mime-ext/1 [
                insert head mime-ext mime-type
                break
            ]
        ]

    ]
    mime-ext: rejoin [mime-ext/1 "/" mime-ext/2]
]

;
; Just checks my mime-types to see if they are text.
; Assumes that if first word is text then the type is binary.
;

IsText-mimetype: func[ mimetype ][
    any [
        equal? mimetype "cgi/r"
        equal? first parse mimetype "/" "text"
    ]
]

mime-write: function [
    "Will write as text or binary according to filename"
    destination [file! url! object!]
    value
][destination-as-object][
    either equal? type? destination object! [
        destination-as-object: destination
    ][
        destination-as-object: import-location-with-mime destination
    ]
    destination-as-object
    either IsText-mimetype destination-as-object/mime-type [
        write destination-as-object/full value
    ][
        write/binary destination-as-object/full value
    ]
]

mime-read: function [
    "Will read as text or binary according to filename"
    source [file! url! object!]
][source-as-object][
    either equal? type? source object! [
        source-as-object: source
    ][
        source-as-object: import-location-with-mime source
    ]
    either IsText-mimetype source-as-object/mime-type [
        read source-as-object/full
    ][
        read/binary source-as-object/full
    ]
]

mime-copy: func[
    "Copy a file from the source to target."
    source [file! url! object!]
    target [file! url! object!]
][mime-write target mime-read source]