#! /usr/local/bin/4 ss \ F8/4 SOURCE v0.11.xx, xec.file "quotaq"; L4 v1.1.4 (modified open-file flag) \ \ read stdin or file "./.ib-dir", ret MB KB BYTES used space. \ ls -l . | quotaq \ displays dir and sum of files & sizes, generates html text. \ any output from can be piped or redirected in. \ silent opr. it stdin and stdout is file/pipe, output summary, only. \ a single, quoted string argument can passed in for immediate evaluation. 0 constant l4test immediate l4test [IF] cr order cr f" util.f8" included \ not required, used when testing cr [THEN] \ search order only linux also forth also hidden also fig also ans also forth prevdef also definitions decimal \ sole, "evaluate"d argument recognized is "hpg5" to omitting the http base-ref \ if a name "hpg5" exists, such that ib-dir.html would refer to local copies. \ e.g. quotaq "0 constant hpg5" \ or quotaq ' s" /path/dirfile" dup stg df0' \ 'df0' re below 3 argstg evaluate \ ------------------------------------------------------------------------------- \ - config - \ ------------------------------------------------------------------------------- \ - def'd for pipe/files handling --- config ------------------------------------ 0. 2variable dir-used dir-used 2! \ file sizes accu 0 value n \ lines count 0 value p \ {read-line} ptr 0 value u \ stg len 0 value file \ html output 0 512 dup stg df1 0 512 dup stg url \ - input name default if stdin is console -------------------------------------- string " pferderei.de" to-stg url 0. if-found df0 2drop df0 \ string 'df0' -dup 0= [IF] drop \ by pre-defined argument \ {f"} returns tested in-chan path+name, {s"} for some default f" ./.pf-dir" -dup 0= [IF] drop \ 0st choice string " lxhp.in-berlin.de" to-stg url f" ./.ib-dir" -dup 0= [IF] drop \ 1st choice f" ./ib-dir" -dup 0= [IF] drop \ 2nd choice f" ./ib-dir.txt" -dup 0= [IF] drop \ 3rd choice f" ./.sna-dir" -dup 0= [IF] drop \ testing f" ./sna-dir" -dup 0= [IF] drop \ testing s" ./sna-dir.txt" \ neither one found [THEN] [THEN] [THEN] [THEN] [THEN] [THEN] [THEN] to-stg df1 \ returns ( -- p 0 ) if neither one found l4test [IF] cr ." df1:" df1 type cr [THEN] l4test [IF] cr ." url:" url type cr [THEN] \ ------------------------------------------------------------------------------- \ - data, words - \ ------------------------------------------------------------------------------- \ - html strings ---------------------------------------------------------------- string ' ' dup stg n1 string ' ' dup stg h2 string ' ' dup stg h3 string ' ' pad +place string ' latest files' pad +place if-nfound hpg5 string ' ' pad +place string ' ' pad +place string '

directory

' pad +place string ' ' pad +place string ' 445-4185' pad +place string ' ' pad +place string '

http://' pad +place url pad +place string '

' pad +place 
								pad count 	dup stg b1
string ' 

' dup stg b2 string '

  Sa. ' dup stg s1 string '

  generated w/ quotaq f8 Forth script

