#!/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 = ( [ '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.' ], ); 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') }, 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{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/changes} => sub { changelog(shift, 'ncdc-changelog', 'ncdc', 'ncdc', 'changes', 'Ncdc Changelog') }, 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{doc} => sub { podpage(shift, 'doc', 'doc', '', 'Articles') }, 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{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{feed\.atom} => \&atom, ); TUWF::set( logfile => '/www/err.log', error_404_handler => \¬found, # 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; }, ); 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]+)\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 $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' => 'http://dev.yorhel.nl/'; tag title => "Yorhel's Projects"; tag updated => strftime('%Y-%m-%dT%H:%M:%SZ', gmtime $t); tag id => "http://dev.yorhel.nl/feed.atom"; tag link => rel => 'self', type => 'application/atom+xml', href => "http://dev.yorhel.nl/feed.atom", undef; tag link => rel => 'alternate', type => 'text/html', href => 'http://dev.yorhel.nl/', undef; for(@changes) { tag 'entry'; tag id => 'http://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 => 'http://dev.yorhel.nl/'; tag email => 'projects@yorhel.nl'; end; tag link => rel => 'alternate', type => 'text/html', href => 'http://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/\/$//; $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; } 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 @_; }; } my $p = Pod::Simple::HTML->new(); my $html = ''; $p->html_header_before_title(''); $p->html_footer(''); $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 ([^ ]+) ([^ ]+) ([^\]]*)\]/$3/g; $html =~ s{\[html\](.*)É}{(my $h = $1) =~ s/\>/>/g; $h =~ s/\</genChanges()/e; lit $html; } sub genDLLink { my($s, $f, $m) = @_; return sprintf '%s' .'pgp-sha1-md5', $f, $f||$m; } # Generate the changelog HTML for this website sub genChanges { return join "\n", map { "$_->[0] " .($_->[1]?qq{}:'') .TUWF::XML::html_escape($_->[2]) .($_->[1]?'':'') .'
'; } @changes; } sub htmlHeader { my $s = shift; my %o = (page => '', sec => '', sec2 => '', @_ ); html; head; style type => 'text/css'; $s->printCSS; end; Link rel => 'alternate', type => 'application/atom+xml', href => '/feed.atom', title => 'Site updates'; title $o{title}; end; body; div id => 'body'; div id => 'uglyhack', ' '; div id => 'left'; h1 class => 'title', '~ Menu ~'; $s->htmlMenu(%o); div class => 'notes'; a href => 'mailto:projects@yorhel.nl', 'projects@yorhel.nl'; br; a href => 'http://yorhel.nl', 'yh'; txt ' - '; a href => 'http://g.blicky.net', 'git'; txt ' - '; a href => 'http://pgp.mit.edu:11371/pks/lookup?search=0x8c2739fa', 'pgp'; br;br; lit q|
|; end; end 'div'; div id => 'main'; h1 class => 'title', $o{title}; } sub htmlFooter { end 'div'; # main div id => 'footer'; p 'end-of-file'; end; end 'div'; # body end 'body'; end 'html'; } sub htmlMenu { my($s, %o) = @_; my $m = sub { li; a href => $_[0], $_[0]!~/^\//?(class=>'external'):$_[2]?(class=>'menusel'):(), $_[1]; if($_[2] && $_[3]) { ul; $_[3]->(); end; } end; }; ul; $m->('/', 'Home', !$o{page}); $m->('/ncdu', 'Ncdu', $o{page} eq 'ncdu', sub { $m->('/ncdu', 'Info', !$o{sec}); $m->('/ncdu/man', 'Manual', $o{sec} eq 'man'); $m->('/ncdu/changes', 'Changelog', $o{sec} eq 'changes'); $m->('/ncdu/scr', 'Screenshots', $o{sec} eq 'scr'); $m->('http://sourceforge.net/tracker/?group_id=200175', 'Bug tracker '); }); $m->('/ncdc', 'Ncdc', $o{page} eq 'ncdc', sub { $m->('/ncdc', 'Info', !$o{sec}); $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->('/tuwf', 'Tuwf', $o{page} eq 'tuwf', sub { $m->('/tuwf', 'Info', !$o{sec}); $m->('/tuwf/man', 'Manual', $o{sec} eq 'man', sub { $m->('/tuwf/man', 'Main', !$o{sec2}); $m->('/tuwf/man/db', '::DB', $o{sec2} eq 'db'); $m->('/tuwf/man/misc', '::Misc', $o{sec2} eq 'misc'); $m->('/tuwf/man/request', '::Request', $o{sec2} eq 'request'); $m->('/tuwf/man/response', '::Response', $o{sec2} eq 'response'); $m->('/tuwf/man/xml', '::XML', $o{sec2} eq 'xml'); }); $m->('/tuwf/changes', 'Changelog', $o{sec} eq 'changes'); }); $m->('/doc', 'Articles', $o{page} eq 'doc'); $m->('/dump', 'Code dump', $o{page} eq 'dump', sub { $m->('/dump', 'Misc.', !$o{sec}); $m->('/demo', 'Demos', $o{sec} eq 'demo'); $m->('/dump/awshrink','AWShrink', $o{sec} eq 'awshrink'); $m->('/dump/grenamr', 'Grenamr', $o{sec} eq 'grenamr'); $m->('/dump/nccolour','NC-Colour', $o{sec} eq 'nccolour'); }); end; } sub printCSS { # font-face code from http://fonts.googleapis.com/css?family=Buenard:700,400 lit <<' E;'; @font-face { font-family: 'Buenard'; font-style: normal; font-weight: bold; src: local('Buenard Bold'), local('Buenard-Bold'), url('http://themes.googleusercontent.com/static/fonts/buenard/v2/8T0adwz_RAtKrxbccQmEFC3USBnSvpkopQaUR-2r7iU.ttf') format('truetype'); } @font-face { font-family: 'Buenard'; font-style: normal; font-weight: 400; src: local('Buenard'), local('Buenard-Regular'), url('http://themes.googleusercontent.com/static/fonts/buenard/v2/UUYHasP8umGDjV-yeZf27Q.ttf') format('truetype'); } html,body { background: #ccc; text-align: center; height: 100% } * { margin: 0; padding: 0; font: 15px 'Buenard',serif; color: #222 } #body { text-align: left; width: 800px; margin: 0 auto; background: #fff; border-left: 1px solid #aaa; border-right: 1px solid #aaa; min-height: 100% } #uglyhack { height: 30px } #main, #left { float: left; border-top: 0px dashed #aaa, margin-top: 50px } #left { width: 130px; border-right: 1px dashed #aaa; padding: 20px 10px; margin-bottom: 30px } #main { width: 609px; padding: 12px 20px 30px 20px } #footer { clear: left; width: 150px; margin: 0 0 0 324px; border-top: 1px dashed #aaa; height: 20px; text-align: center } #footer p { position: relative; top: -10px; padding: 0; background: #fff; display: inline; color: #aaa } #left h1 { font-weight: bold; text-align: center; font-size: 15px } #left li { margin: 20px 0 0 10px; list-style-type: none } #left li a { text-decoration: none; display: block; width: 120px; border-bottom: 1px solid #fff } #left li a:hover { border-bottom: 1px dashed #aaa } #left li li { margin-top: 10px } #left li li a { width: 110px } #left li li li { margin-top: 2px } #left li li li a { width: 100px } #left .menusel { color: #03a } #left .notes { margin-top: 50px; text-align: center } #left .notes, #left .notes a { font-size: 12px; text-decoration: none } #left .notes a:hover { text-decoration: underline } img.right { float: right; margin: 0 0 5px 10px } .indexgroup { margin: 30px 10px 0px 20px } .indexgroup li { list-style-type: none; margin-left: 0px } .indexgroup li li { margin-left: 20px } .indexgroup + .dummyTopAnchor + p { margin-top: 20px } a.external:after { content: url(/img/external.gif) } b { font-weight: bold } h1.title { margin-top: 0; font-size: 25px } h1 { margin-top: 50px; } h2 { margin-top: 25px; } h3 { margin-top: 0; margin-left: 10px } h1, h1 a { font-size: 19px; color: #000; margin-bottom: 5px; text-decoration: none } h2, h2 a { font-size: 16px; color: #000; margin-bottom: 1px; text-decoration: none } h3, h3 a { font-size: 15px; color: #000; margin-bottom: 1px; text-decoration: none } li { margin-left: 35px; margin-right: 15px; text-align: justify } p { margin: 3px 15px 13px 15px; text-align: justify } p + ul, p + ol { margin-top: -10px } pre { padding-left: 0 } pre, code, pre b { font: 11px monospace; } pre b { font-weight: bold } pre { background: #f5f5f5; border: 1px dotted #aaa; margin: 5px 10px; display: block; padding: 5px 5px 5px 0; } dd { margin-left: 15px } dt a { color: #333 } dt { margin-left: 10px } i { font-style: normal } /* TODO */ .sig { vertical-align: super } .sig, .sig a { font-size: 12px; color: #333; text-decoration: none } E; }