#!/usr/bin/perl -w $ID = q$Id: spin,v 1.80 2013/01/04 22:43:26 eagle Exp $; # # spin -- Translate thread (an HTML macro language) into HTML. # # Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, # 2010, 2011, 2013 Russ Allbery # # This program is free software; you may redistribute it and/or modify it # under the same terms as Perl itself. ############################################################################## # Modules and declarations ############################################################################## require 5.005; # The default list of files and/or directories to exclude from spinning. This # can be added to with the -e option. Each of these should be a regular # expression. @EXCLUDES = (qr/^\.(?!\.\z)(?!htaccess\z)/, qr/^CVS\z/, qr/^Makefile\z/, qr/^RCS\z/); # The URL to the software page for all of my web page generation software. $URL = 'http://www.eyrie.org/~eagle/software/web/'; use strict; use subs qw(expand parse parse_context); use vars qw(%DEPEND $DOCID @EXCLUDES $FILE @FILES $FULLPATH $ID $OUTPUT %OUTPUT $REPO @RSS %SITEDESCS %SITELINKS @SITEMAP $SOURCE $SPACE @STATE $STYLES $URL %VERSIONS %commands %macros %strings); use Cwd qw(getcwd); use FileHandle (); use Getopt::Long qw(GetOptions); use Image::Size qw(html_imgsize); use File::Copy qw(copy); use File::Find qw(find finddepth); use File::Spec (); use POSIX qw(mktime strftime); use Text::Balanced qw(extract_bracketed); ############################################################################## # Output ############################################################################## # Sends something to the output file. Pull out any trailing space and stash # it temporarily, and put any trailing space that we'd previously stashed into # the output string after any close tags. This gets spacing working properly # around boundaries. sub output { local $_ = join ('', @_); if ($SPACE) { my ($close, $body) = m%^(\s*(?:]+>\s*)*)(.*)%s; $close .= $SPACE; $close =~ s/\n\s*\n\s*\n/\n\n/g; $_ = $close . $body; $SPACE = ''; } if (s/\n(\s+)\z/\n/) { $SPACE = $1 } print OUT $_; } ############################################################################## # Basic parsing ############################################################################## # Escapes &, <, and > characters found in a string. sub escape { local $_ = shift; s/&/&/g; s//>/g; $_ } # Undo HTML entity escaping. sub unescape { local $_ = shift; s/<//g; s/&/&/g; $_ } # Wrap something in paragraph markers, being careful to get newlines right. # Special-case a paragraph consisting entirely of by turning it into a #