' dup stg s2 \ - i/o redirection, aux. words ------------------------------------------------- \ skip delimited text section : bl-sc bl scan bl skip ; \ buffer & empty line & subdir 0. 400 stg mbuf 0. 400 stg mdir s" " dup stg mpty 0 mpty drop 1+ 2dup c! 2+ 2dup c! 2+ 2dup c! 2+ 2dup c! 2+ 2dup c! 2+ 2dup c! 2+ 2dup c! : mdir0 ' mdir >body @+ 1+ erase ; \ 1st text segment : lsl-1st 2dup 2dup bl scan sdrop - ; ( p u -- p u p1 u1 ( rmg stg, 1st segment ) : addir ( p1 u1 -- p1 u1 ) 2dup + 1- c@ ": - -exit 2dup to-stg mdir "/ mdir + 1- c! ; \ read a line from either type of dir-file input in-chan pad fstat w@ 0= \ whether input is PIPEd [IF] : get-char ( p -- u ) locals| p | begin p 1 in-chan read-file [ s" AGAIN" errno ] literal + until ; : (get-line) pad ddup $fe bounds do drop i get-char 0= i c@ $a = or -leave i loop over- dup 0> [ out-chan cons? ] [IF] >r 2dup type cr r> [THEN] ; [ELSE] \ or file/console : (get-line) pad dup $100 in-chan read-line -dup if [ s" EAGAIN" errno negate ] literal =/= endif [ out-chan cons? ] [IF] >r 2dup type cr r> [THEN] ; [THEN] : get-line pad $100 erase (get-line) ; : xf file stdout xg-chan ; \ xchange stdout w/ file : xo stdout out-chan xg-chan ; \ xchange stdout w/ supplied output channel : odu \ send summary to stdout dir-used 2@ 1024 dup * m/mod 0 .r "M emit space 1024 / 0 .r "K emit space n #. ." Files " "( emit dir-used 2@ 1024 dup u* also rational #digits to #fplaces df. previous ")M emit dir-used 2@ 10 ud.r ." BYTES, " .time&date cr ; : qdu xo odu xo ; \ display summary to console/supplied channel : fdu s1 file write-line -exit xf odu xf s2 file write-line drop ; \ to file \ ------------------------------------------------------------------------------- \ - xec prog - \ ------------------------------------------------------------------------------- \ - init/open file --------------------------------------------------------------- in-chan ch-stat in-chan cons? [IF] \ def. in-chan if stdin is console df1 r/o open-file vers $01010400 < xor if bye-r endif \ pre-1.1.4 open-file ret false on error in-chan is-chan drop [THEN] l4test [IF] out-chan ch-pty? 0= [THEN] out-chan ch-stat out-chan ch-pipe? l4test [IF] and [THEN] [IF] s" /dev/null" w/o open-file \ discard 2nd-ary output if out-chan is a pipe [ELSE] pad 400 in-chan ch-name pad place \ fetch input channel's file-name pad count ". rscan dup \ strip leading "." off file-name if dup pad count rot - pad place 1/string pad +place else 2drop endif \ s" .shtml" pad +place \ append file affix s" .htm" pad +place \ append file affix pad count ": scan if "# over c! endif drop \ use modified name if in-chan is a pipe pad count r/w &644 mcreate-file \ set perm to -rw-rw-r- [THEN] if drop new-chan dup is-chan endif to file \ secondary, html-text output channel get-line 3drop \ drop header line \ - count used space, generate linked directory ---------------------------------- file ch-id 0> if b1 file write-line drop begin get-line in-chan ch-rnum 0> while if over to p dup to u \ save line & length lsl-1st addir 2>r bl-sc bl-sc bl-sc bl-sc -dup 0= if drop mpty pad2 place 2r pad2 +place pad2 count 2dup to u to p endif 2rdrop -dup if 1 +to n 0. 2over >number 2drop dir-used 2+! \ acc. file size bl-sc bl-sc bl-sc bl-sc \ advance to filename 2dup ". scan sdrop over- negate 2 pick swap \ w/o extn n0 file write-file 2drop file write-file 2drop n1 file write-file 2drop \ (name.extn) h1 file write-file 2drop \ html entry mdir -dup if file write-file drop endif drop file write-file 2drop h2 file write-file 2drop p u bl-sc bl-sc bl-sc bl-sc \ discard leading 4 text segm 2dup bl-sc drop also vt previous swap 1- c! \ '(length)' file write-file drop h3 file write-line 2drop \ '' endif l4test [IF] cr mdir type space .s cr [THEN] endif repeat fdu b2 file write-line drop l4test [IF] \ \\ qdu \ display/write result ." \n\tBLAH\n" chans file . out-chan . out-chan pty? . out-chan ch-pipe? . cr 0 sp@ sys exit [THEN] \ \\ else \ piped \ begin get-line in-chan ch-rnum 0> while if over to p dup to u \ save line & length bl-sc bl-sc bl-sc bl-sc -dup if 1 +to n 0. 2swap >number 2drop dir-used 2+! endif endif repeat endif qdu \ display/write result l4test [IF] cr .s cr [THEN] ( 0 bye-r \ out-comment for testing... (alternate termination: ) 0 sp@ sys exit )