345 lines
12 KiB
Perl
Executable file
345 lines
12 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
use TUWF ':html';
|
|
|
|
use Cwd 'abs_path';
|
|
our $ROOT;
|
|
BEGIN { ($ROOT = abs_path $0) =~ s{index\.cgi$}{}; }
|
|
|
|
|
|
TUWF::register(
|
|
qr{} => sub { podpage(shift, 'home', '', '', "Yorhel's Projects") },
|
|
qr{ncdu} => sub { podpage(shift, 'ncdu', 'ncdu', '', 'NCurses Disk Usage') },
|
|
qr{ncdu/man} => sub { manpage(shift, 'ncdu-man', 'ncdu', 'man', 'Ncdu Manual') },
|
|
qr{ncdu/changes} => sub { changelog(shift, 'ncdu-changelog', '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 { manpage(shift, 'ncdc-man', 'ncdc', 'man', 'Ncdc Manual') },
|
|
qr{ncdc/changes} => sub { changelog(shift, 'ncdc-changelog', '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{doc} => sub { podpage(shift, 'doc', 'doc', '', 'Articles') },
|
|
qr{doc/sqlaccess} => sub { podpage(shift, 'sqlaccess', 'doc', '', 'Multi-threaded Access to an SQLite3 Database', 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') },
|
|
);
|
|
|
|
TUWF::set(
|
|
logfile => '/www/err.log',
|
|
#pre_request_handler => sub { $ENV{REQUEST_URI} = $_[0]->reqGet('path')||''; 1 },
|
|
error_404_handler => \¬found,
|
|
);
|
|
|
|
TUWF::run();
|
|
|
|
|
|
sub test {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'Test', page => 'ncdu', sec => 'changes');
|
|
(my $f = $INC{"TUWF.pm"}) =~ s/\.pm$/.pod/;
|
|
#$s->htmlPOD($f, 1);
|
|
$s->htmlPOD('home');
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
sub podpage {
|
|
my($s, $f, $p, $se, $t, $toc) = @_;
|
|
$s->htmlHeader(title => $t, page => $p, sec => $se);
|
|
$s->htmlPOD($f, $toc);
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
# TODO: Convert to POD, or use POD as original source for the man pages
|
|
sub manpage {
|
|
my($s, $f, $p, $se, $t) = @_;
|
|
$s->htmlHeader(title => $t, page => $p, sec => $se);
|
|
open my $F, '<:utf8', "$ROOT/dat/$f" or die $!;
|
|
pre;
|
|
txt $_ while(<$F>);
|
|
end;
|
|
close $F;
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
sub changelog {
|
|
my($s, $f, $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("$p-$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 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 two special formatting codes:
|
|
# [dllink $file $title]
|
|
# [img $class $file $alt]
|
|
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_header_after_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 ([^ ]+) ([^ ]+) ([^\]]*)\]/<img src="\/img\/$2" class="$1" alt="$3" \/>/g;
|
|
#$html =~ s{\[html\](.*)É}{(my $h = $1) =~ s/\>/>/g; $h =~ s/\</</g; $h =~ s/\&/\&/g; $h =~ s/\"/"/g; $h}egs;
|
|
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;
|
|
}
|
|
|
|
|
|
sub htmlHeader {
|
|
my $s = shift;
|
|
my %o = (page => '', sec => '', sec2 => '', @_ );
|
|
html;
|
|
head;
|
|
style type => 'text/css';
|
|
$s->printCSS;
|
|
end;
|
|
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://svn.blicky.net', 'svn';
|
|
txt ' - '; a href => 'http://pgp.mit.edu:11371/pks/lookup?search=0x8c2739fa', 'pgp';
|
|
end;
|
|
end 'div';
|
|
div id => 'main';
|
|
h1 class => 'title', $o{title};
|
|
}
|
|
|
|
|
|
sub htmlFooter {
|
|
end 'div'; # main
|
|
div id => 'anotherhack', ' ';
|
|
end 'div'; # body
|
|
end 'body';
|
|
end 'html';
|
|
}
|
|
|
|
|
|
sub htmlMenu {
|
|
my($s, %o) = @_;
|
|
my $m = sub {
|
|
li;
|
|
a href => $_[0], $_[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 (ext)'); # TODO: wikipedia-style extern image or something
|
|
});
|
|
$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->('/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 }
|
|
#anotherhack { clear: left }
|
|
#main, #left { float: left; border-top: 0px dashed #aaa, margin-top: 50px }
|
|
#left { width: 130px; border-right: 1px dashed #aaa; padding: 20px 10px }
|
|
#main { width: 609px; padding: 12px 20px }
|
|
#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 }
|
|
b { font-weight: bold }
|
|
h1.title { margin-top: 0; font-size: 25px }
|
|
h1 { margin-top: 50px; }
|
|
h2 { margin-top: 25px; }
|
|
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 }
|
|
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;
|
|
}
|