with the same class. sub paragraph { my $text = shift; $text =~ s/^\n(\s*\n)*//; $text =~ s/(\S[ \t]*)\z/$1\n/; if ($text =~ m%^(\s*)]*)>(.*)(\s*)\z%s) { my ($lead, $class, $text, $trail) = ($1, $2, $3, $4); return "$lead$text

$trail"; } else { $text =~ s/^/

\n/; $text =~ s%(\n\s*)\z%\n

$1%; return $text; } } # Opens or closes a border of a continued structure. Either takes the name of # the state and its start and end tags, or takes no arguments to close all # open states. sub border { my ($border, $start, $end) = @_; my $output = ''; if ($border) { if ($STATE[-1] eq 'BLOCK' || $STATE[-1][0] ne $border) { $output .= $start; push (@STATE, [ $border, $end ]); } } else { my $state; while (defined ($state = pop @STATE)) { last if $state eq 'BLOCK'; $output .= $$state[1]; } push (@STATE, 'BLOCK'); } return $output; } # Marks the beginning of major block structure. Within this structure, # borders will only clear to the level of this structure. sub border_start { push (@STATE, 'BLOCK'); } # Clears a major block structure. sub border_clear { my $output = border; pop @STATE; return $output; } # Extract some number of arguments from the front of the given string. If the # optional third argument is true, try to pull off a parenthesized formatting # instruction first, returning it as the first result (or undef if it's not # found). If the count is -1, pull off as many arguments as we can find. sub extract { my ($text, $count, $format) = @_; my (@result, $code); $text =~ s/\s*//; if ($format && $text =~ /^\(/) { ($result[0], $text) = extract_bracketed ($text, '()'); $result[0] = substr ($result[0], 1, -1); } else { $result[0] = ''; } if ($count >= 0) { for (1..$count) { ($result[$_], $text) = extract_bracketed ($text, '[]'); if ($result[$_]) { $result[$_] = substr ($result[$_], 1, -1); } else { warn "$0:$FILE:$.: cannot find argument $_\n"; $result[$_] = ''; } } } else { while ($text =~ /^\s*\[/) { my $result; ($result, $text) = extract_bracketed ($text, '[]'); last unless $result; $result = substr ($result, 1, -1); push (@result, $result); } } unless ($format) { shift @result } (@result, $text); } # Process a macro. Takes the number of arguments, the definition of the # macro, a flag saying whether we're at a block level, and then the values of # all the arguments. Only straight substitution commands are allowed here, of # course. sub macro { my ($args, $definition, $block) = @_; $definition =~ s/\\(\d+)/($1 > $args) ? "\\$1" : $_[$1 + 2]/ge; return parse_context ($definition, $block); } # Expand a given command into its representation. This function is mutually # recursive with parse. Takes a third argument indicating whether this is a # top-level element (if it is, and it doesn't generate its own container, it # may have to be wrapped in

). Returns the result of expanding the # command, a flag saying whether the command is block level, and the remaining # text in the paragraph. sub expand { my ($command, $text, $block) = @_; if ($command eq '==') { my ($new, $args, $definition); ($new, $args, $definition, $text) = extract ($text, 3); if (defined $definition) { $macros{$new} = [ $args, $definition ]; return ('', 1, $text); } } elsif ($command eq '=') { my ($variable, $value); ($variable, $value, $text) = extract ($text, 2); $strings{$variable} = parse ($value); return ('', 1, $text); } elsif ($command =~ s/^=//) { if (exists $strings{$command}) { return ($strings{$command}, 0, $text); } else { warn "$0:$FILE:$.: unknown string $command\n"; return ('', 0, $text); } } elsif ($command eq '\\') { return ('\\', 0, $text); } elsif (ref $macros{$command}) { my ($args, $definition) = @{ $macros{$command} }; my @args; if ($args != 0) { @args = extract ($text, $args, 0); $text = pop @args; } my $block = $block && ($text !~ /\S/); return (macro ($args, $definition, $block, @args), $text); } else { if (!ref $commands{$command}) { warn "$0:$FILE:$.: bad command $command\n"; return ('', 1, $text); } my ($args, $handler) = @{ $commands{$command} }; my ($blocktag, $result); if ($args == 0) { ($blocktag, $result) = &$handler (); } else { my @args = extract ($text, $args, 1); $text = pop @args; my $format = shift @args; ($blocktag, $result) = &$handler ($format, @args); } return ($result, $blocktag, $text); } } # Given a text string, check it for escape sequences and expand them. This # function is mutually recursive with expand. Takes one flag, saying whether # we're at the block level. Returns the expanded text and a flag saying # whether the result is suitable for block level. sub parse_context { my ($text, $block) = @_; if (index ($text, '\\') == -1) { my $output = $text; $output = border . paragraph ($output) if $block; return ($output, $block); } # Chop off everything up to the first backslash and save it in output. # Then grab the escape and figure out what to do with it. # # If we are at block level, we have to distinguish between plain text and # inline commands, which have to be wrapped in paragraph tags, and # block-level commands, which shouldn't be. We accumulate any output that # has to be wrapped in a paragraph in $paragraph (and put the border # before it in $border). Whenever we see a block-level command, we wrap # anything currently in $paragraph in a paragraph, tack it on to the # output, and then add on the results of the block command. $space holds # leading space, which we want to add to the paragraph if we end up # creating a paragraph. # # $nonblock is a flag indicating that we saw some construct that wasn't # suitable for block level. my $output = ''; my ($border, $paragraph, $space) = ('', '', ''); my $nonblock = 0; while ($text ne '') { unless ($text =~ s/^([^\\]+|\\([\w=]+|.))//) { my $error = substr ($text, 0, 20); $error =~ s/\n.*//s; die "$0:$FILE:$.: unable to parse at '$error'\n"; } my $command; if (index ($1, '\\') == -1) { my $string = $1; if ($block && $string =~ /^\s+$/ && $paragraph eq '') { $space .= $string; } elsif ($block && ($string =~ /\S/ || $paragraph ne '')) { $border = border if $paragraph eq ''; $paragraph .= $space . $string; $space = ''; } else { $output .= $string; $nonblock = 1; } } else { $command = $2; my ($result, $blocktag); my $force = $block && $paragraph eq ''; ($result, $blocktag, $text) = expand ($command, $text, $force); if ($blocktag) { if ($block && $paragraph ne '') { $output .= $border . paragraph ($space . $paragraph); $border = ''; $paragraph = ''; } else { $output .= $space; } $output .= $result; } elsif ($block) { $border = border if $paragraph eq ''; $paragraph .= $space . $result; $nonblock = 1; } else { $output .= $result; $nonblock = 1; } $space = ''; } if ($text =~ s/^\n(\s*)//) { if ($paragraph ne '') { $paragraph .= "\n$1"; } else { $output .= "\n" if $text || $nonblock; $output .= $1; } } } # Wrap any remaining output in paragraph tags and then return the output. # If we were at block level, our output is always suitable for block # level. Otherwise, it's suitable for block level only if all of our # output was from block commands. $output .= $border . paragraph ($space . $paragraph) unless $paragraph eq ''; return ($output, $block || !$nonblock); } # A wrapper around parse_context for callers who don't care about the block # level of the results. sub parse { my ($output) = parse_context (@_); return $output; } ############################################################################## # Data files ############################################################################## # Read the sitemap file for a site and flesh out the @SITEMAP array and # %SITEDESCS and %SITELINKS hashes with information from that file. # # @SITEMAP is an array of anonymous arrays holding the complete site map. # Each element represents a page. The element will contain three elements: # the numeric indent level, the partial URL, and the description. %SITEDESCS # holds a map of partial URLs to descriptions, and %SITELINKS map partial URLs # to a list of other partial URLs (previous, next, and up). # # The format of the sitemap file is one line per web page, with indentation # showing the tree structure, and with each line formatted as a partial URL, a # colon, and a page description. If two pages at the same level aren't # related, a line with three dashes should be put between them at the same # indentation level. sub read_sitemap { my ($map) = @_; # @indents holds a stack of indentation levels. @parents is a matching # stack of parent URLs for each level of indentation, and @prev is a # matching stack of the previous page at each level of indentation. If # $prev[0] is undef, there is no previous page at that level. my @indents = (0); my (@parents, @prev); open (MAP, $map) or return; local $_; while () { next if /^\s*\#/; if (/^( *)---$/) { my $indent = length ($1); while ($indents[0] > $indent) { shift @indents; shift @prev; shift @parents; } $prev[0] = undef; next; } my ($indent, $url, $desc) = /^( *)([^\s:]+):\s+(.+)$/; next unless defined $desc; $indent = length ($indent); if ($indent > $indents[0]) { unshift (@parents, $prev[0]); unshift (@indents, $indent); unshift (@prev, undef); } while ($indents[0] > $indent) { shift @indents; shift @prev; shift @parents; } $SITELINKS{$url} = [ $prev[0], undef, @parents ]; $SITELINKS{$prev[0]}[1] = $url if defined $prev[0]; $prev[0] = $url; $SITEDESCS{$url} = $desc; push (@SITEMAP, [ $indent, $url, $desc ]); } close MAP; } # Given a date and time in ISO format, convert it to seconds since epoch. sub time_to_seconds { my ($date, $time) = @_; my @datetime = reverse split (':', $time); push (@datetime, reverse split ('-', $date)); $datetime[4]--; $datetime[5] -= 1900; $datetime[6] = 0; $datetime[7] = 0; $datetime[8] = -1; return mktime (@datetime); } # Read in the .versions file for a site and flesh out the %VERSIONS hash. It # contains a mapping of product name to an anonymous array of version number # and date of the last update. It also fleshes out the %DEPEND hash, which # holds a mapping of file names that use a particular version to the timestamp # of the last change in that version. sub read_versions { my ($versions) = @_; open (VERSIONS, $versions) or return; local $_; my $last; while () { next if /^\s*$/; next if /^\s*\#/; my @files; if (/^\s/) { @files = split; } else { my ($product, $version, $date, $time); ($product, $version, $date, $time, @files) = split; my $timestamp; if ($date) { $time ||= '00:00:00'; $timestamp = time_to_seconds ($date, $time); } else { $timestamp = 0; } $date = strftime ('%Y-%m-%d', gmtime $timestamp); $VERSIONS{$product} = [ $version, $date ]; $last = $timestamp; } for (@files) { $DEPEND{$_} = $last if (!$DEPEND{$_} || $DEPEND{$_} < $last); } } close VERSIONS; } ############################################################################## # Page headers and footers ############################################################################## # Given the partial URL to the current page and the partial URL to another # page, generate a relative URL between the two. sub relative { my ($start, $end) = @_; my @start = split ('/', $start, -1); my @end = split ('/', $end, -1); while (@start && @end && $start[0] eq $end[0]) { shift @start; shift @end; } if (@start == 1 && @end == 1) { return ($end[0] ? $end[0] : './'); } else { return ('../' x $#start) . join ('/', @end); } } # Given the name of the current file being processed, return the tags # for that file suitable for the section. Uses the global %SITEDESCS # and %SITELINKS variables. If the partial URL isn't found in those variables # or we're at the top page, nothing is returned. sub sitelinks { my $file = shift; $file = $File::Find::dir . '/' . $file; $file =~ s%^\Q$SOURCE%%; $file =~ s%/index\.html$%/%; my $output = ''; if ($file ne '/' && $SITELINKS{$file}) { my @links = @{ $SITELINKS{$file} }; my @descs = map { defined ($_) ? $SITEDESCS{$_} : '' } @links; @descs = map { s/\"/"/g; $_ } map { escape $_ } @descs; @links = map { defined ($_) ? relative ($file, $_) : undef } @links; # Make the HTML for the footer. my @types = ('previous', 'next', 'up'); for my $i (0..2) { next unless defined $links[$i]; my $link = qq( 79) { $link .= "\n "; } $link .= qq( title="$descs[$i]" />\n); } else { $link .= " />\n"; } $output .= $link; } my $href = relative ($file, '/'); $output .= qq( \n); } return $output; } # Given the name of the current file being processed, return the HTML for the # navigation links for that file. Uses the global %SITEDESCS and %SITELINKS # variables. If the partial URL isn't found in those variables or we're at # the top page, nothing is returned. sub placement { my $file = shift; $file = $File::Find::dir . '/' . $file; $file =~ s%^\Q$SOURCE%%; $file =~ s%/index\.html$%/%; my $output = ''; if ($file ne '/' && $SITELINKS{$file}) { my @links = @{ $SITELINKS{$file} }; my @descs = map { defined ($_) ? $SITEDESCS{$_} : '' } @links; @descs = map { escape $_ } @descs; @links = map { defined ($_) ? relative ($file, $_) : undef } @links; # Build the table for the navigation bar. $output = qq(\n); $output .= qq( \n); if (defined $links[2]) { $output .= qq( \n); } $output .= qq( \n); $output .= qq(\n\n); } return $output; } # Return the signature file for pages in this directory, if present. sub sign { my $output = ''; if (open (SIG, '< .signature') || open (SIG, "< $SOURCE/.signature")) { local $/ = "\n"; my @signature = ; chomp @signature; close SIG; $output .= join ("\n ", @signature); $output .= "
\n "; } return $output; } # Returns the page footer, which consists of the navigation links, the regular # signature, and the last modified date. Takes as arguments the full path to # the source file, the name of the destination file, the CVS Id of the source # file if known, the template to use if the modification and current dates are # the same, and the temlate to use if they're different. The templates will # have the strings %MOD% and %NOW% replaced by the appropriate dates and %URL% # with the URL to my HTML generation software.. sub footer { my ($source, $file, $id, @templates) = @_; my $output = placement $file; $output .= "

