/* OS/2 REXX: create a plain directory listing (XHTML 1.0) */ /* dir2html.cmd 1.1 : */ /* 1.1: use chars() instead of lines(), add alt-text for banner, */ /* recognize identical timestamps (same minute) as identical */ /* 1.0: kill dubious validator.w3.org system id. mismatch warning */ /* 0.9: minor fixes for WindowsNT ooRexx 3.1 in MOVE() and XDEL() */ /* 0.8: exit calling external procedure SITEMAP */ /* 0.7: add self link rel="bookmark", title="plain text" if PLAIN */ /* 0.6: removed dummy , added a new dummy */ /* */ /* 0.5: Support a banner and relative URLs for icon and banner. */ /* 0.4: Skip dot-files like ftpsynch.cmd. Use slash in subdir.s */ /* 0.3: Skip names with non-ASCII or special char.s ("-._" ok.). */ /* Please configure this script (once) by editing the next lines: */ /* 1 - select some plain text file extensions in variable PLAIN - */ /* resulting type="text/plain" links could help GoogleBot (?) */ /* 2 - select the local root directory of your homepage in DIR.. */ /* 3 - select 1 or more wanted subdirectories in DIR.1 DIR.2 etc. */ /* 4 - modify H.. (URL), H.0E (name), H.0F (first), H.0D (icon), */ /* H.0C (for a Lynx-style made link with a feedback URL). and */ /* H.0B (banner). The optional banner is relatively linked */ /* to the root directory DIR.. (file) or H.. (http) resp. */ /* 5 - H.0B and H.0D can be relative URLs starting with a slash, */ /* and then work also offline as file://localhost/ URLs. */ /* 6 - dito new H.0A for an optional style sheet */ /* Finally do not forget to call this script regularly. Upload */ /* the resulting index.html file(s) with the directory listings. */ /* An unmodified index.html is kept, using a temporary index.bak. */ H.. = 'http://purl.net/xyzzy' ; H.0E = 'Ellermann' H.0C = H.. || '/mailto/webmaster' ; H.0F = 'F' H.0D = '/valid.jpg' /* H.0A + H.0B optional */ H.0A = '/w3c/xyzzy.css' ; H.0B = '/pub/homepage.jpg' DIR.. = 'd:\Inetpub\ftproot' ; DIR.1 = '\dos' DIR.2 = '\eis' ; DIR.3 = '\kex' DIR.4 = '\src' ; DIR.5 = '\pub' DIR.6 = '\home\test' ; DIR.7 = '\w3c' DIR.8 = '\home\ltru' PLAIN = 'kex kml rex cls cmd nrx' /* various plain text .??? */ PLAIN = PLAIN 'awk c pac 003 036 bat' signal on novalue name TRAP ; signal on syntax name TRAP signal on failure name TRAP ; signal on halt name TRAP signal on notready name TRAP EXPO = 'DIR. PLAIN H.' ; call UTIL 'SysFileTree' do N = 1 while symbol( 'DIR.N' ) = 'VAR' if DIRT( DIR.N ) then exit TRAP( 'aborted in' DIR.. || DIR.N ) end N exit SITEMAP() /* update related sitemap.xml */ HTML: procedure expose (EXPO) /* at start or end of index.html */ R.A = arg( 3 ) || substr( H.0A, 2 ) if abbrev( H.0A, '/' ) = 0 then R.A = H.0A R.B = arg( 3 ) || substr( H.0B, 2 ) if abbrev( H.0B, '/' ) = 0 then R.B = H.0B H.1 = '' H.2 = '' H.3 = ' ' H.4 = ' ' H.5 = ' ' H.6 = ' ' H.7 = ' ' if R.A = '' then H.7 = R.A /* style sheet is only optional */ H.8 = ' ' H.. || arg( 2 ) '' H.9 = '' H.10 = '
' || H.. || '' H.10 = H.10 || '
' if R.B = '' then H.10 = R.B /* the banner is only optional */ H.11 = '

Directory listing: ' arg( 2 ) || '/*' H.11 = H.11 || '

 timestamp local   size    file'
   H.0  = 11

   if arg( 4 ) then do           /* this is the end of index.html */
      R.A = arg( 3 ) || substr( H.0D, 2 )
      if abbrev( H.0D, '/' ) = 0 then R.A = H.0D
      H.1 = '
' H.2 = ' ' H.2 = H.2 || 'W3 validator' H.3 = ' Last update:' date() left( time(), 5 ) 'by ' H.3 = H.3 || '' || H.0F || '.' || H.0E || '' H.4 = '
' H.0 = 4 end do N = 1 to H.0 if sign( lineout( arg( 1 ), H.N )) then return 1 end N return sign( lineout( arg( 1 ))) DIRT: procedure expose (EXPO) SUB = DIR.. || arg( 1 ) || left( arg( 1 ), 1 ) REL = translate( arg( 1 ), '/', '\' ) TOP = REL do N = 1 until TOP = '' ; parse var TOP '/' TOP ; end N TOP = copies( '../', N - 1 ) /* relative path to root dir. */ if SysFileTree( SUB || '*', 'SUB', 'FL' ) <> 0 then return 1 if KWIK( 'SUB' ) = 0 then return 1 BAK = SUB || 'index.bak' ; address CMD '@echo >' BAK OUT = SUB || 'index.html' ; call MOVE OUT, BAK if HTML( OUT, REL, TOP, 0 ) then return 1 do N = SUB.0 to 1 by -1 parse var SUB.N DATE TIME SIZE . (SUB) NAME select when NAME = 'index.html' then TYPE = 'checking' when abbrev( NAME, '.' ) then TYPE = 'skipping' otherwise if datatype( translate( NAME, , '-._', 0 ), 'A' ) then TYPE = '' ; else TYPE = 'skipping' end if TYPE <> '' then do say TYPE SUB || NAME ; iterate N end TYPE = reverse( translate( strip( NAME ))) select when abbrev( TYPE, 'LMX.' ) then TYPE = '"text/xml' when abbrev( TYPE, 'SSC.' ) then TYPE = '"text/css' when abbrev( TYPE, 'TXT.' ) then TYPE = '"text/plain' when abbrev( TYPE, 'FDR.' ) then TYPE = '"application/rdf+xml' when abbrev( TYPE, 'DTD.' ) then TYPE = '"application/xml-dtd' otherwise do T = 1 to words( PLAIN ) X = reverse( translate( '.' || word( PLAIN, T ))) if abbrev( TYPE, X ) then do TYPE = '"text/plain" title="plain text' leave T end end T end if abbrev( TYPE, '"' ) then TYPE = '" type=' || TYPE else TYPE = '' if SIZE < 100000 then SIZE = SIZE ' ' else SIZE = SIZE % 1024 'KB' TEXT = '' || NAME || '' call lineout OUT, DATE left( TIME, 5 ) right( SIZE, 9 ) TEXT end N T = HTML( OUT, REL, TOP, 1 ) if T = 0 then do do while sign( chars( BAK )) & sign( chars( OUT )) if linein( BAK ) <> linein( OUT ) then leave end if sign( chars( BAK )) & sign( chars( OUT )) then do T = ( linein( BAK ) == linein( OUT )) T = T & chars( BAK ) = 0 & chars( OUT ) = 0 end end call lineout OUT ; call lineout BAK if T then return MOVE( BAK, OUT ) say 'new file' OUT ; return XDEL( BAK ) 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 */ 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 ) 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 */ 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 */