REBOL [
    Title: "Submit to Script Library"
    Date: 26-Mar-2002
    Version: 1.0.5
    File: %add-script-offline.r
    Author: "Carl Sassenrath, Oldes"
    Purpose: "Submits a script to the script library."
    Comment: {Oldes: This script was already in the library but Carl replaced it again with it's older version (even older than the one I was using - 1.0.2). He probably doesn't like this modification, but I don't like messages as "You cannot do something, becasue...". Some people still have to use dialup connections and pay for every second! Why don't prepare the upload offline!
^-And another thing: people in Rebol probably don't think that on one script may work more people, because there is posibility to fill only one email (author) - that seems to be silly!
^-That reminds me, that some better library with access to older version would be useful.}
    History: [
    1.0.5 {Oldes: renamed from add-script to add-script-offline.r} 
    1.0.4 "Oldes: added offline possibility" 
    1.0.3 "Carl's latest version"
]
    Email: carl@rebol.com
    Category: [cgi util ldc 4]
]

categories: [
    "Email Related"             email   
    "Web Related"               web     
    "CGI Related"               cgi     
    "HTML/XML Related"          markup  
    "FTP Related"               ftp     
    "Network Related"           net     
    "TCP/Network Related"       tcp     
    "Distributed Computing"     ldc

    "View Related"              view    
    "VID Visual Interface"      vid     

    "Scripting Style"           script  
    "Tutorial Scripts"          tutor   

    "File I/O Related"          file    
    "Text-Processing"           text    
    "Database Related"          db      
    "Encryption Related"        crypt
    "External Library"          lib
    "Shell Access"              shell
    "Math Related"              math    
    "Utility Functions"         util    
    "General Example"           misc    
    "Game Related"              game
    "Sound Related"             sound
    "Compression Related"       compress    

    "[Very Simple]"         1       
    "[Beginner Level]"      2       
    "[Moderate Level]"      3       
    "[Advanced Level]"      4       
    "[Guru Level]"          5       
]

sort/skip categories 2

off-data-file:  %add-script-data.rb ;Oldes: where to save offline data

field-types: [
    f-title   title   [string!]
    f-author  author  [string!]
    f-date    date    [date!]
    f-vers    version [tuple!]
    f-file    file    [file!]
    f-purpose purpose [string!]
    f-email   email   [email!]
    f-web     web     [url!]
]

tell: func [str] [stat/text: str  show stat]

set-field: func [face 'fld /local val typ] [
    types: select field-types fld
    foreach type types [
        if find [string! file!] type [
            set in hdr fld to get type face/text
            check-all
            exit
        ]
        if not error? try [val: load face/text][
            if type = type?/word val [
                set in hdr fld val
                check-all
                exit
            ]
        ]
    ]
    set in hdr fld none
    tell reform [fld "must be of" types "format"]
    err-label face true
]

init: does [
cats: []
cnt: 0
lo: center-face layout [
    style label label 80x24 right
    style field field 300 
    space 4x8
    across
    label "Script:" button 300 "Open and Examine File" [
        file: request-file/keep
        if all [file file/1] [certify first file]
    ]
    return
    space 4x0
    label "Title:"    f-title:  field [set-field face title] return
    label "Author:"   f-author: field [set-field face author] return
    label "Date:"     f-date:   field [set-field face date] return
    label "Version:"  f-vers:   field [set-field face version] return
    label "File:"     f-file:   field [set-field face file] return
    label "Purpose:"  f-purpose: field 300x74 wrap [set-field face purpose] return
    label "Optional Fields (Useful for feedback):" 340 left yellow return
    label "Email:"    f-email:  field [set-field face email] return
    label "Web URL:"  f-web:    field [set-field face web] return

    space 0

    at f-title/offset + 310x0
    guide
    sc: text bold white black 176 "Categories" return
    cl: list 160x174 [
        space 0
        text 160x16 font [colors: [0.0.0 130.130.130]] [alter cats word]
    ] supply [
        count: count + cnt
        face/text: face/color: none
        if count * 2 > length? categories [return none]
        set [name word] at categories count * 2 - 1
        face/text: name
        face/color: if find cats word [yellow]
    ]
    sl: slider cl/size * 0x1 + 16x0 [
        c: to-integer value * ((length? categories) / 2 - 8)
        if cnt <> c [cnt: c  show cl]
    ]
    return

    pad 0x20
    stat: text 160x30 red black "error window" font-size 10 return
    button 80 "Submit" [submit-script]
    button 80 "Close" [quit]
]
];end of init
init