\n " . sign; # Figure out the modified dates. Use the RCS/CVS Id if available, # otherwise use the Git repository if available. my $modified; if (defined $id) { my $date = (split (' ', $id))[3]; if ($date && $date =~ m%^(\d+)[-/](\d+)[-/](\d+)%) { $modified = sprintf ("%d-%02d-%02d", $1, $2, $3); } } elsif (defined $REPO && $source =~ /^\Q$SOURCE/) { $modified = $REPO->run ('log', '-1', '--format=%ct', $source); if ($modified) { $modified = strftime ('%Y-%m-%d', gmtime $modified); } } if (!$modified) { $modified = strftime ('%Y-%m-%d', gmtime ((stat $source)[9])); } my $now = strftime ('%Y-%m-%d', gmtime); # Determine which template to use and substitute in the appropriate times. my $template = ($modified eq $now) ? $templates[0] : $templates[1]; if ($template) { for ($template) { s/%MOD%/$modified/g; s/%NOW%/$now/g; s/%URL%/$URL/g; } $output .= "$template\n"; } $output .= "
\n"; return $output; } ############################################################################## # Supporting functions ############################################################################## # Given the format argument to a command, return the class or id attribute # that should be used preceeded by a space, or an empty string if none should # be used. sub format_string { my $format = shift; if ($format) { if ($format =~ s/^\#//) { if ($format =~ /\s/) { warn qq($0:$FILE:$.: Space in anchor "$format"\n); } return ' id="' . $format . '"'; } else { return ' class="' . $format . '"'; } } else { return ''; } } # Splits a block of text apart at paired newlines so that it can be reparsed # in paragraphs, but combines a paragraph with the next one if it has an # unbalanced number of open brackets. Used by containiners like \block that # can contain multiple paragraphs. sub split_paragraphs { my $text = shift; $text =~ s/^\n(\s*\n)+/\n/; my @paragraphs; while ($text && $text =~ s/^(.*?(?:\n\n+|\s*\z))//s) { my $paragraph = $1; my $open = ($paragraph =~ tr/\[//); my $close = ($paragraph =~ tr/\]//); while ($text && $open > $close) { $text =~ s/^(.*?(?:\n\n+|\s*\z))//s; my $extra = $1; $open += ($extra =~ tr/\[//); $close += ($extra =~ tr/\]//); $paragraph .= $extra; } push (@paragraphs, $paragraph); } return @paragraphs; } # A simple block element. Takes the name of the tag, an initial string to be # prepended verbatim, the format, and the text. Handles splitting the # argument on paragraph boundaries and surrounding things properly with the # tag. sub block { my ($tag, $border, $format, $text) = @_; my $output; border_start; if ($format eq 'packed') { $output = parse ($text, 0); } else { $output = join ('', map { parse ($_, 1) } split_paragraphs ($text)); } $output .= border_clear; $output = $border . "<$tag" . format_string ($format) . '>' . $output; $output =~ s%\s*\z%%; $output .= "\n" unless $format eq 'packed'; return (1, $output); } # A heading. Handles formats of #something specially by adding an # tag inside the heading tag to make it a valid target for internal links even # in old browsers. sub heading { my ($level, $format, $text) = @_; my $output = border; if ($format && $format =~ /^\#/) { my $tag = $format; $tag =~ s/^\#//; $text = qq($text); } $output .= "'; $output .= parse ($text); $output =~ s/\n\z//; $output .= "\n"; return (1, $output); } # A simple inline element. Takes the name of the tag, the format, and the # body and returns the appropriate list of block level and HTML. sub inline { my ($tag, $format, $text) = @_; my $output = "<$tag" . format_string ($format) . '>'; $output .= parse ($text) . ""; return (0, $output); } # Enclose some text in another tag. The one special thing that we do is if # the enclosed text is entirely enclosed in or
tags, we pull the # options of the or
out and instead apply them to the parent tag. # Takes the tag and the text to enclose. sub enclose { my ($tag, $text) = @_; my $close = $tag; $close =~ s/ .*//; if ($text =~ m%^(\s*)]*)>(.*)(\s*)\z%s) { my ($lead, $class, $text, $trail) = ($1, $2, $3, $4); return "$lead<$tag$class>$text$trail"; } elsif ($text =~ m%^(\s*)]*)>(.*)
(\s*)\z%s) { my ($lead, $class, $text, $trail) = ($1, $2, $3, $4); return "$lead<$tag$class>$text$trail"; } else { return "<$tag>$text"; } } ############################################################################## # Commands ############################################################################## # Basic inline commands. sub do_break { (0, '
') } sub do_bold { inline ('b', @_) } sub do_cite { inline ('cite', @_) } sub do_class { inline ('span', @_) } sub do_code { inline ('code', @_) } sub do_emph { inline ('em', @_) } sub do_italic { inline ('i', @_) } sub do_rule { return (1, border . "
\n") } sub do_strike { inline ('strike', @_) } sub do_strong { inline ('strong', @_) } sub do_sub { inline ('sub', @_) } sub do_sup { inline ('sup', @_) } sub do_under { inline ('u', @_) } # Basic block commands. sub do_div { block ('div', '', @_) } sub do_block { block ('blockquote', '', @_) } sub do_bullet { block ('li', border ('bullet', "
    \n", "
