#!/usr/bin/perl # TODO somehow use

instead of

to make lynx happy use strict; use warnings; use HTML::Entities; use Cwd; use File::Basename; use L; my $title = $ARGV[0] || ""; $title =~ s/^(.*)\.(.*)$/$1/; $title =~ s{/?index$}{}; if ($title eq "") { $title = basename(getcwd()); } $title =~ s/[_-]/ /g; $title = encode_entities($title); my $head_extra_file = $ARGV[0]||''; $head_extra_file =~ s/\.[^.]+$//; $head_extra_file .= ".head"; my $head_extra = ""; if ($head_extra_file && -f $head_extra_file) { $head_extra = slurp($head_extra_file); chomp $head_extra; } print < $title $head_extra End use Cwd; my $hrefbase = ""; my $www = "/www"; # vhosts are under this (my $www_root = getcwd) =~ s{^($www/.*?)/.*}{$1}; my $ref_base = ""; my $rel = ""; my @table = (); my $in_tab_table = 0; my $in_tab_table_blank_lines = 0; my $in_pre = 0; while (<>) { if (/^#/) { next; } sub ahref { # normal (external) hyperlink my $href = $_[0]; my $cruft = ''; if ($href =~ s/([,.:;!?])$//) { $cruft = $1; } my $text = $href; $text =~ s/\?$//; $text =~ s/\/$//; $text =~ s/[-_+]/ /g; $text =~ s/\.(html|htm|txt|pdf|doc|rtf|jpe?g|png|gif|cgi)$// unless $text =~ m{://}; if ($href =~ /@/) { $href = "mailto:$href"; } elsif ($href =~ s{^/}{}) { $text =~ s{^/|/$}{}g; if (-d "$www_root/$href") { $href =~ s{/?$}{/}; } $href="$hrefbase/$href"; } elsif ($href =~ s{^\./}{}) { $text =~ s{^\./}{}; $text =~ s{/$}{}; if (-d $href) { $href =~ s{/?$}{/}; } if (! -e $href && -e lc $href) { $href = lc $href; } if (-l $href) { my $link_target = readlink $href; if ($link_target =~ m{://} or $link_target =~ m{^/}) { $href = $link_target; } } $href="$href"; } else { if ($href !~ m|://|) { if ($href !~ m:/:) { $href .= "/"; } if ($href =~ /^ftp/) { $href = "ftp://$href"; } else { $href = "http://$href"; } } # if ($href !~ /cards\.(sf|sourceforge)\.net/) { # ($hrefbase = $href) =~ s,([a-z]+://[^])\@'\s/]+).*,$1,; #' keep editor happy # } } my $href_ee = encode_entities($href); return qq{$text$cruft}; } sub href { # generic hyperlink - TODO relative? if ($_[0] =~ /^[0-9\W]$/) { return $_[0]; } # XXX this is broken my @args = split /;\s*/, $_[0], 3; my ($text, $rel, $object); $rel = ""; # XXX this is broken, fix it! if (@args == 1) { $text = $object = $args[0]; $text =~ s/^\.//; $text =~ s/\.$//; } elsif (@args == 2) { $text = $args[0]; # $rel = $text (implicit) $object = $args[1]; } else { ($text, $rel, $object) = @args; } if ($object !~ m|://|) { $object = canonicalise_ref($object); $object = "/cgi-bin/view?$object"; } if ($rel ne "") { $rel = qq{ rel="$rel"} } return qq{$text}; } sub ghref { # group my @args = split /;\s*/, $_[0], 2; my ($text, $object); if (@args == 1) { $text = $object = $args[0]; $text =~ s/^\.//; $text =~ s/\.$//; } else { ($text, $object) = @args; } if ($object !~ m|://|) { $object = canonicalise_ref($object); $object = "/cgi-bin/view?$object"; } return qq{$text}; } sub phref { # part my @args = split /;\s*/, $_[0], 2; my ($text, $object); if (@args == 1) { $text = $object = $args[0]; $text =~ s/^\.//; $text =~ s/\.$//; } else { ($text, $object) = @args; } if ($object !~ m|://|) { $object = canonicalise_ref($object); $object = "/cgi-bin/view?$object"; } return qq{$text}; } # s/^\t+//; tr/\r//d; s/ +$//mg; s/\&/&/g; s/<->/↔/g; s/->/→/g; s/<-/←/g; s//>/g; if (!$in_pre) { # these are broken XXX # s/\[(.*?)\]/href($1)/ge; # s/<(.*?)>]/ghref($1)/ge; # s/{(.*?)}]/phref($1)/ge; # email links s,([^:\@.\w"<]|^) ( #" [^\s=<>&;]+\@[\w.]+\.\w+ ),$1.ahref($2),gex; # normal links s,([^:\@.\w"<*]|^) ( #" [a-z]+://[^])\@'\s]+ | #' www\.[^])\@'=\s]+ | [^][^()\@`'=\s*~]+\.(net|com|org|info|gov|id|ki|de|se|ws)(\.\w\w)?(/[^])\@'\s]+|\b) | /[^])\@'\s]+/? | #' \./[^])\@'\s]+/? #' ),$1.ahref($2),gex; # our $wrap_delim = '[^:\@.\w"<=*]|^|$'; our $wrap_delim = '[^\@\w"<=*]|^|$'; our %wrap_rx; sub wrap2 { my ($x, $tag) = @_; (my $close = $tag) =~ s{(\S+).*}{}; my $open = "<$tag>"; my $return = "$open$x$close"; return $return; } sub wrap { my ($char, $tag) = @_; my $rx = $wrap_rx{$char} ||= qr{($wrap_delim)\Q$char\E(\S(?:.*?\S)?)\Q$char\E($wrap_delim)}; 1 while s{$rx}{$1.wrap2($2, $tag).$3}ges; } s{^____$}{
}; s{^________$}{
}; wrap("=", "h1"); 1 while s{(

.*?)(.*?

)}{$1$2}; wrap("*", "b"); wrap("_", "u"); wrap("~", "i"); wrap("!", 'span class="hi"'); sub object { my ($src, $align) = @_; my ($ext) = $src =~ /.*\.(.*)$/; $ext ||= ''; if ($ext =~ /^(png|jpg|jpeg|gif)$/i) { return img($src, $align); } elsif ($ext =~ /^(html|htm)$/i) { open my $file, "<$src" or die "can't open $src"; return join "", <$file>; } elsif ($ext =~ /^(txt)$/i) { open my $file, "<$src" or die "can't open $src"; return join "", <$file>; } } sub img { my ($src, $align) = @_; my $attr = ""; if ($align) { if ($align eq "<") { $attr = qq{ align="left" style="margin-right 1em"}; } elsif ($align eq ">") { $attr = qq{ align="right" style="margin-left: 1em"}; } } (my $alt = $src) =~ s/(.*)\..*/$1/; $alt =~ s/_/ /g; my $html = qq{$alt}; if ($src =~ m{(/|^)tn/}) { (my $href = $src) =~ s/tn\///; $html = qq{$html}; } if ($align && $align eq "-") { $html = qq{
$html
}; } return $html; } sub input { my ($name, $size, $type) = @_; my $value = ""; $size ||= 8; $size = qq{ style="width:${size}em;"}; $type ||= "text"; if ($type eq "?") { $type = "password"; } if ($type eq "!") { $type = "submit"; $size = ""; ($value = $name) =~ s/_/ /g; } if ($value) { $value = qq{ value="$value"}; } return qq{}; } s{<([?!])?(\d*)(\w+)>}{input($3,$2,$1)}ge; } if (s/^(\s*)([][{}()_\|;]|\(\(|\)\)|<|>|;;|__)\s*$//) { my $indent = $1; my $level = length($indent); my $what = $2; if ($what eq "[") { print qq{$indent \n}; if (!$in_tab_table) { $in_tab_table = 1; $_ = qq{
\n}; $table[$level] = 1; } elsif ($what eq "{") { print qq{$indent
\n}; $table[$level] = 1; } elsif ($what eq "(") { print qq{$indent
\n}; $table[$level] = 1; } elsif ($what eq "]" || $what eq "}") { print "$indent
\n"; $table[$level] = 0; } elsif ($what eq ")") { # print qq{$indent
\n}; print qq{$indent
\n}; $table[$level] = 0; } elsif ($what eq "((") { print qq{$indent
\n}; } elsif ($what eq "))") { print qq{$indent
\n}; } elsif ($what eq "_") { print qq{$indent
\n}; } elsif ($what eq "|") { print qq{$indent\n}; } elsif ($what eq ";") { print qq{$indent
\n}; } elsif ($what eq ";;") { print qq{$indent
\n}; } elsif ($what eq "__") { print qq{$indent
\n}; } elsif ($what eq "<") { print qq{$indent
};
			$in_pre = 1;
		} elsif ($what eq ">") {
			print qq{$indent
\n}; $in_pre = 0; } } if (!$in_pre) { s{\s\|\s}{
}g; if ($in_tab_table && $_ eq "\t\n") { $_ = ""; $in_tab_table_blank_lines++; } elsif (s{\t}{}g) { chomp; $_ = qq{
$_
\n$_}; } else { for my $i (1..$in_tab_table_blank_lines) { $_ = qq{ \n$_}; } } $in_tab_table_blank_lines = 0; } elsif ($in_tab_table) { $in_tab_table = 0; for my $i (1..$in_tab_table_blank_lines) { $_ = "\n$_"; } $_ = "

\n$_"; } s,^(\s*)(\*|-) ,$1• ,; s,(^|\S)\n,$1
\n,gm; s{(.*) \.{4} (.*) \.{4} ?(.*)
\n}{$1$3
$2
\n}; s{(.*) \.{4} (.*)
\n}{$1$2
\n}; s{\(\((.*?)\)\)}{$1}g; 1 while s, ,  ,; # s,\n, 
\n,g; s, \n,\n,g; s/^( +)/" "x(length($1))/gme; s{(\<|\>|-)?\[(.*?)\]}{object($2, $1)}ge; s{\bCO2\b}{CO2}g; # special hack for CO2! s{\bH2O\b}{H2O}g; # H20 for free, although I'm not using it yet. This could get unwieldly! s{^--
$}{
}; s{^←
$}{

}; s{^→
$}{

}; s{<<(.*?)>>}{$1}; s{^<"(.*?)"
$}{slurp($1)}e; } print; # print encode_entities($_); } if ($in_tab_table) { print "\n"; } print "\n"; exit; sub canonicalise_ref { my $object = $_[0]; if ($object =~ /\.$/) { $object = join ".", reverse split /\./, $object, -1; } if ($object =~ /^\./) { $object = "$ref_base$object"; } $object =~ s/^\.//; return $object; }