REBOL [
    Title: "Internet Message Model"
    Author: "Brett Handley"
    Date: 18-Jan-2002
    Version: 0.9.3
    Purpose: "Faciliates manipulation of messages - primarily email."
    Comment: {
    }
    History: [
        0.9.3 [18-Jan-2002 "Added function netmsg-block. to-netmsg will default the content-type header to text/plain if none exists." "Brett Handley"]
        0.9.2 [17-Jan-2002 "Added functions to-netmsg, uublock-to-mime. to-netmsg is preferred." "Brett Handley"]
        0.9.1 [17-Jan-2002 "Changed import-netmsg to always try to return an object." "Brett Handley"]
        0.9.0 [16-June-2001 "Initial version." "Brett Handley"]
    ]
    Rights: {Copyright (c) Brett Handley 2001

Permission is hereby granted, free of charge, to any person obtaining a
copy of this software and associated documentation files (the "Software"),
to deal in the Software without restriction, including without limitation
the rights to use, copy, modify, merge, publish, distribute, subrights,
and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included
in all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.}
]

; Use-script is my local script manager.
; Define it if we are in another environment.
; Use-script is my local script manager.
; Define it if we are in another environment.
if not value? 'use-script [
    either value? 'load-thru [
        use-script: func[script][do load-thru join http://www.codeconscious.com/rebsite/rebol-library/ script]
    ][use-script: :do]
]

; Supporting Code
use-script %mime-model.r

;
; Now on to the functions.

to-netmsg: function [
    "Loads an internet message (e.g. mail) with attachments."
    message [string! object!]
][msg][
    msg: msg-as-object message
    RETURN any [
        if mime-message? msg [ RETURN mime-structure? msg ]
        if uuencoding? msg/content [make msg uublock-to-mime uudecode msg/content]
        either in msg 'content-type [msg][make msg [content-type: "text/plain"]]
    ]
]

netmsg-block: function [
    "Returns a flattened structure representing the parts of the message."
    message [object!]
][result][
    either mime-multipart? message [
        result: copy []
        for i 1 length? message/content 1 [
            append result netmsg-block message/content/:i
        ]
    ][result: reduce [ message/content-type mime-filename? message :message/content] ]
    RETURN result
]



; Left for backward compatability - see to-netmsg
import-netmsg: function [
    "Loads an internet message (e.g. mail) with attachments. (Old behaviour)"
    message [string! object!]
][msg][
    msg: msg-as-object message
    RETURN any [
        either mime-message? msg [ RETURN mime-structure? msg ][none]
        either uuencoding? msg/content [ msg/content: uudecode msg/content RETURN msg][none]
        msg
    ]
]

uublock-to-mime: function [
    "Converts the block as returned from uudecode to a mime entity."
    uublock [block!]
][result atch emit emit-plain emit-attachment][

    emit-plain: function[text][entity][
        append result context [
            content-type: copy "text/plain; charset=us-ascii"
            content: first text
        ]
    ]

    emit-attachment: function[name value][entity][
        append result context [
            content-type: join guess-mime-type name value [{; name="} name {"}]
            content: :value
            content-disposition: join {attachment; filename="} [name {"}]
        ]
    ]

    either parse uublock [
        (result: copy [])
        any [
            copy text string! (emit-plain text)|
            copy atch [file! any-type!] (emit-attachment atch/1 atch/2)
        ]
    ][
        RETURN either equal? length? result 1 [
            first result
        ][
            context [
                content-type: copy "multipart/mixed"
                content: :result
            ]
        ]
    ][RETURN none]
]

uuencoded-attachments?: function [
    "Returns uuencoded attachments as filename filedata pairs in a block."
    message [string!]
    /typing "Include a default mime type."
    /local result attachment
][
    ; Puts the mime-type for unrecogised types in - application or user can decide.
    ; Technically though, this would be erroneous if it were actually a text file -
    ; because we have already done line conversion. But it is the best I can do because
    ; I do not know what type it actually is.
    if parse uudecode message [
        (result: copy [])
        any [
            string! |
            copy attachment [file! any-type!] (
                if typing [ insert next attachment "application/octet-stream" ]
                insert tail result attachment
            )
        ]
    ][result]
]

attachments?: function [
    "Returns the attachments in an internet message (e.g. mail) some [filename mime-type data]"
    message [string! object!]
    /local msg
][
    msg: msg-as-object message
    RETURN any [
        either mime-message? msg [ RETURN mime-named-attachments?/typing mime-structure? msg ][none]
        either uuencoding? msg/content [ RETURN uuencoded-attachments?/typing msg/content ][none]
    ]
]