/* OS/2 REXX: Create XML sitemaps for search engines in the form */
/* specified by . */
/* sitemap.xml is a list of the two sitemaps files (new and old) */
/* sitenew.xml lists files modified after YYYY-12-31 */
/* siteold.xml lists files up to YYYY-12-31 for YYYY = year - 3 */
/* .site???.xml are 3 temporary versions (deleted if unchanged) */
/* This version of the script assumes that file names consist of */
/* US-ASCII letters, digits, '-' (hyphen), '_' (underscore), and */
/* dots. Files starting with a dot are silently ignored, this is */
/* the same logic as for ftpsynch.cmd and dir2html.cmd, see also */
/* */
/* Configure the following two variables manually for your site: */
/* ROOT is the root of a subdirectory tree with all listed files */
/* BASE is the base URL of the site (without a slash at the end) */
ROOT = 'd:\Inetpub\ftproot'
BASE = 'http://omniplex.om.funpic.de'
signal on novalue name TRAP ; signal on syntax name TRAP
signal on failure name TRAP ; signal on halt name TRAP
call UTIL 'SysFileTree' ; call UTIL 'SysSleep'
call SysSleep 1 ; SEP = '\'
THIS = directory() ; PATH = ROOT
ROOT = directory( PATH ) ; THIS = directory( THIS )
YYYY = left( date( 'S' ), 4 ) - 3
SMSD = 'http://www.sitemaps.org/schemas/sitemap/0.9'
SMUS = 'xmlns:use="http://www.w3.org/2001/XMLSchema-instance"'
SMUS = SMUS 'use:schemaLocation="' || SMSD
SMSI = 'xmlns="' || SMSD || '"' SMUS SMSD || '/siteindex.xsd"'
SMUS = 'xmlns="' || SMSD || '"' SMUS SMSD || '/sitemap.xsd"'
PURL = 'http://purl.net/xyzzy/src/sitemap.cmd 0.5'
if ROOT = '' then exit TRAP( PATH 'not found' )
if right( ROOT, 1 ) <> SEP then ROOT = ROOT || SEP
RLEN = 1 + length( ROOT ) ; SHY = '**-*-'
if SysFileTree( ROOT || '*', 'TREE', 'FSL', SHY ) <> 0
then TREE.0 = 0 /* ignore system or hidden files */
if TREE.0 = 0 then exit TRAP( 'SysFileTree error' ROOT || '*' )
MAP.1 = 'sitenew.xml' /* sitemap of new files */
MAP.2 = 'siteold.xml' /* sitemap of old files */
MAP.3 = 'sitemap.xml' /* list of sitemaps 1+2 */
do M = 1 to 3
TMP.M = ROOT || . || MAP.M
OUT.M = ROOT || MAP.M
call XDEL TMP.M
call lineout TMP.M, ''
call lineout TMP.M, ''
if M = 3 then call lineout TMP.M, ''
else call lineout TMP.M, ''
end M
PATH.0 = KWIK( 'TREE.' )
do N = 1 to PATH.0
X = TREE.0 + 1 - N ; PATH.N = TREE.X
end N
do N = 1 to PATH.0
parse var PATH.N DATE TIME SIZE ATTR PATH
PATH = translate( substr( PATH, RLEN ), '/', SEP )
if sign( pos( '/.', PATH )) then iterate N
do M = 1 to 3 /* skip dot and sitemap files... */
if PATH == '/' || MAP.M then iterate N
end M /* ...accept alphanum and '/.-_' */
if PATH = '' then do
say 'sitemap ignored access error for "' || PATH.N || '"'
iterate N /* obscure bug, not yet analyzed */
end
if datatype( translate( PATH, , '/.-_', 0 ), 'A' ) = 0
then exit TRAP( 'unsupported char.s in "' || PATH || '"' )
M = 1 + ( DATE <= YYYY || '-12-31' )
X = '' BASE || PATH ''
call lineout TMP.M, X
X = '' DATE ''
call lineout TMP.M, X
end N
SAME = 1
do M = 1 to 2
call lineout TMP.M, ''
call lineout TMP.M
X = sign( lines( TMP.M ))
do while X & sign( lines( OUT.M ))
X = ( linein( OUT.M ) = linein( TMP.M ))
X = X & ( lines( OUT.M ) = lines( TMP.M ))
end
call lineout OUT.M ; call lineout TMP.M
if X then do
call XDEL TMP.M
say 'checking' OUT.M
end
else do
call MOVE TMP.M, OUT.M
say 'new file' OUT.M
SAME = 0
end
DATE = word( stream( OUT.M, 'c', 'q timestamp' ), 1 )
X = '' BASE || '/' || MAP.M ''
call lineout TMP.3, X
X = '' DATE ''
call lineout TMP.3, X
end M
call lineout TMP.3, ''
call lineout TMP.3
if SAME then call XDEL TMP.3
else do
call MOVE TMP.3, OUT.3
say 'new file' OUT.3
end
exit 0
MOVE: procedure /* non-portable W2K or OS/2 move */
parse arg SRC, DST ; QUIET = '> NUL 2>&1'
address CMD '@copy "' || SRC || '" "' || DST || '"' QUIET
if rc = 0 then return XDEL( SRC ) ; else return 1
/* see , (c) F. Ellermann */
XDEL: procedure /* semi-portable SysFileDelete() */
parse source KEY . . /* assuming ooREXX for WindowsNT */
if KEY = 'OS/2' | KEY = 'WindowsNT' then do
call UTIL 'SysFileDelete'
return SysFileDelete( arg( 1 )) <> 0 /* 0: okay, 1: error */
end
parse version KEY . .
if KEY = 'REXXSAA'
then return RxDelete( arg( 1 )) <> 0 /* 0: okay, 1: error */
else return DosDel( arg( 1 )) == 0 /* 0: okay, 1: error */
KWIK: /* quick sort: call KWIK 'stem.' */
if arg() <> 1 then return abs( /* REXX error 40 */ )
THIS... = arg( 1 ) /* abuse global THIS... as stem */
if right( THIS... , 1 ) <> . then THIS... = THIS... || .
return KWIK.Y( THIS... ) /* expose THIS... stem */
KWIK.Y: procedure expose ( THIS... )
S = 1 ; SL.1 = 1 ; SR.1 = value( THIS... || 0 )
do until S = 0
L = SL.S ; R = SR.S ; S = S - 1 /* pop */
do while L < R
I = ( L + R ) % 2 ; P = value( THIS... || L )
XR = value( THIS... || R )
if XR << P then do /* R...L */
call value THIS... || R, P
call value THIS... || L, XR ; P = XR
end /* L...R */
XI = value( THIS... || I )
XR = value( THIS... || R )
select
when XI << P then do /* I L R */
call value THIS... || I, P
call value THIS... || L, XI
end /* L I R */
when XI >> XR then do /* L R I */
call value THIS... || R, XI
call value THIS... || I, XR ; P = XR
end /* L I R */
otherwise P = XI /* L I R */
end
I = L + 1 ; J = R - 1 /* I...J */
if J <= I then leave /* ready */
do until I > J
do while value( THIS... || I ) << P ; I = I+1 ; end
do while value( THIS... || J ) >> P ; J = J-1 ; end
if I <= J then do
XI = value( THIS... || I )
call value THIS... || I, value( THIS... || J, XI )
I = I + 1 ; J = J - 1
end
end /* I > J */
if J - L < R - I then do /* less left keys */
S = S + 1 ; SL.S = I ; SR.S = R ; R = J
end /* pushed old R - I > 1 keys, now do L */
else do /* more left keys */
S = S + 1 ; SL.S = L ; SR.S = J ; L = I
end /* pushed J - old L > 1 keys, now do R */
end /* R <= L */
end /* S == 0 */
return value( THIS... || 0 )
UTIL: procedure /* load necessary RexxUtil entry */
if RxFuncQuery( arg( 1 )) then
if RxFuncAdd( arg( 1 ), 'RexxUtil', arg( 1 )) then
exit TRAP( "can't add RexxUtil" arg( 1 ))
return 0
TRAP: /* select REXX exception handler */
call trace 'O' ; trace N /* don't trace interactive */
parse source TRAP /* source on separate line */
TRAP = x2c( 0D ) || right( '+++', 10 ) TRAP || x2c( 0D0A )
TRAP = TRAP || right( '+++', 10 ) /* = standard trace prefix */
TRAP = TRAP strip( condition( 'c' ) 'trap:' condition( 'd' ))
select
when wordpos( condition( 'c' ), 'ERROR FAILURE' ) > 0 then do
if condition( 'd' ) > '' /* need an additional line */
then TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
TRAP = TRAP '(RC' rc || ')' /* any system error codes */
if condition( 'c' ) = 'FAILURE' then rc = -3
end
when wordpos( condition( 'c' ), 'HALT SYNTAX' ) > 0 then do
if condition( 'c' ) = 'HALT' then rc = 4
if condition( 'd' ) > '' & condition( 'd' ) <> rc then do
if condition( 'd' ) <> errortext( rc ) then do
TRAP = TRAP || x2c( 0D0A ) || right( '+++', 10 )
TRAP = TRAP errortext( rc )
end /* future condition( 'd' ) */
end /* may use errortext( rc ) */
else TRAP = TRAP errortext( rc )
rc = -rc /* rc < 0: REXX error code */
end
when condition( 'c' ) = 'NOVALUE' then rc = -2 /* dubious */
when condition( 'c' ) = 'NOTREADY' then rc = -1 /* dubious */
otherwise /* force non-zero whole rc */
if datatype( value( 'RC' ), 'W' ) = 0 then rc = 1
if rc = 0 then rc = 1
if condition() = '' then TRAP = TRAP arg( 1 )
end /* direct: TRAP( message ) */
TRAP = TRAP || x2c( 0D0A ) || format( sigl, 6 )
signal on syntax name TRAP.SIGL /* throw syntax error 3... */
if 0 < sigl & sigl <= sourceline() /* if no handle for source */
then TRAP = TRAP '*-*' strip( sourceline( sigl ))
else TRAP = TRAP '+++ (source line unavailable)'
TRAP.SIGL: /* ...catch syntax error 3 */
if abbrev( right( TRAP, 2 + 6 ), x2c( 0D0A )) then do
TRAP = TRAP '+++ (source line unreadable)' ; rc = -rc
end
select
when 0 then do /* in pipes STDERR: output */
parse version TRAP.REXX /* REXX/Personal: \dev\con */
if abbrev( TRAP.REXX, 'REXXSAA ' ) | /**/ ,
6 <= word( TRAP.REXX, 2 ) then TRAP.REXX = 'STDERR'
else TRAP.REXX = '\dev\con'
signal on syntax name TRAP.FAIL
call lineout TRAP.REXX , TRAP /* fails if no more handle */
end
when 0 then do /* OS/2 PM or ooREXX on NT */
signal on syntax name TRAP.FAIL
call RxMessageBox translate( TRAP, ' ', x2c( 0D )), /**/ ,
'Trap' time(),, 'ERROR'
end
otherwise say TRAP ; trace ?L /* interactive Label trace */
end
if condition() = 'SIGNAL' then signal TRAP.EXIT
TRAP.CALL: return rc /* continue after CALL ON */
TRAP.FAIL: say TRAP ; rc = 0 - rc /* force TRAP error output */
TRAP.EXIT: exit rc /* exit for any SIGNAL ON */
ZW5kZW5yYWhheXU5QGdtYWlsLmNvbQ==