retroforth/example/atua-gophermap.retro
crc 06ee9705a8 image: rename some words
s:contains-char?  to  s:contains/char?
s:contains-string? to s:contains/string?
a:contains-string? to a:contains/string?

old names are now deprecated and will be removed after 2021.7.

FossilOrigin-Name: 5a19d7aac514c5ba87963c5f0645f3daa8a8e3dc04546c0627fa046479ecd8dd
2021-06-04 13:54:21 +00:00

191 lines
4.7 KiB
Forth
Executable file

#!/usr/bin/env retro
# Atua :: Gophermap Generation
I've been running a Gopher server written in RETRO since
2018. This server, named Atua, has served me quite well.
But it has one limit that sometimes proves annoying: there
is no support for generating a directory listing. Atua
only serves the data in a `gophermap`.
I decided to rectify this in a way. Rather than altering
Atua to add more complexity, I decided to write a tool
which can generate the `gophermap` automatically.
As a practical matter, the list will exclude files named
`gophermap`, `HEADER`, and `FOOTER`. The generated file
will consist of the contents of `HEADER`, the directory
entries, and the contents of `FOOTER`.
Output will be written to standard output. Redirect to the
`gophermap` file, or pipe it to another process for
examination or manipulation.
# The Code
I begin by defining a word for dealing with pipes.
~~~
:pipe> (s-s) file:R unix:popen [ file:read-line ] [ unix:pclose ] bi ;
~~~
I then create a word to return the number of files in the
current directory. This makes use of a Unix pipe to run
`ls -l | wc -l` and capture the result. I trim off any
whitespace and convert to a number.
~~~
:unix:count-files (-n)
'ls_-1_|_wc_-l pipe> s:trim s:to-number ;
~~~
Next, a word to identify the current working directory. This
also uses a pipe to `pwd`.
~~~
:unix:get-cwd (-s)
'pwd pipe> s:trim '/ s:append ;
~~~
The program accepts a single command line argument: the
physical base path to exclude. In Atua, there is a root
directory, and all selector paths are relative to this.
E.g., if the actual root is `/home/atua/gopherspace/` then
launching this program as:
atua-gophermap.forth /home/atua/gopherspace
will strip the actual root path off, allowing the selectors
to work as expected.
~~~
#0 script:get-argument s:length 'SKIP const
~~~
So with these defined, I define a couple of constants using
them for later use.
~~~
unix:get-cwd SKIP + 'BASE s:const
unix:count-files 'FILES const
~~~
Ok, now for a useful combinator. I want to be able to run
something once for each file or directory in the current
directory. One option would be to read the names and
construct a set, then use `a:for-each`. I decided to take
a different path: I implement a word to open a pipe, read a
single line, then run a quote against it.
With this, something like `ls` can be defined as:
:ls [ s:put nl ] unix:for-each-file ;
~~~
:unix:for-each-file (q-)
'ls_-1_-p file:R unix:popen
unix:count-files-in-cwd
[ [ file:read-line s:temp over call ] sip ] times
unix:pclose drop ;
~~~
# Generate The Output
Begin by displaying HEADER (if it exists).
~~~
'HEADER file:exists?
[ here 'HEADER file:slurp here s:put nl ] if
~~~
Next, list any directories. If a file name ends with a `/`,
I assume it is a directory.
~~~
:dir? (s-sf)
dup s:length over + n:dec fetch $/ eq? ;
~~~
A directory entry needs the following form:
0description<tab>selector<newline>
I am using the directory name as the description (with a
trailing slash), and the relative path (without the final
slash) as the selector.
~~~
:selector (filename-selector)
BASE s:prepend s:chop ;
:dir-entry (filename)
$1 c:put dup s:put tab selector s:put nl ;
[ dir? &dir-entry &drop choose ] unix:for-each-file
~~~
Next, list files. This is harder because files can have
different types.
I start with a word to decide if the item is a file. This
will ignore directories (ending in a `/`), `HEADER`, `FOOTER`,
and `gophermap` files.
~~~
:file? (s-sf)
dup 'HEADER [ FALSE ] s:case
'FOOTER [ FALSE ] s:case
'gophermap [ FALSE ] s:case
drop dir? not ;
~~~
Then I look to see if it has a file extension.
~~~
:has-extension? (s-sf)
dup $. s:contains/char? ;
~~~
If there is an extension, it can be mapped to a type code.
I do this with a simple `s:case` construct, defaulting to
a binary (type 9) file if I don't recognize the extension.
~~~
:file-type
dup $. s:split/char drop
'.forth [ $0 ] s:case
'.md [ $0 ] s:case
'.txt [ $0 ] s:case
'.htm [ $h ] s:case
'.html [ $h ] s:case
drop $9 ;
~~~
Finishing up the file listing, the `file-entry` determines
the file type and prints out the appropriate line.
~~~
:selector (filename-selector)
BASE s:prepend ;
:file-entry (filename)
has-extension? [ file-type ] [ $9 ] choose
c:put dup s:put tab selector s:put nl ;
[ file? &file-entry &drop choose ] unix:for-each-file
~~~
End by displaying FOOTER (if it exists).
~~~
'FOOTER file:exists?
[ here 'FOOTER file:slurp here s:put nl ] if
~~~
# Conclusion
This was a quick little thing that will make using Atua nicer
in the future. The techniques used here can be beneficial in
other filesystem related tasks as well, so I expect to reuse
portions of this code in the future.