err-label: func [face state] [
    face: first back find lo/pane face
    face/color: either state [180.0.0][none]
    show face
]

check-type: func [face word types /local var] [
    var: all [var: in hdr word  get var]
    if all [any-string? var empty? var] [var: none]
    either all [var find types type?/word var] [
        face/text: form var
        err-label face none
    ][  ;print word
        if negative? offset? find field-types 'email find field-types word [
            if not stat/text [stat/text: reform [word "needs" types]]
        ]
        err-label face true
    ]
]

check-all: does [
    stat/text: none
    foreach [face fld type] field-types [check-type get face fld type]
    cats: hdr/category
    sc/color: black
    if all [not stat/text empty? cats][
        sc/color: 180.0.0
        stat/text: "select script categories"
    ]
    show lo
    not stat/text
]

certify: func [file /local msg] [
    msg: none
    either all [  ; verify the script and header
        msg: "File not found"
        exists? file
        msg: "REBOL header not found"
        script? file
        msg: "File cannot be loaded"
        not error? try [set [hdr src] load/header/next file]
        msg: "Invalid header block"
        hdr: make context [Email: none Web: none Category: copy []] hdr
        not error? try [hdr: make system/standard/script hdr]
    ][
        if string? hdr/purpose [trim/auto hdr/purpose]
        if none? hdr/date [hdr/date: now]
        if none? hdr/author [hdr/author: user-prefs/name]
        if none? hdr/file [hdr/file: second split-path file]
        if none? hdr/version [hdr/version: 1.0.0]
        if none? hdr/email [hdr/email: system/user/email]
        check-all
    ][
        alert join "Error: " msg
    ]

]

out-head: has [val str] [
    str: make string! 4096
    repend str "REBOL [^/"
    foreach fld next first hdr [
        val: get in hdr fld
        if val [
            repend str [tab fld ": " detab mold val newline]
        ]
    ]
    repend str ["]" src]
    
    
    flash "Uploading..."
    msg: "Cannot access library server."
    either error? try [
        parse str [any [thru "^J" (append str " ")]]  ; Yuk. Accounts for bug in HTTP POST function.
        ;probe str
        msg: read/custom http://www.reboltech.com/cgi/rebol/post-script.r reduce ['post str]
        ;probe msg
        msg: trim/lines msg
    ][
        unview
        alert reform ["Error on upload:" msg "If you are not connected to the Internet, the script will be uploaded later."]
        offline-save str
        clear-fields
    ][
        unview
        either msg <> "ok" [alert join "Script rejected: " msg][
            alert "Your script has been posted to the library." quit
        ]
    ]
]

submit-script: does [
    either check-all [out-head][alert "Cannot submit with missing or invalid fields."]
]

clear-fields: func[][
    hdr: make system/standard/script [Email: none Web: none Category: copy []]
    init
    view lo
]

offline-save: func[str /local off-data][
    str: compress str
    system/options/binary-base: 64
    off-data: either exists? off-data-file [load off-data-file][make block! []]
    file: either block? file [first file][file]
    either found? f: find/tail off-data file [
        poke off-data (index? f) str
    ][  repend off-data [file str]]
    save off-data-file off-data
]
offline-send: func[/local tmp msg off-data][
    either exists? off-data-file [off-data: load off-data-file][return]
    tmp: length? off-data
    while [not tail? off-data] [
        flash rejoin ["Uploading..." off-data/1]
        either error? try [
            msg: read/custom http://www.reboltech.com/cgi/rebol/post-script.r reduce ['post decompress off-data/2]
            msg: trim/lines msg
        ][
            off-data: skip off-data 2
        ][
            either msg <> "ok" [alert reform ["Script" off-data/1 "rejected:" msg]][
                alert "Your script has been posted to the library."
            ]
            remove/part off-data 2 ;the script is removed even if it's rejected!!
        ]
        unview
    ]
    off-data: head off-data
    if tmp <> length? off-data [save off-data-file off-data]
]

;if not connected? [alert "Must be connected to the Internet to add a script." quit]
;No, I want to prepare the upload offline!...
if connected? [offline-send]
;...and send them after connection:)

view lo