\n\n"), @_) } sub do_number { block ('li', border ('number', "
    \n", "
\n\n"), @_) } # A description list entry, which takes the heading and the body as arguments. sub do_desc { my ($format, $heading, $text) = @_; my $initial = border ('desc', "
\n", "
\n\n"); $initial .= '' . parse ($heading) . "\n"; return block ('dd', $initial, $format, $text); } # An HTML entity. Check for and handle numeric entities properly, including # special-casing [ and ] since the user may have needed to use \entity to # express text that contains literal brackets. sub do_entity { my ($format, $char) = @_; $char = parse ($char); if ($char eq '91') { return (0, '['); } elsif ($char eq '93') { return (0, ']'); } elsif ($char =~ /^\d+$/) { return (0, '&#' . $char . ';'); } else { return (0, '&' . $char . ';'); } } # Generates the page heading at the top of the document. Takes as arguments # the page title and the page style. This is where the XHTML declarations # come from. sub do_heading { my ($format, $title, $style) = @_; $title = parse ($title); $style = parse ($style); my $file = $FILE; $file =~ s/\.th$/.html/; my $output = qq(\n); $output .= qq(\n); $output .= qq(\n\n); $output .= qq(\n $title\n); $output .= qq( \n); if ($style) { $style .= '.css'; $style = $STYLES . $style if $STYLES; $output .= qq( \n); } if (@RSS) { for my $rss (@RSS) { my ($url, $title) = @$rss; $output .= qq( \n); } } if ($FILE ne '-') { $output .= sitelinks $file; } $output .= "\n\n"; my $version = (split (' ', $ID))[2]; my $date = strftime ('%Y-%m-%d %T -0000', gmtime); $output .= '\n"; $output .= "\n" if $DOCID; $output .= "\n\n"; if ($FILE ne '-') { $output .= placement ($file); } return (1, $output); } # Used to save the RCS Id for the document. Doesn't actually output anything # (the identifier is later used in do_heading). sub do_id { my ($format, $id) = @_; $DOCID = $id; return (1, ''); } # Include an image. The size is added to the HTML tag automatically. Takes # the relative path to the image and the alt text. sub do_image { my ($format, $image, $text) = @_; $image = parse ($image); $text = parse ($text); my $size = ''; if (-f $image) { $size = ' ' . lc html_imgsize ($image); } my $output = qq($text"; return (1, $output); } # Include a file. Note that this includes a file after the current paragraph, # not immediately at the current point, which may be a bit surprising. # Someday, I should fix that. sub do_include { my ($format, $file) = @_; $file = parse ($file); my $fh = FileHandle->new ("< $file") or die "$0:$FILE:$.: cannot include $file: $!\n"; unshift (@FILES, [$fh, $file]); return (1, ''); } # A link to a URL or partial URL. sub do_link { my ($format, $url, $text) = @_; my $output = '' . parse ($text) . ''; return (0, $output); } # Preformatted text, the same as the HTML tag. sub do_pre { my ($format, $text) = @_; my $output = border; $output .= '' . parse ($text); $output .= "\n"; return (1, $output); } # Used for the leading quotes that I have on many of my pages. Takes the # quote, the author, and the citation; the citation may be empty. If the # format is "broken", adds line breaks at the end of each line. sub do_quote { my ($format, $quote, $author, $cite) = @_; my $output = border . '
'; border_start; $quote = join ('', map { parse ($_, 1) } split_paragraphs ($quote)); $quote .= border_clear; if ($format && $format eq 'broken') { $quote =~ s%(\S *)(\n\s*(?!

)\S)%$1
$2%g; $quote =~ s%\n
%\n%g; $quote =~ s%


