yhdev/index.cgi
Yorhel 7cf772d968 Should have committed earlier
Lots of changes:
- Article about IPC
- New TUWF release
- New ncdu release
- Atom feeds for the bug tracker
- Bug tracker switch to sqlite
2016-06-18 15:18:27 +02:00

572 lines
24 KiB
Perl
Executable file

#!/usr/bin/perl
use strict;
use warnings;
use utf8;
use TUWF ':html', ':xml';
use POSIX 'strftime';
use Cwd 'abs_path';
our $ROOT;
BEGIN { ($ROOT = abs_path $0) =~ s{index\.cgi$}{}; }
my @changes = (
[ '2015-09-27', '/tuwf', 'TUWF 1.0 released' ],
[ '2015-04-05', '/ncdu', 'ncdu 1.11 released' ],
[ '2014-07-29', '/doc/easyipc', 'New article: The Sorry State of Convenient IPC' ],
[ '2014-06-25', '/doc', 'Uploaded my masters thesis' ],
[ '2014-04-23', '/ncdc', 'ncdc 1.19.1 released' ],
[ '2014-02-11', '/ncdc', 'ncdc 1.19 released' ],
[ '2014-01-09', '/doc/dcstats', 'Uploaded an article on DC file list stats' ],
[ '2013-11-14', '/yxml/man', 'yxml now has a manual' ],
[ '2013-10-05', '/ncdc', 'ncdc 1.18.1 released' ],
[ '2013-09-25', '/ncdc', 'ncdc 1.18 released' ],
[ '2013-09-03', '/yxml', 'Announcing yxml: A small, fast and correct XML parser' ],
[ '2013-07-05', '/dump/insbench', 'Documented a little data structure benchmark' ],
[ '2013-06-15', '/ncdc', 'ncdc 1.17 released' ],
[ '2013-05-09', '/ncdu', 'ncdu 1.10 released' ],
[ '2013-04-04', '/ylib', 'Created a page for Ylib' ],
[ '2013-04-03', '/ncdc', 'Created a mailing list for ncdc' ],
[ '2013-03-23', '/ncdc', 'ncdc 1.16.1 released.' ],
[ '2013-03-02', '/ncdc', 'ncdc 1.15 released.' ],
[ '2012-12-15', '/globster', 'Announcing yet another awesome project: Globster!' ],
[ '2012-12-02', '/ncdu/jsonfmt', 'Documented the ncdu export file format' ],
[ '2012-11-04', '/ncdc', 'ncdc 1.14 released' ],
[ '2012-10-17', '/dump', 'Added reference to my repo of small C libs to the code dump' ],
[ '2012-10-07', '/dump#maildir.pl','Added maildir.pl to the code dump' ],
[ '2012-09-27', '/ncdu', 'ncdu 1.9 released.' ],
[ '2012-09-25', '/dump#dbusev.c', 'Added dbusev.c to the code dump' ],
[ '2012-08-16', '/ncdc', 'ncdc 1.13 released.' ],
[ '2012-07-10', '/ncdc', 'ncdc 1.12 released.' ],
[ '2012-05-15', '/ncdc', 'ncdc 1.11 released.' ],
[ '2012-05-03', '/ncdc/install', 'Added installation instructions for ncdc.' ],
[ '2012-05-03', '/ncdc', 'ncdc 1.10 released.' ],
[ '2012-04-10', undef, 'Minor site re-style: ncdu/ncdc/tuwf now have their own menu.' ],
[ '2012-03-30', '/dump', 'Updated ncdc-share-report for Go 1' ],
[ '2012-03-24', '/ncdu/bug', 'Moved ncdu bug tracker from sourceforge to this site' ],
[ '2012-03-17', '/ncdc/bug', 'Wrote a small bug tracker for ncdc' ],
[ '2012-03-14', '/ncdc', 'ncdc 1.9 released.' ],
[ '2012-02-15', '/doc/commvis', 'Added an article on my new communication system.' ],
[ '2012-02-13', '/ncdc', 'ncdc 1.8 released.' ],
[ '2012-01-19', '/tuwf', 'TUWF 0.2 released.' ],
[ '2012-01-17', undef, 'Complete site redesign.' ],
[ '2011-12-30', '/ncdc', 'ncdc 1.7 released!' ],
[ '2011-12-07', '/ncdc', 'ncdc 1.6 released!' ],
[ '2011-11-26', '/doc', 'Added article section and the article on SQLite.' ],
[ '2011-11-03', '/ncdu', 'ncdu 1.8 released!' ],
[ '2011-11-03', '/ncdc', 'ncdc 1.5 released!' ],
[ '2011-10-26', '/ncdc', 'ncdc 1.4 released!' ],
[ '2011-10-19', undef, 'PGP-signed all releases of ncdu, ncdc and TUWF.' ],
[ '2011-10-14', '/ncdc', 'ncdc 1.3 released!' ],
[ '2011-09-25', '/ncdc', 'ncdc 1.1 released - follwed by a 1.2 quickfix.' ],
[ '2011-09-16', '/ncdc', 'ncdc 1.0 released!' ],
[ '2011-09-15', '/ncdc/scr', 'Added some screenshots for ncdu.' ],
[ '2011-09-03', '/ncdc', 'ncdc 0.9 released!' ],
[ '2011-08-26', '/ncdc', 'ncdc 0.8 released!' ],
[ '2011-08-17', '/ncdc', 'ncdc 0.7 released!' ],
[ '2011-08-08', '/ncdc', 'ncdc 0.6 released & user guide updated' ],
[ '2011-08-02', '/ncdc', 'ncdc 0.5 released!' ],
[ '2011-07-23', '/ncdc', 'ncdc 0.4 released!' ],
[ '2011-07-15', '/ncdc', 'ncdc 0.3 released!' ],
[ '2011-06-27', '/ncdc', 'ncdc 0.2 released!' ],
[ '2011-06-20', '/ncdc', 'ncdc 0.1 released! And wrote a user guide for it.' ],
[ '2011-06-11', '/dump/nccolour', 'Added NCurses colour experiment' ],
[ '2011-06-03', '/ncdc', 'Added my latest project: ncdc' ],
[ '2011-02-07', '/tuwf', 'TUWF 0.1 released and now also available on CPAN' ],
[ '2011-01-27', '/tuwf', 'Documented and uploaded one of my older projects: TUWF' ],
[ '2011-01-09', '/dump', 'Added my json.mll OCaml library to code dump' ],
[ '2010-08-13', '/ncdu', 'ncdu 1.7 released!' ],
[ '2009-12-22', '/dump', 'Added vinfo.c script to code dump' ],
[ '2009-10-23', '/ncdu', 'ncdu 1.6 released!' ],
[ '2009-09-21', undef, 'Tiny CSS fix to make this site look good in certain configurations.' ],
[ '2009-05-02', '/ncdu', 'ncdu 1.5 released!' ],
[ '2009-04-30', undef, 'Site redesign and reorganisation.' ],
);
my %feeds = map +($_,1), qw|ncdc ncdu globster tuwf yxml|;
my $feedreg = join '|', keys %feeds;
TUWF::register(
qr{} => sub { podpage(shift, 'home', '', '', "Yorhel's Projects") },
qr{ncdu} => sub { podpage(shift, 'ncdu', 'ncdu', '', 'NCurses Disk Usage') },
qr{ncdu/man} => sub { podpage(shift, 'ncdu-man', 'ncdu', 'man', 'Ncdu Manual', 1) },
qr{ncdu/changes} => sub { changelog(shift, 'ncdu-changelog', 'ncdu', 'ncdu', 'changes', 'Ncdu Changelog') },
qr{ncdu/scr} => sub { podpage(shift, 'ncdu-scr', 'ncdu', 'scr', 'Ncdu Screenshots') },
qr{ncdu/jsonfmt} => sub { podpage(shift, 'ncdu-jsonfmt', 'ncdu', 'jsonfmt', 'Ncdu Export File Format') },
qr{ncdc} => sub { podpage(shift, 'ncdc', 'ncdc', '', 'NCurses Direct Connect') },
qr{ncdc/faq} => sub { podpage(shift, 'ncdc-faq', 'ncdc', 'faq', 'Ncdc Q&A', 1) },
qr{ncdc/scr} => sub { podpage(shift, 'ncdc-scr', 'ncdc', 'scr', 'Ncdc Screenshots') },
qr{ncdc/man} => sub { podpage(shift, 'ncdc-man', 'ncdc', 'man', 'Ncdc Manual', 1) },
qr{ncdc/install} => sub { podpage(shift, 'ncdc-install', 'ncdc', 'install', 'Ncdc Installation Instructions', 1) },
qr{ncdc/changes} => sub { changelog(shift, 'ncdc-changelog', 'ncdc', 'ncdc', 'changes', 'Ncdc Changelog') },
qr{globster} => sub { podpage(shift, 'globster', 'globster', '', 'The Globster Direct Connect Client') },
qr{globster/api} => sub { podpage(shift, 'globster-api', 'globster', 'api', 'The Globster D-Bus API', 1) },
qr{globster/daemon} => sub { podpage(shift, 'globster-daemon', 'globster', 'daemon', 'The globster(1) Man Page', 1) },
qr{globster/launch} => sub { podpage(shift, 'globster-launch', 'globster', 'launch', 'The globster-launch(1) Man Page', 1) },
qr{globster/ctl} => sub { podpage(shift, 'globster-ctl', 'globster', 'ctl', 'The globsterctl(1) Man Page', 1) },
qr{tuwf} => sub { podpage(shift, 'tuwf', 'tuwf', '', 'The Ultimate Website Framework') },
qr{tuwf/man(?:/(db|misc|request|response|xml))?} => \&tuwfmanual,
qr{tuwf/changes} => sub { changelog(shift, 'tuwf-changelog', 'TUWF', 'tuwf', 'changes', 'TUWF Changelog') },
qr{ylib} => sub { podpage(shift, 'ylib/README.pod', 'ylib', '', 'Ylib') },
qr{yxml} => sub { podpage(shift, 'yxml', 'yxml', '', 'Yxml - A small, fast and correct* XML parser') },
qr{yxml/man} => sub { podpage(shift, 'yxml-man', 'yxml', 'man', 'Yxml Manual', 1) },
qr{doc} => sub { podpage(shift, 'doc', 'doc', '', 'Writing') },
qr{doc/sqlaccess} => sub { podpage(shift, 'sqlaccess', 'doc', '', 'Multi-threaded Access to an SQLite3 Database', 1) },
qr{doc/commvis} => sub { podpage(shift, 'doc-commvis', 'doc', '', 'A Distributed Communication System for Modular Applications', 1) },
qr{doc/dcstats} => sub { podpage(shift, 'doc-dcstats', 'doc', '', 'Some Measurements on Direct Connect File Lists', 1) },
qr{doc/easyipc} => sub { podpage(shift, 'doc-easyipc', 'doc', '', 'The Sorry State of Convenient IPC', 1) },
qr{dump} => sub { podpage(shift, 'dump', 'dump', '', 'Code dump') },
qr{demo} => sub { podpage(shift, 'dump-demo', 'dump', 'demo', 'Demos') },
qr{dump/awshrink} => sub { podpage(shift, 'dump-awshrink', 'dump', 'awshrink', 'AWStats Data File Shrinker') },
qr{dump/grenamr} => sub { podpage(shift, 'dump-grenamr', 'dump', 'grenamr', 'GTK+ Mass File Renamer') },
qr{dump/nccolour} => sub { podpage(shift, 'dump-nccolour', 'dump', 'nccolour', 'Colours in NCurses') },
qr{dump/insbench} => sub { podpage(shift, 'dump-insbench', 'dump', 'insbench', 'Insertion Performance Benchmarks') },
qr{(?:($feedreg)/)?feed\.atom} => \&atom,
qr{(ncdc|ncdu|globster|yxml)/bug} => \&bug_list,
qr{(ncdc|ncdu|globster|yxml)/bug/feed\.atom} => \&bug_atom,
qr{(ncdc|ncdu|globster|yxml)/bug/post} => \&bug_post,
qr{(ncdc|ncdu|globster|yxml)/bug/new} => \&bug_new,
qr{(ncdc|ncdu|globster|yxml)/bug/([1-9][0-9]*)} => \&bug_item,
);
TUWF::set(
logfile => '/var/log/apache2/tuwf.log',
error_404_handler => \&notfound,
mail_from => 'Yorhels Bug Tracker <projects@yorhel.nl>',
# this is a fairly static site, allow some aggressive caching
pre_request_handler => sub { $_[0]->resHeader('Cache-Control', 's-max-age=86400, max-age=3600'); 1; },
cookie_defaults => { domain => 'dev.yorhel.nl', path => '/', secure => 1 },
db_login => [ undef, undef, undef ],
);
TUWF::run();
sub podpage {
my($s, $f, $p, $se, $t, $toc) = @_;
$s->htmlHeader(title => $t, page => $p, sec => $se);
$s->htmlPOD($f, $toc);
$s->htmlFooter;
}
sub changelog {
my($s, $f, $pr, $p, $se, $t) = @_;
$s->htmlHeader(title => $t, page => $p, sec => $se);
open my $F, '<', "$ROOT/dat/$f" or die $!;
ul;
for my $v (split /\n\n/, join '', <$F>) {
$v =~ s/^([0-9]+\.[0-9]+(?:\.[0-9]+)?)\s+-\s+([0-9]{4}-[0-9]{2}-[0-9]{2})//;
li style => 'list-style-type: none; margin: 0';
b $1;
txt " - $2 - ";
lit $s->genDLLink("$pr-$1.tar.gz");
br;
ul;
for (split(/\r?\n\s+-\s+/, $v)) {
s/[\r\n\s]{2,50}/ /;
li $_ if $_;
}
end;
br;
end;
}
end;
close $F;
$s->htmlFooter;
}
sub tuwfmanual {
my $s = shift;
my $man = shift || '';
my %mod = (qw|db DB xml XML|);
my $mod = 'TUWF';
$mod .= '/'.($mod{$man} || ucfirst $man) if $man;
(my $pm = $mod) =~ s/\//::/;
$s->htmlHeader(title => $pm.' Documentation', page => 'tuwf', sec => 'man', sec2 => $man);
(my $f = $INC{"$mod.pm"}) =~ s/\.pm$/.pod/;
$s->htmlPOD($f, 1);
$s->htmlFooter;
}
sub atom {
my $s = shift;
my $sub = shift;
my $t = (stat("$ROOT/index.cgi"))[9];
$s->resHeader('Last-Modified' => strftime '%a, %d %b %Y %H:%M:%S GMT', gmtime $t);
$s->resHeader('Content-Type' => 'application/atom+xml');
xml;
tag feed => xmlns => 'http://www.w3.org/2005/Atom', 'xml:lang' => 'en', 'xml:base' => 'https://dev.yorhel.nl/';
tag title => $sub ? "\u$sub Project Announcements" : "Yorhel's Projects";
tag updated => strftime('%Y-%m-%dT%H:%M:%SZ', gmtime $t);
tag id => "https://dev.yorhel.nl/feed.atom";
tag link => rel => 'self', type => 'application/atom+xml', href => "https://dev.yorhel.nl/feed.atom", undef;
tag link => rel => 'alternate', type => 'text/html', href => 'https://dev.yorhel.nl/', undef;
my $n = 0;
for(@changes) {
next if $sub && (!$_->[1] || $_->[1] !~ /^\/\Q$sub/);
last if $n++ >= 10;
tag 'entry';
tag id => 'https://dev.yorhel.nl'.($_->[1]||'/').'#'.$_->[0];
tag title => $_->[2];
tag updated => $_->[0].'T12:00:00Z';
tag published => $_->[0].'T12:00:00Z';
tag 'author';
tag name => 'Yoran Heling';
tag uri => 'https://dev.yorhel.nl/';
tag email => 'projects@yorhel.nl';
end;
tag link => rel => 'alternate', type => 'text/html', href => 'https://dev.yorhel.nl'.($_->[1]||'/'), undef;
end 'entry';
}
end 'feed';
}
sub notfound {
my $s = shift;
my $u = lc $s->reqPath;
($_->[0] eq $u || $_->[0] eq "$u/") && return $s->resRedirect($_->[1], 'perm') for (
[ '/bluecubes', '/demo' ],
[ '/ncdc/guide', '/ncdc/man' ],
[ '/dump', '/dump' ],
[ '/dump/index2', '/dump' ],
[ '/dump/pmdc2-parse', '/dump' ],
[ '/dump/cbbcode', '/dump' ],
[ '/dump/cechoserv', '/dump' ],
[ '/dump/cyapong', '/dump' ],
[ '/dump/awshrink', '/dump/awshrink' ],
[ '/dump/grenamr', '/dump/grenamr' ],
);
return $s->resRedirect("$u", 'perm') if $u =~ s/\/$//;
return $s->resRedirect("/$1/bug$2", 'perm') if $u =~ /^(ncd[uc])\/issue(.*)$/;
$s->resStatus(404);
$s->htmlHeader(title => '404', page => '404');
txt 'Sorry, there is no page at this URI. Try one of the links from the menu to find the page you are looking for.';
$s->htmlFooter;
}
# Bug tracker
sub _bug_init {
require "$ROOT/Bug.pm";
my($s, $p) = @_;
$s->resHeader('Cache-Control', 'no-cache');
#$s->_load_module('TUWF::DB');
#$s->{_TUWF}{db_login} = [ undef, undef, undef ];
#$s->dbInit;
return TUWF::Bug->new(table => $p, admins => [ $ENV{ISSUE_CODE} ]);
}
sub bug_list {
my($s, $p) = @_;
my $is = _bug_init(@_);
$s->htmlHeader(title => "\u$p Bug tracker", page => $p, sec => 'bug');
br; a href => "/$p/bug/new", 'Report new bug';
p class => 'bug_filter';
txt 'filter{';
my $cl = $s->reqParam('cl')||0;
a href => "/$p/bug", 'open' if $cl;
txt 'open' if !$cl;
txt '/';
a href => "/$p/bug?cl=1", 'closed' if $cl != 1;
txt 'closed' if $cl == 1;
txt '/';
a href => "/$p/bug?cl=2", 'all' if $cl != 2;
txt 'all' if $cl == 2;
txt '}';
end;
$is->htmlListing((scalar $is->dbListing(closed => $cl)), sub { "/$p/bug/".shift });
br; a href => "/$p/bug/new", 'Report new bug'; br; br;
$s->htmlFooter;
}
sub bug_atom {
my($s, $p) = @_;
my $is = _bug_init(@_);
$is->atomFeed(sub { "https://dev.yorhel.nl/$p/bug/".shift });
}
sub bug_new {
my($s, $p) = @_;
my $is = _bug_init(@_);
$s->htmlHeader(title => "\u$p: Report new bug", page => $p, sec => 'bug');
br; a href => "/$p/bug", 'Back to the bug index'; br; br;
$is->htmlForm(undef, "/$p/bug/post");
$s->htmlFooter;
}
sub bug_post {
my($s, $p) = @_;
return $s->resNotFound if $s->reqMethod() ne 'POST';
my $is = _bug_init($s, $p);
my($f, $l) = $is->handleForm(sub { "/$p/bug/".shift });
if($f->{_err}) {
$s->htmlHeader(title => 'Error creating message', page => $p, sec => 'bug');
p 'There was an error in the form. Please use the \'back\' button of your
browser to go back to the form (hopefully) without losing your message.
There was an error in the following fields: '.join(', ', map {(my$f=$_->[0])=~s/bug_// ;"\u$f"} @{$f->{_err}}).'.';
return $s->htmlFooter;
}
# Announce this report to the ncdc hub, through the globster bot
#eval {
# $ENV{DBUS_SESSION_BUS_ADDRESS} = 'unix:path=/tmp/dbus-globster';
# require Net::DBus;
# my $msg = "Bug activity for $p: $l->{summary} -> https://dev.yorhel.nl/$p/bug/$l->{issue}";
# Net::DBus->find->get_service("net.blicky.Globster")->get_object("/net/blicky/Globster/Hub/1")->SendChat(-1, $msg, 0);
# 1;
#} || warn $@;
}
sub bug_item {
my($s, $p, $i) = @_;
my $is = _bug_init($s, $p);
my $item = $is->dbItem($i);
return $s->resNotFound if !@$item;
my $last = $item->[$#$item];
$s->htmlHeader(title => "\u$p: $last->{summary}", page => $p, sec => 'bug');
br; a href => "/$p/bug", 'Back to the bug index'; br; br;
$is->htmlItem($item);
$is->htmlForm($last, "/$p/bug/post");
br; a href => "/$p/bug", 'Back to the bug index'; br; br;
$s->htmlFooter;
}
package TUWF::Object;
use TUWF ':html';
# Accepts some special formatting codes:
# [dllink $file $title]
# [img $class $file $alt]
# [html]..É
# [yh-changes]
sub htmlPOD {
my($s, $file, $toc) = @_;
require Pod::Simple::HTML;
{
# The usual output escaping function is terribly stupid
no warnings 'redefine', 'once';
*Pod::Simple::HTML::esc = sub {
return map TUWF::XML::html_escape($_), @_ if wantarray;
return TUWF::XML::html_escape($_[0]) if defined wantarray;
$_ = TUWF::XML::html_escape($_) for(@_);
return @_;
};
# Let's override the manual page links
*Pod::Simple::HTML::do_man_link = sub {
my $l = $_[1]->attr('to');
my %l = qw|
globsterctl(1) /globster/ctl
globster-launch(1) /globster/launch
globster(1) /globster/daemon
globster-api(7) /globster/api
|;
return $l{$l} || ($l =~ /(.+)\((.)\)/ and "http://manned.org/$1.$2");
};
}
my $p = Pod::Simple::HTML->new();
my $html = '';
$p->html_header_before_title('<!--');
$p->html_header_after_title('-->');
$p->html_footer('');
$p->parse_characters(1);
$p->output_string(\$html);
$p->{podhtml_LOT} = {
'TUWF' => '/tuwf/man',
'TUWF::DB' => '/tuwf/man/db',
'TUWF::Misc' => '/tuwf/man/misc',
'TUWF::Request' => '/tuwf/man/request',
'TUWF::Response' => '/tuwf/man/response',
'TUWF::XML' => '/tuwf/man/xml',
};
open(my $F, '<:utf8', $file =~ /^\// ? $file : "$ROOT/dat/$file") or die $!;
$p->parse_file($F);
close $F;
lit $p->index_as_html() if $toc;
$html =~ s/\[dllink ([^ ]+)(?: ([^>]+))?\]/$s->genDLLink($1, $2)/eg;
$html =~ s/\[img ([^ ]+) ([^ ]+) ([^\]]*)\]/<img src="\/img\/$2" class="$1" alt="$3" \/>/g;
$html =~ s{\[html\](.*)É}{(my $h = $1) =~ s/\&gt;/>/g; $h =~ s/\&lt;/</g; $h =~ s/\&amp;/\&/g; $h =~ s/\&quot;/"/g; $h}egs;
$html =~ s/\[yh-changes\]/$s->genChanges()/e;
$html =~ s/<pre>( +(?:method|signal|property)) /<pre class="interface">$1 /g;
lit $html;
}
sub genDLLink {
my($s, $f, $m) = @_;
return sprintf
'<a href="/download/%s">%s</a>'
.'<b class="sig"><a href="/download/%1$s.asc">pgp</a>-<a href="/download/%1$s.sha1">sha1</a>-<a href="/download/%1$s.md5">md5</a></b>',
$f, $f||$m;
}
# Generate the changelog HTML for this website
sub genChanges {
return join "\n", map {
"<code>$_->[0] </code>"
.($_->[1]?qq{<a href="$_->[1]">}:'')
.TUWF::XML::html_escape($_->[2])
.($_->[1]?'</a>':'')
.'<br />';
} @changes;
}
sub htmlHeader {
my $s = shift;
my %o = (
spec => { map +($_,1), qw|ncdu ncdc globster tuwf yxml| },
page => '',
sec => '',
sec2 => '',
@_
);
html;
head;
Link rel => 'stylesheet', href => '/style.css', type => 'text/css', media => 'all';
Link rel => 'alternate', type => 'application/atom+xml', href => ($feeds{$o{page}||''} ? "/$o{page}" : '').'/feed.atom', title => 'Site updates';
title $o{title};
end;
body;
div id => 'body';
div id => 'uglyhack', ' ';
div id => 'left';
$s->htmlMenu(%o);
div class => 'notes';
txt 'Yoran Heling'; br;
a href => 'mailto:projects@yorhel.nl', 'projects@yorhel.nl';
br; a href => 'https://yorhel.nl', 'home';
txt ' - '; a href => 'http://g.blicky.net', 'git repos';
br; b '= donate =';
a href => 'https://www.paypal.com/cgi-bin/webscr?cmd=_donations&business=BBF8LGT2LLNFN&lc=US&currency_code=EUR&bn=PP%2dDonationsBF%3abtn_donate_SM%2egif%3aNonHosted', 'paypal';
br; b '= pgp =';
a href => 'https://yorhel.nl/key.asc', 'key';
txt ' - '; a href => 'http://pgp.mit.edu:11371/pks/lookup?search=0x8c2739fa', 'mit';
br; i '7446 0D32 B808 10EB A9AF A2E9 6239 4C69 8C27 39FA';
end;
img id => 'scissors', src => '/img/scissors.png', alt => 'Cute decorative scissors, cutting through your code.';
end 'div';
div id => 'main';
h1 class => 'title', $o{title};
}
sub htmlFooter {
end 'div'; # main
div id => 'footer';
p 'all lefts and rights reversed';
end;
end 'div'; # body
end 'body';
end 'html';
}
sub htmlMenu {
my($s, %o) = @_;
h1 class => 'title', "~ \u$o{page} ~" if $o{spec}{$o{page}};
my $m = sub {
li;
my $s = ($_[0] =~ m{^/([^/]+)} && $o{spec}{$1} && $o{page} ne $1) || $_[0] =~ m{^http://};
my @c = ($s?'special':(), $_[2]?'menusel':(), $_[4]?'tiny':());
a href => $_[0], @c?(class => join ' ',@c):(), $_[1];
if($_[3]) {
ul;
$_[3]->();
end;
}
end;
};
ul;
if($o{page} eq 'ncdu') {
$m->('/ncdu', 'Info', !$o{sec});
$m->('/ncdu/man', 'Manual', $o{sec} eq 'man', sub {
$m->('/ncdu/jsonfmt','File Format', $o{sec} eq 'jsonfmt');
});
$m->('/ncdu/changes', 'Changelog', $o{sec} eq 'changes');
$m->('/ncdu/scr', 'Screenshots', $o{sec} eq 'scr');
$m->('/ncdu/bug', 'Bug tracker', $o{sec} eq 'bug');
} elsif($o{page} eq 'ncdc') {
$m->('/ncdc', 'Info', !$o{sec});
$m->('/ncdc/install', 'Installation',$o{sec} eq 'install');
$m->('/ncdc/faq', 'Q&A', $o{sec} eq 'faq');
$m->('/ncdc/man', 'Manual', $o{sec} eq 'man');
$m->('/ncdc/changes', 'Changelog', $o{sec} eq 'changes');
$m->('/ncdc/scr', 'Screenshots', $o{sec} eq 'scr');
$m->('/ncdc/bug', 'Bug tracker', $o{sec} eq 'bug');
$m->('http://l.blicky.net/listinfo/ncdc', 'Mailing list ');
} elsif($o{page} eq 'globster') {
$m->('/globster', 'Info', !$o{sec});
$m->('/globster/daemon', 'Commands', (scalar $o{sec} =~ /(daemon|ctl|launch)/), sub {
$m->('/globster/daemon', 'globster', $o{sec} eq 'daemon', undef, 1);
$m->('/globster/ctl', 'globsterctl', $o{sec} eq 'ctl', undef, 1);
$m->('/globster/launch', 'globster-launch', $o{sec} eq 'launch', undef, 1);
});
$m->('/globster/api', 'API Doc', $o{sec} eq 'api');
$m->('/globster/bug', 'Bug tracker', $o{sec} eq 'bug');
} elsif($o{page} eq 'tuwf') {
$m->('/tuwf', 'Info', !$o{sec});
$m->('/tuwf/man', 'Manual', $o{sec} eq 'man', sub {
$m->('/tuwf/man', 'Main', $o{sec} eq 'man' && !$o{sec2});
$m->('/tuwf/man/db', '::DB', $o{sec} eq 'man' && $o{sec2} eq 'db');
$m->('/tuwf/man/misc', '::Misc', $o{sec} eq 'man' && $o{sec2} eq 'misc');
$m->('/tuwf/man/request', '::Request', $o{sec} eq 'man' && $o{sec2} eq 'request');
$m->('/tuwf/man/response', '::Response', $o{sec} eq 'man' && $o{sec2} eq 'response');
$m->('/tuwf/man/xml', '::XML', $o{sec} eq 'man' && $o{sec2} eq 'xml');
});
$m->('/tuwf/changes', 'Changelog', $o{sec} eq 'changes');
} elsif($o{page} eq 'yxml') {
$m->('/yxml', 'Info', !$o{sec});
$m->('/yxml/man', 'Manual', $o{sec} eq 'man');
$m->('/yxml/bug', 'Bug tracker', $o{sec} eq 'bug');
} else {
$m->('/', 'Home', !$o{page});
$m->('/ncdu', 'Ncdu ');
$m->('/ncdc', 'Ncdc ');
$m->('/globster', 'Globster ');
$m->('/tuwf', 'Tuwf ');
$m->('/yxml', 'Yxml ');
$m->('/ylib', 'Ylib', $o{page} eq 'ylib');
$m->('/doc', 'Writing', $o{page} eq 'doc');
$m->('/dump', 'Code dump', $o{page} eq 'dump', sub {
$m->('/dump', 'Misc.', $o{page} eq 'dump' && !$o{sec});
$m->('/demo', 'Demos', $o{page} eq 'dump' && $o{sec} eq 'demo');
$m->('/dump/awshrink','AWShrink', $o{page} eq 'dump' && $o{sec} eq 'awshrink');
$m->('/dump/grenamr', 'Grenamr', $o{page} eq 'dump' && $o{sec} eq 'grenamr');
$m->('/dump/nccolour','NC-Colour', $o{page} eq 'dump' && $o{sec} eq 'nccolour');
$m->('/dump/insbench','Ins-bench', $o{page} eq 'dump' && $o{sec} eq 'insbench');
});
}
if($o{spec}{$o{page}}) {
li;
a href => '/', class => 'small special', 'Projects home ';
end;
}
end;
}