#! /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 ' ' pad +place
string ' ' pad +place
string '
' pad +place
string ' ' 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 )