%

%g; } $quote =~ s/\n+$//; if ($format) { my $class = format_string ($format); $quote =~ s/

//g; } $output .= $quote; if ($author) { $author = parse ($author); my $prefix = ''; if ($format && ($format eq 'broken' || $format eq 'short')) { $output .= qq(

\n); } else { $output .= qq(

\n); $prefix = '— '; } if ($cite) { $cite = parse ($cite); $output .= " $prefix$author,\n $cite\n"; } else { $output .= " $prefix$author\n"; } $output .= "

"; } else { $output .= "\n"; } $output .= "
\n"; return (1, $output); } # Given the name of a product, return the release date of the product. sub do_release { my ($format, $product) = @_; $product = parse ($product); if ($VERSIONS{$product}) { my $date = $VERSIONS{$product}[1]; $date =~ s/ .*//; return (0, $date); } else { warn qq($0:$FILE:$.: No release date known for "$product"\n); return (0, ''); } } # Used to save RSS feed information for the page. Doesn't output anything # directly; the RSS feed information is used later in do_heading. sub do_rss { my ($format, $url, $title) = @_; $url = parse ($url); $title = parse ($title); push (@RSS, [ $url, $title ]); return (1, ''); } # Used to end each page, this adds the navigation links and my standard # address block. sub do_signature { my $output = border; if ($FILE eq '-') { $output .= "\n\n"; return (1, $output); } my $file = $FILE; $file =~ s/\.th$/.html/; my $link = 'spun'; my $source = $FILE; if (defined $File::Find::dir) { $source = $File::Find::dir . '/' . $source; } $output .= footer ($source, $file, $DOCID, "Last modified and\n $link %MOD%", "Last $link\n %NOW% from thread modified %MOD%"); $output .= "\n\n"; return (1, $output); } # Insert the formatted size in bytes, kilobytes, or megabytes of some local # file. We could use Number::Format here, but what we're doing is simple # enough and doesn't seem worth the trouble of another dependency. sub do_size { my ($format, $file) = @_; $file = parse ($file); unless ($file) { warn "$0:$FILE:$.: empty file name in \\size\n"; return (0, ''); } my ($size) = (stat $file)[7]; unless (defined $size) { warn "$0:$FILE:$.: cannot stat file $file: $!\n"; return (0, ''); } my @suffixes = qw(K M G T); my $suffix = '';; while ($size > 1024 && @suffixes) { $size /= 1024; $suffix = shift @suffixes; } $size = sprintf ('%.0f', $size) . $suffix . 'B'; return (0, $size); } # Generates a HTML version of the sitemap and outputs that. sub do_sitemap { unless (@SITEMAP) { warn qq($0:$FILE:$.: No sitemap file found\n); return (1, ''); } my $output = border; my @indents = (0); for my $page (@SITEMAP) { my ($indent, $url, $title) = @$page; next if $indent == 0; $url =~ s,^/,,; if ($indent > $indents[0]) { $output .= (' ' x $indent) . "
    \n"; unshift (@indents, $indent); } else { while ($indent < $indents[0]) { $output .= (' ' x $indents[0]) . "
