REBOL [
Title: "Script Library Builder"
Date: 19-Jul-2001/11:58:12-7:00
Version: 2.4.1
File: %build-lib.r
Author: "Carl Sassenrath"
Purpose: {Builds the REBOL library, including its HTML pages
and compressed archive file, then uploads the files to
the web site. Can also be used for making a local copy
of the library index pages.
}
Email: carl@rebol.com
Category: [web markup net file db 5]
]
;-- Configuration:
verbose: off ; print the details
testing: off ; do all files
stop-on-error: off ; do not continue after error
auto-upload: off ; ask to upload when done
main-dir: %library ; where to put them on web site
site-dir: %www.rebol.com/www/ ; where to put it
html-dir: main-dir/html ; subdir for html files
script-dir: main-dir/scripts ; subdir for script files
index-file: %library.html ; main index file
date-file: %librarydate ; datestamp
arch-file: %library.rip ; archive of all scripts
system/schemes/ftp/timeout: 0:05 ; transfer timeout
system/schemes/ftp/passive: true ; passive mode transfer
new-days: 90 ; days to get a NEW! tag
delay-time: 0 ; (integer) wait this period of time on error
errors: 0
site: none
extras: []
do %color-code.r
print ["Build REBOL Library - Version" system/script/header/version newline]
print ["Building library as of" now]
;-- Create directories, get prior date:
if not exists? main-dir [make-dir main-dir]
if not exists? script-dir [make-dir script-dir]
if not exists? html-dir [make-dir html-dir]
last-date: either all [exists? date-file not testing][load date-file][1-Jan-1900]
;-- Script categories:
Categories: [
; "Popular Downloads" good
"All Scripts" all
"New or Revised" new
"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
]
;-- Primary HTML sections:
make-banner: func [title] [
reduce [{
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2//EN">
<HTML>
<HEAD>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html;CHARSET=iso-8859-1">
<TITLE>REBOL Library - } title {</TITLE>
</HEAD>
<BODY TEXT="#000000" BGCOLOR="white" LINK="#000000" ALINK="#833621" VLINK="#505027" >
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0" WIDTH="100%" BGCOLOR="#000000">
<TR><TD WIDTH="5"> </TD>
<TD><FONT COLOR="white" FACE="arial, helvetica"><B>REBOL Library</B></FONT></TD>
<TD WIDTH="592" ALIGN="RIGHT"><A HREF="http://www.rebol.com"><IMG SRC="rebol-banner.gif" WIDTH="592" HEIGHT="31" ALIGN="BOTTOM" BORDER="0" ALT="REBOL"></A></TD>
</TR>
</TABLE>
<P>
}
]
]
Introduction: [{
<CENTER><B><FONT FACE="arial, helvetica">Library contains } script-count { files - Updated: } now/date {</FONT></B><P>
<P><TABLE BORDER="0" CELLPADDING="4" CELLSPACING="0">
<TR BGCOLOR="#833621">
<TD WIDTH="230"><B><FONT COLOR="white" FACE="arial, helvetica">Category</FONT></B></TD>
<TD><P ALIGN="RIGHT"><B><FONT COLOR="white" FACE="arial, helvetica">#</FONT></B></TD>
<TD><P ALIGN="CENTER"><B><FONT COLOR="white" FACE="arial, helvetica">Updated</FONT></B></TD>
</TR>
}]
Search-part: {
<FORM ACTION="http://demo.rebol.net/cgi-bin/search.r" METHOD="GET">
<INPUT TYPE="HIDDEN" NAME="lib" VALUE="Y">
<P><B><FONT FACE="Arial, Helvetica">Search library:</FONT></B>
<INPUT TYPE="TEXT" NAME="keywords" SIZE="40"><INPUT TYPE="SUBMIT" VALUE="SUBMIT"><FONT FACE="Arial, Helvetica"></FONT><P>
</FORM>
}
Conclusion: [{
<FONT SIZE="2" FACE="Arial, Helvetica">
<B>To add or modify a file, run REBOL/View and click on
the Add-Script icon in the Library folder.</B> Be sure that
the script has a REBOL header that describes its purpose. <P>
<B>You can download the entire library as
} rejoin [{<A HREF="../} main-dir "/" arch-file {">}]
{a compressed, self-extracting REBOL archive</A>.</B> The
file is} to-integer (archive-size / 1024) { KB and requires
REBOL to extract. You may need to right click on this link
to save the file in some browsers. <P>
Once you have extracted the files, you can build these HTML
index pages locally by running the build-lib.r script.<P>
<I>Note: All scripts are provided AS IS without warranty and
without liability to the author or to REBOL Technologies.</I>
</FONT><P>
<FONT SIZE="1" FACE="Arial, Helvetica">REBOL is a trademark of REBOL Technologies.</FONT><P>
}]
;-- Misc helper functions:
error: func [msg /warn] [
print ["*****" reduce msg]
if all [not warn stop-on-error] [halt]
wait delay-time
errors: errors + 1
none
]
out: make string! 10000
emit: func [val /new] [
if new [clear out: head out]
either block? val [
val: reduce val
foreach item val [out: insert out form item]
][out: insert out form val]
]
count-lines: func [str][(length? parse/all mold load str "^/") - 2]
new-suffix: func [file suffix] [
append clear find/last/tail copy file #"." suffix
]
preformat: func ["Format a code example" code name] [
replace/all code "&" "&"
replace/all code "<" "<"
replace/all code ">" ">"
insert code [<html><body><pre>]
append code [</pre></body></html>]
code
]
upload: func [file data /binary] [
either binary [write/binary file data] [write file data]
if site [
print [tab "Uploading:" file]
either binary [write/binary site/:file data] [
write site/:file data
]
]
]
;-- Build a list of all scripts and verify their headers.
print "Analyzing all script files..."
scripts: make block! 1000
popular: either exists? %popular.txt [load %popular.txt][[]]
foreach file load %. [
if not dir? file [
if verbose [print ["Examining:" file]]
msg: none
if not all [ ; verify the script and header
%.r = find/last file %.r
msg: "Cannot read header of:"
script? file
not error? try [data: read file]
not error? try [header: first load/next/header data]
result: true
foreach item [title category][
if not all [in header item series? header/:item not empty? header/:item][
msg: reform ["Problem in" item "field of:"]
result: false
]
result
]
not if not all [in header 'purpose string? header/purpose] [
print ["*****" file "is missing its purpose"]
header/purpose: copy header/title
none
]
msg: join "Invalid category " mold grp: exclude header/category categories
empty? grp
msg: "Bad date in:"
in header 'date
date? header/date
header/date > 1-Jan-1997
header/date < (now + 2)
msg: "Wrong filename in:"
header/file = file
msg: 0
lines: count-lines data
do [
if (now - header/date) < new-days [
append header/title { - <font color="red">Recent!</font>}
append header/category 'new
]
append header/category 'all
if find popular file [append header/category 'good]
repend scripts [lines file header data]
]
][if string? msg [error [msg file]]]
]
]
script-count: (length? scripts) / 4
sort/skip scripts 4
print [script-count "script files qualified"]
;-- Create archive file:
print "Creating compressed library archive..."
system/options/binary-base: 64
archive: make binary! 128 * 1024
file-list: make block! script-count * 2
foreach [lines file header data] scripts [
append archive data: compress data
append file-list reduce [file length? data]
]
foreach file extras [
append archive data: compress read/binary file
append file-list reduce [file length? data]
]
header: mold compose/deep [
REBOL [
Title: "REBOL Script Library Binary Archive"
Date: (now)
File: (arch-file)
Note: (reform [{To extract, type REBOL} arch-file {or run REBOL and type: do} arch-file])
]
file: (arch-file)
size: (length? archive)
path: (main-dir)
files: (reduce [file-list])
check: (checksum archive)
if not exists? path [make-dir path]
archive: read/binary file
archive: next find/case/tail archive to-binary join "!DATA" ":"
if check <> checksum archive [print ["Checksum failed" check checksum archive] halt]
print "Reviving:"
foreach [file len] files [
print [tab file]
data: decompress copy/part archive len
archive: skip archive len
write/binary path/:file data
]
none
]
archive-size: length? archive
print ["Archive size:" archive-size]
insert archive reduce [header newline "!DATA:" newline]
;-- Should files be uploaded?
if all [auto-upload confirm rejoin ["Upload files to " site-dir "? (y/N) "]] [
user: pass: none
if exists? %userpass [do load %userpass]
user: any [user ask "Site Login: "]
pass: any [pass ask/hide "Site Password: "]
if not any [empty? user empty? pass] [
site: join ftp:// [user ":" pass "@" site-dir]
]
]
upload/binary main-dir/:arch-file archive
;-- Sort main index:
hold: copy/part categories 4
remove/part categories 4
hold2: copy tmp: find categories "Very Simple"
clear tmp
sort/skip categories 2
insert categories hold
append categories hold2
;-- Generate main index page:
print "Creating HTML index pages..."
emit/new [make-banner "Main Index" reduce introduction]
foreach [title cat] categories [
lib-file: rejoin [%script- cat ".html"]
most-recent: 1-jan-1900
count: 0
foreach [lines file header data] scripts [
if find header/category cat [
if header/date > most-recent [most-recent: header/date]
count: count + 1
]
]
emit [{
<TR>
<TD><A HREF="} lib-file {">
<FONT FACE="Arial, Helvetica"><B>} title {</B></FONT></A></TD>
<TD ALIGN="RIGHT"><FONT SIZE="2" FACE="Arial, Helvetica">} count {</FONT></TD>
<TD ALIGN="RIGHT"><FONT SIZE="2" FACE="Arial, Helvetica">} most-recent/date {</FONT></TD>
</TR>
}]
]
emit [</TABLE></CENTER><P> conclusion: reduce conclusion </BODY></HTML>]
upload main-dir/:index-file head out
;-- Generate category pages:
emit-category: func [cat title] [
lib-file: rejoin [%script- cat ".html"]
emit/new [
make-banner title
{<H3><FONT FACE="arial,helvetica">} title {</FONT></H3>
<FONT SIZE="2" FACE="arial,helvetica">
<BLOCKQUOTE><B>Updated: } now/date {</B>
<P><A HREF="} index-file {">Return to main library index</A>
</BLOCKQUOTE></FONT><P>
<TABLE BORDER="0" CELLPADDING="3" CELLSPACING="0" WIDTH="90%">}
]
foreach [lines file header data] scripts [
if find header/category cat [
html-file: new-suffix file "html"
lineword: either lines == 1 [" line"][" lines"]
if lines > 120 [lines: to-integer (lines / 60) lineword: " pages"]
emit [{
<TR>
<TD BGCOLOR="#E3E9E2"><B><A HREF="../} html-dir/:html-file
{"><FONT FACE="Arial, Helvetica">} header/title {</FONT></A></B></TD>
<TD WIDTH="120" BGCOLOR="#E3E9E2">
<P ALIGN="CENTER"><TT><A HREF="../} script-dir/:file
{"><B>} file {</B></A></TT>
</TD>
<TD WIDTH="108" BGCOLOR="#E3E9E2">
<P ALIGN="CENTER"><TT>} header/date/date {</TT>
</TD>
</TR>
<TR VALIGN="TOP">
<TD ><FONT SIZE="2" FACE="Arial, Helvetica">} header/purpose {</FONT></TD>
<TD><P ALIGN="CENTER"><TT>} lines lineword {</TT></TD>
<TD><P ALIGN="CENTER"><TT>} length? data { bytes </TT></TD>
</TR>
<TR><TD COLSPAN="3"> </TD></TR>
}]
]
]
emit [{
<TR><TD COLSPAN="3"></TD></TR>
</TABLE> <P><HR><FONT SIZE="2" FACE="Arial, Helvetica"><i>
The line count is for code lines only and is used as a rough
estimate of code size. It does not include script
headers, blank lines, or comment lines.</i></FONT><p>
} conclusion {
<P></BODY></HTML>
}]
upload main-dir/:lib-file head out
]
foreach [title cat] categories [emit-category cat title]
;-- Save REBOL banner:
either error? try [do %bin-data.r] [error "Could not decode banner graphic." none][
upload/binary main-dir/rebol-banner.gif read/binary %banner.gif
]
;-- Upload script files:
print "Colorizing and storing scripts..."
foreach [lines file header data] scripts [
if greater? modified? file last-date [
detabbed: detab data
upload script-dir/:file detabbed
if site [
if (checksum detabbed) <> checksum read site/:script-dir/:file [
error ["FTP upload error in:" file]
]
]
html-file: new-suffix file "html"
if error? try [
htmled: color-code detabbed
][ ; (avoid bug in load/next)
error ["Could not colorize:" file]
htmled: preformat detabbed file
]
insert find/tail htmled ">" reduce ["<title>Script: " file "</title>"]
upload html-dir/:html-file htmled
if site [
if (checksum htmled) <> checksum read site/:html-dir/:html-file [
error ["FTP upload error in:" html-file]
]
]
]
]
if site [save date-file now]
print [newline "Build complete. Library index is in" main-dir/:index-file]
;browse main-dir/:index-file
either errors > 0 [ask reform [errors "warnings (Press a key to quit.)"]][wait 2]