REBOL [
	Title: { Upload library-script - upload a script to rebol.org}
	File: %upload-library-script.r
	Date: 15-Jul-2004
	Purpose: "  upload a script to rebol.org  "
	Usage: {
		Request a token on
		http://www.rebol.org/cgi-bin/cgiwrap/rebol/lds-library-tokens.r
		Read your email.
		Paste it when this script asks. (note the token is stored on disk then).
		Select your upload-script in requester.
		Upload and edit header until it "upload" says ok.
	}
	Version: 1.1.1
	Author: "Volker Nitsch"
	History: [
		1.1.2  "added upload-note-field"
		1.1.1  "%validate-script.r now fixed for external download"
		1.1.0  "Faster local check, auto-update"
		1.0.0  "Usable to upload scripts to rebol.org"
	]
	Credits: [
		{Sunanda for lds, the header-checker and explanations}
	]
	Library: [
		level: 'intermediate
		platform: 'all
		type: tool
		domain: [file-handling gui other-net vid web]
		tested-under: none
		support: none
		license: GPL
		see-also: none
	]]


print "-uploaders console for logging-"


rebol []

???: func ['word value] [;Volker
	print [mold :word mold :value]
	set :word :value
]

; /link lacks it.
if not value? 'construct [
	construct: func [block /with object] [
		make either object [object] [object!]
		disinfect block
	]
]

; [context disinfect block] is like construct
; check i all?
disinfect: func [; by Volker
	"removes values which could be executed by make. only top-level"
	block
	/local value hot word out
] [
	out: copy []
	parse block [any [
			set word ['none | 'true | 'false] (
				append out get in system/words word
			)
			|
			set word [word! | lit-word!] (append out to-lit-word word) ;grrr
			|
			set hot [get-word! | paren!
				| path! | set-path!
			] ;(probe :hot)
			|
			set value any-type! (append/only out value)
		]]
	out
]


rebol []

config: any [
	attempt [construct load config-file: %lds-config-d.txt]
	[]
]
config: make context [
	upload-file: none
	files: copy []
	filters: none
] config

save-config: does [
	save/all config-file third config
]



rebol []

modules: [
	http://www.rebol.org/library/public/ %lds-local.r
	http://www.rebol.org/library/public/ %validate-script.r
]

download-lds: does [
	foreach [url file] modules [
		load-thru/to join url file file
		do file
	]
	if not config/filters [
		res2: lds/send-server 'list-search-filters []
		config/filters: res2/data
		save-config
	]

]

download-lds
library-tags: config/filters

update-me: does [
	if confirm "checking for updates?" [
		flash "downloading"
		foreach [url file] modules [
			attempt [delete file]
		]
		config/filters: none
		save-config
		download-lds
		probe
		load-thru/update/to join http://www.rebol.org/library/scripts-download/
		???
		file: %upload-library-script.r file
		unview
		alert "Script fresh downloaded. Now restart script."
	]
]


rebol [title: "support for tokens"]

token-file: %lds-library-token.txt

if not all [
	exists? file: token-file
] [
	inform layout [
		backdrop gray
		across title "Enter library-token"
		text "(kind of rebol-cooky)"
		below
		text 400 trim system/script/header/usage as-is
		button "get token" [
			browse http://www.rebol.org/cgi-bin/cgiwrap/rebol/lds-library-tokens.r
		]
		pad 0x5
		label join {paste token, or write it directly to } file
		f-token: area
		across
		button "OK" [hide-popup token: if "" <> s: f-token/text [s]]
		button "Cancel" [quit]
	]
	if all [not token not exists? file] [quit]
	if token [write file token]
]

delete-bad-token: does [
	delete token-file
	alert "bad token - get a new one, restart script!"
	quit
]
if not attempt [
	token: decompress first load/all read token-file
	set [token-owner token-id] parse token "/"
] [
	delete-bad-token
]






rebol [title: "checking and uploading"]

upload: func [scr note /really] [

	lds/send-server/use-token 'contribute-script compose [
		mode (either not really ["check"] ["update"])
		note (note) script (scr)
	]

]

quick-check: does [
	res: validate-script/from-local f-script/text library-tags
	res: make context [revised-script: ""] res
	either empty? res/error-messages [
		show-check-result join "Local reply: "
		msg: "Looking good. You should check online" reduce ["upload" msg] ""
	] [
		show-check-result "Local reply: Problems with script"
		res/error-messages res/revised-script
	]
]
show-check-result: func [why msg-blk revised /local proposals tags lib-hdr msg] [
	proposals: [
		"title" [probe mold rejoin [" - " mold second split-path file " - " now]]
		"file" [mold second split-path file]
		"date" [mold now]
		"purpose" [mold "  Please edit me!  "]
		"lib-head" [
			lib-hdr: second load/all revised
			lib-hdr: select lib-hdr [library:]
			mold lib-hdr
		]
	]
	msg: copy ""
	foreach [field help] msg-blk [
		proposal: switch/default field proposals [
			mold '?
		]
		if "lib-head" = field [field: "library"] ;patch
		tags: either find first library-tags w: to-word field [
			rejoin ["" newline "; " mold library-tags/:w]
		] [""]
		repend msg [
			"; " help tags newline
			newline uppercase/part field 1 ": " proposal
			newline newline]
	]
	f-status/text: uppercase/part why 1
	f-comment/text: msg f-comment/line-list: none
	show lay
	alert why
]
upload-lay-content: has [res revised w] [
	flash join "checking " mold file
	res: upload scr f-note/text
	unview
	any [
		if res/status = [810 40 "bad token"] [
			delete-bad-token
		]
		if [210 30 "problems with script"] = res/status [
			revised: either w: in res/data 'revised-script [decompress get w] [copy ""]
			show-check-result join "Server-reply: " res/status/3 res/data/validation revised

		]
		if any [
			[0 10 {Looking good. Use mode update to add the new script}] = res/status
			[0 10 "Looking good. Use mode update to update the script"] = res/status
		] [
			if confirm third res/status [
				flash join "really uploading " mold file
				???
				res: upload/really f-script/text f-note/text
				unview
				alert join "real upload: " mold res/status
			]
		]
	]
]
save-lay: does [
	if f-script/text <> read file [
		write file f-script/text
	]
]
if file: request-file/only/title/file "script to upload?" "Edit" config/upload-file [
	config/upload-file: file
	save-config
	scr: read file
	lay: layout [
		backdrop gray
		title 620 "Upload this file to rebol.org?" left
		across f-status: h1 "No replies yet:" 500 left
		below
		across f-comment: area 620x180 wrap silver
		slider 16x180 [scroll-para f-comment face]
		below
		across h1 "With script: " text mold file
		below
		across f-script: area 620x180 scr wrap font-name font-fixed
		slider 16x180 [scroll-para f-script face]
		below
		across label "Why upload?" f-note: field 500
		below
		across label "token-id" text mold token-id
		label "token-owner" text mold token-owner
		below
		across
		button "quit" [quit]
		button "save&check&upload" [save-lay upload-lay-content] 150
		button "save" [save-lay]
		button "save&quick check" [save-lay quick-check] 150
		button "update me" [update-me]
	]
	attempt [quick-check]
	view lay
]