\n"; shift @indents; } } $output .= ' ' x $indent; $output .= qq(
  • $title
  • \n); } for my $indent (@indents) { last if $indent <= 0; $output .= (' ' x $indent) . "\n"; } return (1, $output); } # Start a table. Takes any additional HTML attributes to set for the table # (this is ugly, but takes so many attributes for which there is no # style sheet equivalent that it's unavoidable) and the body of the table # (which should consist of \tablehead and \tablerow lines). sub do_table { my ($format, $options, $body) = @_; my $tag = $options ? "table $options" : 'table'; return block ($tag, '', $format, $body); } # A heading of a table. Takes the contents of the cells in that heading. sub do_tablehead { my ($format, @cells) = @_; my $output = ' \n"; for (@cells) { $output .= ' ' . enclose ('th', parse ($_) . border) . "\n"; } $output .= " \n"; return (1, $output); } # A data line of a table. Takes the contents of the cells in that row. sub do_tablerow { my ($format, @cells) = @_; my $output = ' \n"; for (@cells) { $output .= ' ' . enclose ('td', parse ($_) . border) . "\n"; } $output .= " \n"; return (1, $output); } # Output HTML text completely verbatim. sub do_verbatim { my ($format, $text) = @_; $text = unescape ($text); return (1, $text); } # Given the name of a product, return the version number of that product. sub do_version { my ($format, $product) = @_; $product = parse ($product); if ($VERSIONS{$product}) { return (0, $VERSIONS{$product}[0]); } else { warn qq($0:$FILE:$.: No version known for "$product"\n); return (0, ''); } } # The table of available commands. First column is the number of arguments, # second column is the handler, and the third column is whether this is its # own top-level element or whether it needs to be wrapped in

    tags. A # count of -1 means pull off as many arguments as we can find. %commands = (block => [ 1, \&do_block ], bold => [ 1, \&do_bold ], break => [ 0, \&do_break ], bullet => [ 1, \&do_bullet ], class => [ 1, \&do_class ], cite => [ 1, \&do_cite ], code => [ 1, \&do_code ], desc => [ 2, \&do_desc ], div => [ 1, \&do_div ], emph => [ 1, \&do_emph ], entity => [ 1, \&do_entity ], heading => [ 2, \&do_heading ], id => [ 1, \&do_id ], image => [ 2, \&do_image ], include => [ 1, \&do_include ], italic => [ 1, \&do_italic ], link => [ 2, \&do_link ], number => [ 1, \&do_number ], pre => [ 1, \&do_pre ], quote => [ 3, \&do_quote ], release => [ 1, \&do_release ], rss => [ 2, \&do_rss ], rule => [ 0, \&do_rule ], signature => [ 0, \&do_signature ], sitemap => [ 0, \&do_sitemap ], size => [ 1, \&do_size ], strike => [ 1, \&do_strike ], strong => [ 1, \&do_strong ], sub => [ 1, \&do_sub ], sup => [ 1, \&do_sup ], table => [ 2, \&do_table ], tablehead => [ -1, \&do_tablehead ], tablerow => [ -1, \&do_tablerow ], under => [ 1, \&do_under ], verbatim => [ 1, \&do_verbatim ], version => [ 1, \&do_version ]); # Add handlers for all the headings. for (1..6) { $commands{"h$_"} = [ 1, eval "sub { heading ($_, \@_) }" ] } ############################################################################## # Interface ############################################################################## # This function is called, giving an input and an output file name, to spin # HTML from thread. sub spin { my ($thread, $output) = @_; open (OUT, "> $output") or die "$0: cannott create $output: $!\n"; my $fh = FileHandle->new ("< $thread") or die "$0: cannott open $thread: $!\n"; @FILES = ([$fh, $thread]); $SPACE = ''; # Parse the thread file a paragraph at a time (but pick up macro contents # that are continued across paragraphs. We maintain the stack of files # that we're parsing in @FILES, and do_include will unshift new file # handle and filename pairs onto that stack. That means that the top of # the stack may change any time we call parse, so we have to grab our # current values again each time through the loop. local $/ = ''; local $_; border_start; while (@FILES) { ($fh, $FILE) = @{ $FILES[0] }; while (<$fh>) { if ("\n" !~ /\015/ && /\015/) { warn "$0:$FILE:$.: found CR characters; are your line endings" . " correct?\n"; } my $open = tr/\[//; my $close = tr/\]//; while (!eof && $open > $close) { my $extra = <$fh>; $open += ($extra =~ tr/\[//); $close += ($extra =~ tr/\]//); $_ .= $extra; } my $result = parse (escape ($_), 1); $result =~ s/^(?:\s*\n)+//; output $result unless ($result =~ /^\s*$/); ($fh, $FILE) = @{ $FILES[0] }; } close $fh; shift @FILES; } print OUT border_clear, $SPACE; close OUT; undef %macros; undef %strings; undef $DOCID; undef @RSS; } ############################################################################## # External converters ############################################################################## # Given the command to run to generate the page, the file to save the output # in, and an anonymous sub that takes three arguments, the first being the # captured blurb, the second being the document ID if found, and the third # being the base name of the output file, and prints out a last modified line, # handle a call to an external converter. sub run_converter { my ($command, $output, $footer) = @_; my @page = `$command`; if ($? != 0) { $command =~ s/ .*//; die "$0: command failed with exit status ", ($? >> 8), "\n"; } open (OUT, "> $output") or die "$0: cannot create $output: $!\n"; my $file = $output; $file =~ s%.*/%%; # Grab the first few lines of input, looking for a blurb and Id string. # Give up if we encounter first. Also look for a tag and # add the navigation link tags before it, if applicable. Add the # navigation bar right at the beginning of the body. my ($blurb, $docid); local $_; while (defined ($_ = shift @page)) { if (//) { $docid = $1; } if (//) { $blurb = $1; $blurb =~ s/ \d\d:\d\d:\d\d -0000//; $blurb =~ s/ \(\d{4}-\d\d-\d\d\)//; } if (m%^%) { print OUT sitelinks $file; } print OUT $_; if (m%, which is our # signal to start adding things. We just got very confused if was # on the same line as , so don't do that. print OUT $_ while (defined ($_ = shift @page) && !m%%i); # Add the footer and finish with the output. print OUT &$footer ($blurb, $docid, $file); print OUT $_, @page if defined; close OUT; } # A wrapper around the cl2xhtml script, used to handle .changelog pointers in # a tree being spun. Adds the navigation links and the signature to the # cl2xhtml output. sub cl2xhtml { my ($source, $output, $options, $style) = @_; $style = $STYLES . 'changelog.css' unless $style; my $command = "cl2xhtml $options -s $style $source"; my $footer = sub { my ($blurb, $id, $file) = @_; $blurb =~ s%cl2xhtml%\ncl2xhtml% if $blurb; footer ($source, $file, $id, $blurb, $blurb); }; run_converter ($command, $output, $footer); } # A wrapper around the cvs2xhtml script, used to handle .log pointers in a # tree being spun. Adds the navigation links and the signature to the # cvs2xhtml output. sub cvs2xhtml { my ($source, $output, $options, $style) = @_; my $dir = $source; $dir =~ s%/+[^/]+$%%; my $name = $source; $name =~ s%^.*/%%; $options .= " -n $name" unless $options =~ /-n /; $style = $STYLES . 'cvs.css' unless $style; $options .= " -s $style"; my $command = "(cd $dir && cvs log $name) | cvs2xhtml $options"; my $footer = sub { my ($blurb, $id, $file) = @_; $blurb =~ s%cvs2xhtml%\ncvs2xhtml% if $blurb; footer ($source, $file, $id, $blurb, $blurb); }; run_converter ($command, $output, $footer); } # A wrapper around the faq2html script, used to handle .faq pointers in a tree # being spun. Adds the navigation links and the signature to the faq2html # output. sub faq2html { my ($source, $output, $options, $style) = @_; $style = $STYLES . 'faq.css' unless $style; my $command = "faq2html $options -s $style $source"; my $footer = sub { my ($blurb, $id, $file) = @_; $blurb =~ s%faq2html%\nfaq2html%; footer ($source, $file, $id, $blurb, $blurb); }; run_converter ($command, $output, $footer); } # A wrapper around pod2thread and spin -f, used to handle .pod pointers in a # tree being spun. Adds the navigation links and the signature to the output. sub pod2html { my ($source, $output, $options, $style) = @_; $options = '-n' unless $options; my $styles = ($STYLES ? " -s $STYLES" : ''); $style = 'pod' unless $style; $options .= " -s $style"; my $command = "pod2thread $options $source | $FULLPATH -f$styles"; my $footer = sub { my ($blurb, $id, $file) = @_; my $link = 'spun'; footer ($source, $file, $id, "Last modified and\n $link %MOD%", "Last $link\n %NOW% from POD modified %MOD%"); }; run_converter ($command, $output, $footer); } ############################################################################## # Per-file operations ############################################################################## # Given a pointer file, read the master file and any options from that file, # returning them as a list with the newlines chomped off. sub read_pointer { my $file = shift; open (POINTER, $file) or die "$0: cannot open $file: $!\n"; my $master = ; my $options = ; my $style = ; close POINTER; die "$0: no master file specified in $file" unless $master; chomp $master; chomp $options if defined $options; chomp $style if defined $style; $options ||= ''; return ($master, $options, $style); } # This routine is called for every file in the source tree, and references the # variables $SOURCE and $OUTPUT to find the roots of the source and output # tree. It decides what to do with each file, whether spinning it or copying # it. It's called from within File::Find and therefore uses the standard # File::Find variables. sub process_file { return if ($_ eq '.' || $_ eq '..'); for my $regex (@EXCLUDES) { if (/$regex/) { $File::Find::prune = 1; return; } } my $input = $File::Find::name; my $output = $input; $output =~ s/^\Q$SOURCE/$OUTPUT/ or die "$0: $input out of tree?\n"; my $shortout = $output; $shortout =~ s/^\Q$OUTPUT/.../; # Conversion rules for pointers. The key is the extension, the first # value is the name of the command for the purposes of output, and the # second is the sub to run. my %rules = (changelog => [ 'cl2xhtml', \&cl2xhtml ], faq => [ 'faq2html', \&faq2html ], log => [ 'cvs2xhtml', \&cvs2xhtml ], rpod => [ 'pod2thread', \&pod2html ]); # Figure out what to do with the input. if (-d) { $OUTPUT{$output} = 1; if (-e $output && !-d $output) { die "$0: cannot replace $output with a directory\n"; } elsif (!-d $output) { print "Creating $shortout\n"; mkdir ($output, 0755) or die "$0: mkdir $output failed: $!\n"; } if (-f "$_/.rss") { system ('spin-rss', '-b', $_, "$_/.rss") == 0 or die "$0: running spin-rss on $input/.rss failed\n"; } } elsif (/\.th$/) { $output =~ s/\.th$/.html/; $OUTPUT{$output} = 1; $shortout =~ s/\.th$/.html/; my $relative = $input; $relative =~ s%^\Q$SOURCE/%%; my $time = $DEPEND{$relative} || 0; if (-e $output) { return if (-M $_ >= -M $output && (stat $output)[9] >= $time); } print "Spinning $shortout\n"; spin ($_, $output); } else { my ($extension) = (/\.([^.]+)$/); if ($extension && $rules{$extension}) { my ($name, $sub) = @{ $rules{$extension} }; $output =~ s/\.\Q$extension\E$/.html/; $OUTPUT{$output} = 1; $shortout =~ s/\.\Q$extension\E$/.html/; my ($file, $options, $style) = read_pointer ($input); if (-e $output && -e $file) { return if (-M $file >= -M $output && -M $_ >= -M $output); } print "Running $name for $shortout\n"; &$sub ($file, $output, $options, $style); } else { $OUTPUT{$output} = 1; return unless (!-e $output || -M $_ < -M $output); print "Updating $shortout\n"; copy ($_, $output) or die "$0: copy of $input to $output failed: $!\n"; } } } # This routine is called for every file in the destination tree, if the user # requested file deletion of files not generated from the source tree. It # checks each file to see if it is in the %OUTPUT hash that was generated # during spin processing, and if not, removes it. It's called from within # File::Find and therefore uses the standard File::Find variables. sub delete_files { return if ($_ eq '.' || $_ eq '..'); my $file = $File::Find::name; my $shortfile = $file; $shortfile =~ s/^\Q$OUTPUT/.../; return if $OUTPUT{$file}; print "Deleting $shortfile\n"; if (-d $file) { rmdir $file or warn "$0: cannot remove directory $file: $!\n"; $File::Find::prune = 1; } else { unlink $file or die "$0: unable to remove $file: $!\n"; } } ############################################################################## # Main routine ############################################################################## $| = 1; $FULLPATH = $0; $0 =~ s%.*/%%; # Parse command-line options. my ($delete, @excludes, $filter, $help, $overrides, $version); $STYLES = ''; Getopt::Long::config ('bundling'); GetOptions ('d|delete' => \$delete, 'e|exclude=s' => \@excludes, 'f|filter' => \$filter, 'h|help' => \$help, 'o|overrides=s' => \$overrides, 's|style-url=s' => \$STYLES, 'v|version' => \$version) or exit 1; if ($help) { print "Feeding myself to perldoc, please wait....\n"; exec ('perldoc', '-t', $FULLPATH); } elsif ($version) { my $version = join (' ', (split (' ', $ID))[1..3]); $version =~ s/,v\b//; $version =~ s/(\S+)$/($1)/; $version =~ tr%/%-%; print $version, "\n"; exit; } $STYLES =~ s%/*$%/% if $STYLES; push (@EXCLUDES, map { qr/$_/ } @excludes); # Load overrides from the specified file, if desired. if ($overrides) { unless (do "$overrides") { if ($@) { die "$0: cannot load $overrides: $@\n"; } else { die "$0: cannot load $overrides: $!\n"; } } } # The arguments depend on whether -f is given. If it is, just filter stdin to # stdout; otherwise, take the input tree and the output tree on the command # line and process the input into the output. if ($filter) { if (@ARGV) { die "Usage: $0 -f\n" } spin ('-', '-'); } else { die "Usage: $0 []\n" unless (@ARGV >= 1 && @ARGV <= 2); ($SOURCE, $OUTPUT) = @ARGV; $OUTPUT ||= '-'; $OUTPUT =~ s%/+$%%; if (-f $SOURCE) { open (STDIN, $SOURCE) or die "$0: cannot open $SOURCE: $!\n"; if ($OUTPUT ne '-') { my (undef, $dir, $file) = File::Spec->splitpath ($OUTPUT); my $current = getcwd; chdir $dir or die "$0: cannot chdir to $dir: $!\n"; $OUTPUT = File::Spec->catpath ('', getcwd, $file); chdir $current or die "$0: cannot chdir to $current: $!\n"; open (STDOUT, "> $OUTPUT") or die "$0: cannot create $OUTPUT: $!\n"; } my (undef, $dir, $file) = File::Spec->splitpath ($SOURCE); my $current = getcwd; chdir $dir or die "$0: cannot chdir to $dir: $!\n"; $SOURCE = File::Spec->catpath ('', getcwd, $file); spin ('-', '-'); } else { die "$0: no output directory specified\n" if $OUTPUT eq '-'; if ($SOURCE !~ m%^/%) { my $current = getcwd; chdir $SOURCE or die "$0: cannot chdir to $SOURCE: $!\n"; $SOURCE = getcwd; chdir $current or die "$0: cannot chdir to $current: $!\n"; } if ($OUTPUT !~ m%^/%) { unless (-d $OUTPUT) { print "Creating $OUTPUT\n"; mkdir ($OUTPUT, 0755) or die "$0: cannot create $OUTPUT: $!\n"; } chdir $OUTPUT or die "$0: cannot chdir to $OUTPUT: $!\n"; $OUTPUT = getcwd; } read_sitemap ("$SOURCE/.sitemap"); read_versions ("$SOURCE/.versions"); if (-d "$SOURCE/.git") { eval { require Git::Repository; $REPO = Git::Repository->new (work_tree => $SOURCE); }; } $File::Find::dont_use_nlink = 1; if (-f "$SOURCE/.rss") { my $current = getcwd; chdir $SOURCE or die "$0: cannot chdir to $SOURCE: $!\n"; system ('spin-rss', '.rss') == 0 or die "$0: running spin-rss on $SOURCE/.rss failed\n"; chdir $current or die "$0: cannot chdir to $current: $!\n"; } find (\&process_file, $SOURCE); finddepth (\&delete_files, $OUTPUT) if $delete; } } ############################################################################## # Documentation ############################################################################## =head1 NAME spin - Translate thread, an HTML macro language, into XHTML =head1 SYNOPSIS spin [B<-dhv>] [B<-e> I ...] [B<-s> I] [B<-o> I] I [I] spin [B<-s> I] [B<-o> I] B<-f> =head1 REQUIREMENTS Perl 5.005 or later and the Image::Size and Text::Balanced modules. Also expects to find B, B, B, and B to convert certain types of files. The Git::Repository module is required to determine last change dates for thread source from Git history. =head1 DESCRIPTION B implements a fairly simple macro language that expands out into XHTML, as well as serving as a tool to maintain a set of web pages, updating a staging area with the latest versions, converting pages written in the macro language (named "thread"), and running B where directed. When invoked with the B<-f> option, B works in filter mode, reading thread from stdin and writing the converted output to stdout. Some features, such as appending a signature or navigation links, are disabled in this mode. If I is a regular file, I should be the name of the file into which to put the output, and B will process only that one file (which is assumed to be thread). I may be omitted to send the output to standard output. The same features are disabled in this mode as in filter mode. Otherwise, each file in the directory I is examined recursively. For each one, it is either copied verbatim into the same relative path under I, used as instructions to an external program (see the details on converters below), or converted to HTML. The HTML output for external programs or for converted pages is put under I with the same file name but with the extension changed to C<.html>. Missing directories are created. If the B<-d> flag is given, files and directories in the I directory that do not correspond to files in the I directory will be deleted. Files that end in C<.th> are assumed to be in thread and are turned into HTML. For the details of the thread language, see L below. Files that end in various other extensions are taken to be instructions to run an external converter on a file. The first line of such a pointer file should be the path to the source file, the second line any arguments to the converter, and the third line the style sheet to use if not the default. Which converter to run is based on the extension of the file as follows: .changelog cl2xhtml .faq faq2html .log cvs log | cvs2xhtml .rpod pod2thread | spin -f All other files not beginning with a period are copied as-is, except that files or directories named F, F, or F are ignored. As an exception, F<.htaccess> files are also copied over. B looks for a file named F<.sitemap> at the top of the I directory and reads it for navigation information to generate the navigation links at the top and bottom of each page. The format of this file is one line per web page, with indentation showing the tree structure, and with each line formatted as a partial URL, a colon, and a page description. If two pages at the same level aren't related, a line with three dashes should be put between them at the same indentation level. The partial URLs should start with / representing the top of the hierarchy (the I directory), but all generated links will be relative. Here's an example of a simple F<.sitemap> file: /personal/: Personal Information /personal/contact.html: Contact Information --- /personal/projects.html: Current Projects /links/: Links /links/lit.html: Other Literature /links/music.html: Music /links/sf.html: Science Fiction and Fantasy This defines two sub-pages of the top page, /personal/ and /links/. /personal/ has two pages under it that are not part of the same set (and therefore shouldn't have links to each other). /links/ has three pages under it which are part of a set and should be linked between each other. If F<.sitemap> is present, this navigation information will also be put into the section of the resulting HTML file as tags. Some browsers will display this information as a navigation toolbar. B also looks for a file named F<.signature> in the same directory as a thread file (and then at the top of the source tree if none is found in the current directory) and copies its contents verbatim into an

    block at the end of the XHTML page (so the contents should be valid XHTML). The contents will be surrounded by an
    tag, and added to the end of the supplied F<.signature> contents will be information about when the page was last modified and generated. B looks for a file named F<.versions> at the top of the I directory and reads it for version information. If it is present, each line should be of the form: