712 lines
27 KiB
Perl
Executable file
712 lines
27 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
|
|
|
|
use strict;
|
|
use warnings;
|
|
use TUWF ':html';
|
|
|
|
use Cwd 'abs_path';
|
|
our $ROOT;
|
|
BEGIN { ($ROOT = abs_path $0) =~ s{index\.cgi$}{}; }
|
|
|
|
TUWF::register(
|
|
qr{} => \&home,
|
|
qr{ncdu} => \&ncdu,
|
|
qr{ncdu/changes} => \&ncduchangelog,
|
|
qr{ncdu/man} => \&ncdumanual,
|
|
qr{tuwf} => \&tuwf,
|
|
qr{tuwf/man(?:/(db|misc|request|response|xml))?}
|
|
=> \&tuwfmanual,
|
|
qr{demo} => \&demo,
|
|
qr{dump} => \&dump,
|
|
qr{dump/awshrink} => \&dumpawshrink,
|
|
qr{dump/grenamr} => \&dumpgrenamr,
|
|
);
|
|
TUWF::set(
|
|
logfile => '/www/err.log',
|
|
error_404_handler => \¬found,
|
|
);
|
|
TUWF::run();
|
|
|
|
|
|
|
|
|
|
# H O M E P A G E
|
|
|
|
sub home {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'Yorhel\'s projects');
|
|
p;
|
|
lit <<' E;';
|
|
This site is an attempt to publish and organise my various opensource programs
|
|
and libraries on one central location, possibly documented as well as possible
|
|
so it might actually be useful to anyone. Some of these projects might end up to
|
|
be total crap, and some might not be useful to anyone at all. I'll simply try to
|
|
dump most of the things I create here, and leave it up to you whatever you decide
|
|
to do with it.
|
|
E;
|
|
end;
|
|
h2 'Updates';
|
|
b '2011-02-07'; txt ' TUWF 0.1 released and now also available on CPAN'; br;
|
|
b '2011-01-27'; txt ' Documented and uploaded one of my older projects: TUWF'; br;
|
|
b '2011-01-09'; txt ' Added my json.mll OCaml library to code dump'; br;
|
|
b '2010-08-13'; txt ' ncdu 1.7 released!'; br;
|
|
b '2009-12-22'; txt ' Added vinfo.c script to code dump'; br;
|
|
b '2009-10-23'; txt ' ncdu 1.6 released!'; br;
|
|
b '2009-09-21'; txt ' Tiny CSS fix to make this site look good in certain configurations.'; br;
|
|
b '2009-05-02'; txt ' ncdu 1.5 released!'; br;
|
|
b '2009-04-30'; txt " Site redesign and reorganisation."; br;
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
|
|
|
|
# N C D U
|
|
|
|
sub ncdu {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'NCurses Disk Usage', page => 'ncdu');
|
|
img style => 'float: right', src => '/img/ncdu.png', alt => 'ncdu';
|
|
p;
|
|
lit <<' E;';
|
|
Not quite happy with the available disk usage analyzers and looking for a fun
|
|
project to get used to C programming, I started working on ncdu: A disk usage
|
|
analyzer with an ncurses interface, aimed to be run on a remote server where
|
|
you don't have an entire gaphical setup, but have to do with a simple SSH
|
|
connection. ncdu aims to be fast, simple and easy to use, and should be able
|
|
to run in any minimal POSIX-like environment with ncurses installed.
|
|
E;
|
|
br; br;
|
|
b 'Latest version: ';
|
|
txt '1.7 (';
|
|
a href => 'http://dev.yorhel.nl/download/ncdu-1.7.tar.gz', 'download';
|
|
txt ' - ';
|
|
a href => '/ncdu/changes', 'changes';
|
|
txt ' - ';
|
|
a href => 'http://sourceforge.net/project/showfiles.php?group_id=200175', 'mirror';
|
|
txt ' - ';
|
|
a href => '/download/ncdu.md5', 'md5';
|
|
txt ' - ';
|
|
a href => '/download/ncdu.sha1', 'sha1';
|
|
txt ")"; br;
|
|
b 'Requirements: '; txt 'A POSIX-like system and the ncurses library'; br;
|
|
txt 'Entirely written in C and available under a liberal MIT license.';
|
|
end;
|
|
|
|
h2 'Packages and ports';
|
|
p 'ncdu has been packaged for various systems already, here\'s a list of the ones I am aware of:';
|
|
a href => 'http://www.archlinux.org/packages/?q=ncdu', 'Arch Linux'; txt ' - ';
|
|
a href => 'http://crux.nu/portdb/?q=ncdu&a=search', 'CRUX'; txt ' - ';
|
|
a href => 'http://cygwin.com/packages/ncdu/', 'Cygwin'; txt ' - ';
|
|
a href => 'http://packages.debian.org/ncdu', 'Debian'; txt ' - ';
|
|
a href => 'https://admin.fedoraproject.org/pkgdb/acls/name/ncdu', 'Fedora'; txt ' - ';
|
|
a href => 'http://www.freshports.org/sysutils/ncdu/', 'FreeBSD'; txt ' - ';
|
|
a href => 'http://packages.gentoo.org/package/sys-fs/ncdu', 'Gentoo'; txt ' - ';
|
|
a href => 'http://www.ipcopaddons.org/addondb.php?action=detail&addonid=67', 'IPCop'; txt ' - ';
|
|
a href => 'http://www.openbsd.org/cgi-bin/cvsweb/ports/sysutils/ncdu/', 'OpenBSD'; txt ' - ';
|
|
a href => 'http://packman.links2linux.de/package/ncdu/182992', 'OpenSUSE'; txt ' - ';
|
|
txt 'Mac OS X (';
|
|
a href => 'http://ncdu.darwinports.com/', 'Darwin Ports'; txt '-';
|
|
a href => 'http://pdb.finkproject.org/pdb/package.php/ncdu', 'Fink';
|
|
txt ') - ';
|
|
a href => 'http://paketler.pardus.org.tr/info/2009/stable/source/ncdu.html', 'Pardus'; txt ' - ';
|
|
txt 'Solaris (';
|
|
a href => 'http://www.opencsw.org/packages/ncdu', 'CSW'; txt '-';
|
|
a href => 'http://www.sunfreeware.com/', 'sunfreeware';
|
|
txt ') - ';
|
|
a href => 'http://slackbuilds.org/repository/13.1/system/ncdu/', 'Slackware'; txt ' - ';
|
|
a href => 'http://packages.ubuntu.com/search?searchon=sourcenames&keywords=ncdu', 'Ubuntu'; txt ' - ';
|
|
a href => 'http://zur.zenwalk.org/view/package/name/ncdu', 'Zenwalk';
|
|
|
|
br; br;
|
|
txt 'Subscribe to ';
|
|
a href => 'http://freshmeat.net/projects/ncdu', 'freshmeat';
|
|
txt ' or to ';
|
|
a href => 'https://sourceforge.net/api/file/index/project-id/200175/mtime/desc/rss', 'this RSS feed at sf.net';
|
|
txt ' to receive notifications for new releases.';
|
|
|
|
h2 'Development access';
|
|
p;
|
|
txt 'The most recent code is available on a git repository and is ';
|
|
a href => 'http://g.blicky.net/ncdu.git/', 'available for online browsing';
|
|
txt '.';
|
|
end;
|
|
|
|
h2 'Similar projects';
|
|
a href => 'http://gt5.sourceforge.net/', 'gt5'; txt " - Quite similar to ncdu, but a different approach."; br;
|
|
a href => 'http://webonastick.com/tdu/', 'tdu'; txt " - Another small ncurses-based disk usage visualization utility."; br;
|
|
a href => 'http://treesize.sourceforge.net/', 'TreeSize'; txt " - Same goal, but in GTK this time."; br;
|
|
a href => 'http://www.marzocca.net/linux/baobab.html', 'Baobab'; txt " - Another GTK disk usage analyzer, comes with GNOME."; br;
|
|
a href => 'http://www.methylblue.com/filelight/', 'Filelight'; txt " - And one for KDE."; br;
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
sub ncduchangelog {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'Version history', page => 'ncdu', tab => 'changes');
|
|
$s->htmlChangeLog('ncdu');
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
sub ncdumanual {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'Manual page', page => 'ncdu', tab => 'man');
|
|
open my $F, '<', "$ROOT/dat/ncdu-man" or die $!;
|
|
pre;
|
|
txt $_ while(<$F>);
|
|
end;
|
|
close $F;
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
|
|
|
|
# T U W F
|
|
|
|
|
|
sub tuwf {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'The Ultimate Website Framework', page => 'tuwf');
|
|
lit <<' E;';
|
|
TUWF is a very small and lightweight web development framework for Perl. It
|
|
has evolved from being a few abstraction layers in two large websites to a
|
|
separate set of modules. While initially designed to be used for large and
|
|
complex websites, it is also perfectly suited for small single-file
|
|
websites.
|
|
E;
|
|
|
|
h2 'Main features';
|
|
ul;
|
|
li 'Very small, and no extra modules required,';
|
|
li 'Easy URI-to-function mapping using regular expressions,';
|
|
li 'Handy form validation functions,';
|
|
li 'Easy XML/XHTML output generation functions,';
|
|
li 'Response buffering and output compression,';
|
|
li 'Easy access to GET/POST data and cookies,';
|
|
li 'Support for CGI and FastCGI - optimized for FastCGI,';
|
|
li 'Uses UTF-8 for all text,';
|
|
li 'Convenient SQL execution functions and correct transaction handling,';
|
|
li 'Promotes code re-use,';
|
|
li 'Open source (duh!) and available under a liberal MIT license.';
|
|
end;
|
|
lit <<' E;';
|
|
Read the <a href="/tuwf/man#DESCRIPTION">description</a> in the
|
|
documentation for more information and details.
|
|
E;
|
|
|
|
h2 'Download';
|
|
p;
|
|
lit <<' E;';
|
|
<b>Latest packaged version:</b> 0.1 (<a href="/download/TUWF-0.1.tar.gz">download</a>
|
|
- <a href="http://search.cpan.org/dist/TUWF/">CPAN mirror</a>)
|
|
<br />
|
|
TUWF is also available on a git repository at <a href="http://g.blicky.net/tuwf.git/">
|
|
http://g.blicky.net/tuwf.git/</a>.
|
|
E;
|
|
end;
|
|
|
|
h2 'Websites using TUWF';
|
|
txt '(Not a whole lot)';
|
|
ul;
|
|
li;
|
|
a href => 'http://vndb.org/', 'VNDB.org';
|
|
txt ' (the site that spawned TUWF - ';
|
|
a href => 'http://g.blicky.net/vndb.git/', 'open source';
|
|
txt ')';
|
|
end;
|
|
li;
|
|
a href => 'http://dev.yorhel.nl/', 'This website'; txt ' (also ';
|
|
a href => 'http://g.blicky.net/yorhel-dev.git/tree/index.cgi', 'open source'; txt ')';
|
|
end;
|
|
li;
|
|
a href => 'http://p.blicky.net/', 'Blicky.net Pastebin'; txt ' (';
|
|
a href => 'http://g.blicky.net/bpaste.git/tree/index.cgi', 'open source'; txt ')';
|
|
end;
|
|
li; txt 'The website embedded in the '; a href => 'http://www.d-r.nl/AXUM/AXUM.htm', 'D&R Axum'; txt ' mixing console.'; end;
|
|
li; a href => 'http://yorhel.nl/', 'Yorhel.nl'; end;
|
|
end;
|
|
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
sub tuwfmanual {
|
|
my $s = shift;
|
|
my $man = shift || '';
|
|
$s->htmlHeader(title => 'TUWF Documentation', page => 'tuwf', tab => 'man');
|
|
my %mod = (qw|db DB xml XML|);
|
|
|
|
for ('', qw|db misc request response xml|) {
|
|
my $n = 'TUWF'.($_ ? '::'.(($mod{$_} || ucfirst $_)) : '');
|
|
txt ', ' if $_;
|
|
a href => '/tuwf/man'.($_ ? "/$_" : ''), $n
|
|
if $_ ne $man;
|
|
b $n if $_ eq $man;
|
|
}
|
|
br; br;
|
|
|
|
my $mod = 'TUWF';
|
|
$mod .= '/'.($mod{$man} || ucfirst $man) if $man;
|
|
(my $f = $INC{"$mod.pm"}) =~ s/\.pm$/.pod/;
|
|
$s->htmlPOD($f);
|
|
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
|
|
|
|
# D E M O S
|
|
|
|
sub demo {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'Demos', page => 'demo');
|
|
p;
|
|
lit <<' E;';
|
|
Yes, I realise that the title is plural, suggesting there's more than one demo. That is
|
|
not quite true, unfortunately. The reason I chose to use plural form is simply in the
|
|
hopes that I do, in fact, write more demos, and that this page will actually get more
|
|
content in the future. I still happen to be a huge fan of the <a href="http://demoscene.info/">
|
|
demoscene</a>, and still wish to contribute to it... if only I could find the time and
|
|
self-discipline to do so. In the meanwhile, here's one demo I did write some time ago:
|
|
E;
|
|
end;
|
|
|
|
h2 'Blue Cubes';
|
|
img src => '/img/bluecubes.png', style => 'float: right', alt => 'Blue Cubes';
|
|
p;
|
|
lit <<' E;';
|
|
August 2006. My first demo - or more exact: intro. Blue Cubes is a 64kB intro written in
|
|
OpenGL/SDL with Linux as target OS. I wrote this intro within 10 days without any prior
|
|
experience in any of the fields of computer generated graphics or music. So needlessly to
|
|
say, it sucks. I am ashamed even of the thought of releasing it at a respectable demoparty
|
|
like <a href="http://www.evoke.eu/2006/">Evoke</a>. Still, it didn't feel I was unwelcome,
|
|
I did actually receive three prices: 3rd price in the 64k competition (there were only 3
|
|
actual entries, but oh well), best non-windows 64k intro (it was the only one in the
|
|
competition), and the Digitale Kultur newcomer award, which actually is something to be
|
|
proud of, I guess.
|
|
E;
|
|
br; br;
|
|
a href => '/download/yorhel~bluecubes.zip', 'download';
|
|
txt ' - ';
|
|
a href => 'http://scene.org/file.php?file=/parties/2006/evoke06/in64/yorhel_bluecubes.zip&fileinfo', 'mirror';
|
|
txt " (includes linux binaries, windows port, and sources)"; br;
|
|
a href => 'http://pouet.net/prod.php?which=25866', 'pouet'; txt ' - ';
|
|
a href => 'http://demoscene.tv/page.php?id=172&lang=uk&vsmaction=view_prod&id_prod=12653', 'demoscene.tv'; txt ' - ';
|
|
a href => 'http://demozoo.org/productions/32253', 'demozoo';
|
|
end;
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
|
|
|
|
# C O D E D U M P
|
|
|
|
|
|
sub dump {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'Code Dump', page => 'dump');
|
|
p 'Most of the things I write are simple perl/shell scripts or programs that only '
|
|
.'serve the purpose of learning something new. This page is a listing of those I '
|
|
.'thought might be of interest to others as well.';
|
|
|
|
h2 'bbcode.c';
|
|
p;
|
|
txt 'January 2006. Simple BBCode to HTML converter written in plain C, for learning '
|
|
.'puroses. ';
|
|
a href => '/download/code/bbcode.c', 'source';
|
|
end;
|
|
|
|
h2 'echoserv.c';
|
|
p;
|
|
txt 'February 2006. A simple non-blocking single-threaded TCP echo server, '
|
|
.'displaying how the select() system call can be used to handle multiple '
|
|
.'connections. ';
|
|
a href => '/download/code/echoserv.c', 'source';
|
|
end;
|
|
|
|
h2 'yapong.c';
|
|
p;
|
|
txt 'Feburary 2006. Yet Another Pong, and yet another program written just for testing/'
|
|
.'learning purposes. Tested to work with the ncurses or pdcurses libraries. ';
|
|
a href => '/download/code/yapong.c', 'source';
|
|
txt ' (';
|
|
a href => '/download/code/yapong-0.01.c', '0.01';
|
|
txt ')';
|
|
end;
|
|
|
|
h2 'Microdc2 log file parser';
|
|
p;
|
|
lit <<' E;';
|
|
June 2007. Simple perl script that parses log files created by
|
|
<a href="http://corsair626.no-ip.org/microdc/">microdc2</a> and outputs a simple and
|
|
ugly html file with all uploaded files. It correctly merges chunked uploads, calculates
|
|
average upload speed per file and total bandwidth used for uploads.
|
|
E;
|
|
a href => '/download/code/mdc2-parse.pl', 'source';
|
|
end;
|
|
|
|
h2 'vinfo.c';
|
|
p;
|
|
lit <<' E;';
|
|
November 2009. The <a href="http://vndb.org/d11">public VNDB API</a> was designed to be
|
|
easy to use even from low level languages. I wrote this simple program to see how much
|
|
work it would be to use the API in C, and as example code for anyone wishing to use the
|
|
API for something more useful. Read the comments for more info.
|
|
E;
|
|
a href => '/download/code/vinfo.c', 'source';
|
|
end;
|
|
|
|
h2 'json.mll';
|
|
p;
|
|
lit <<' E;';
|
|
December 2010. I was writing a client for the <a
|
|
href="http://vndb.org/d11">public VNDB API</a> in OCaml and needed a JSON
|
|
parser/generator. Since I wasn't happy with the currently available
|
|
solutions - they try to do too many things and have too many dependencies -
|
|
I decided to write a minimal JSON library myself.
|
|
E;
|
|
a href => 'http://g.blicky.net/serika.git/tree/json.mll', 'source';
|
|
end;
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
sub dumpawshrink {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'AWStats data file shrinker', page => 'dump', tab => 'awshrink');
|
|
p;
|
|
txt 'People who run AWStats on large log files have most likely noticed: the data files can '
|
|
.'grow quite large, resulting in both a waste of disk space and longer page generation '
|
|
.'times for the AWStats pages. I wrote a small script that analyzes these data files and '
|
|
."can remove any information you think is unnecessary.";
|
|
br; br;
|
|
b 'Download: ';
|
|
a href => '/download/code/awshrink', 'awshrink';
|
|
txt ' (copy to /usr/bin to install)';
|
|
end;
|
|
h2 'Important';
|
|
txt 'Do NOT use this script on data files that are not completed yet (i.e. data files of the '
|
|
.'month you\'re living in). This will result in inaccurate sorting of visits, pages, '
|
|
.'referers and whatever other list you\'re shrinking. Also, keep in mind that this is just '
|
|
.'a fast written perl hack, it is by no means fast and may hog some memory while shrinking '
|
|
.'data files.';
|
|
|
|
h2 'Usage';
|
|
pre class => 'code', q|awshrink [-c -s] [-SECTION LINES] [..] datafile
|
|
-s Show statistics
|
|
-c Overwrite datafile instead of writing to a backupfile (datafile~)
|
|
-SECTION LINES
|
|
Shrink the selected SECTION to LINES lines. (See example below)|;
|
|
|
|
h2 'Typical command-line usage';
|
|
p 'While awshrink is most useful for monthly cron jobs, here\'s an example of basic command line '
|
|
.'usage to demonstrate what the script can do:';
|
|
pre class => 'code', join "\n", grep s/^\s{4}//||1, split /\n/, <<' E;';
|
|
$ wc -c awstats122007.nedtlyrics.txt
|
|
29916817 awstats122007.nedtlyrics.txt
|
|
|
|
$ awshrink -s awstats122007.nedtlyrics.txt
|
|
Section Size (Bytes) Lines
|
|
SCREENSIZE* 74 0
|
|
WORMS 131 0
|
|
EMAILRECEIVER 135 0
|
|
EMAILSENDER 143 0
|
|
CLUSTER* 144 0
|
|
LOGIN 155 0
|
|
ORIGIN* 178 6
|
|
ERRORS* 229 10
|
|
SESSION* 236 7
|
|
FILETYPES* 340 12
|
|
MISC* 341 10
|
|
GENERAL* 362 8
|
|
OS* 414 29
|
|
SEREFERRALS 587 34
|
|
TIME* 1270 24
|
|
DAY* 1293 31
|
|
ROBOT 1644 40
|
|
BROWSER 1992 127
|
|
DOMAIN 2377 131
|
|
UNKNOWNREFERERBROWSER 5439 105
|
|
UNKNOWNREFERER 20585 317
|
|
SIDER_404 74717 2199
|
|
PAGEREFS 130982 2500
|
|
KEYWORDS 288189 27036
|
|
SIDER 1058723 25470
|
|
SEARCHWORDS 5038611 157807
|
|
VISITOR 23285662 416084
|
|
* = not shrinkable
|
|
|
|
$ awshrink -s -c -VISITOR 100 -SEARCHWORDS 100 -SIDER 100 awstats122007.nedtlyrics.txt
|
|
Section Size (Bytes) Lines
|
|
SCREENSIZE* 74 0
|
|
WORMS 131 0
|
|
EMAILRECEIVER 135 0
|
|
EMAILSENDER 143 0
|
|
CLUSTER* 144 0
|
|
LOGIN 155 0
|
|
ORIGIN* 178 6
|
|
ERRORS* 229 10
|
|
SESSION* 236 7
|
|
FILETYPES* 340 12
|
|
MISC* 341 10
|
|
GENERAL* 362 8
|
|
OS* 414 29
|
|
SEREFERRALS 587 34
|
|
TIME* 1270 24
|
|
DAY* 1293 31
|
|
ROBOT 1644 40
|
|
BROWSER 1992 127
|
|
SEARCHWORDS 2289 100
|
|
DOMAIN 2377 131
|
|
SIDER 3984 100
|
|
UNKNOWNREFERERBROWSER 5439 105
|
|
VISITOR 5980 100
|
|
UNKNOWNREFERER 20585 317
|
|
SIDER_404 74717 2199
|
|
PAGEREFS 130982 2500
|
|
KEYWORDS 288189 27036
|
|
* = not shrinkable
|
|
|
|
$ wc -c awstats122007.nedtlyrics.txt
|
|
546074 awstats122007.nedtlyrics.txt
|
|
E;
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
sub dumpgrenamr {
|
|
my $s = shift;
|
|
$s->htmlHeader(title => 'GTK+ Mass File Renamer', page => 'dump', tab => 'grenamr');
|
|
p;
|
|
lit <<' E;';
|
|
GRenamR is a GTK+ mass file renamer written in Perl, the functionality is insipred
|
|
by the <a href="http://search.cpan.org/~rmbarker/File-Rename-0.05/rename.PL">rename</a>
|
|
command that comes with a Perl module.<br />
|
|
<br />
|
|
GRenamR allows multiple file renaming using perl expressions. You can see the effects
|
|
of your expression while typing it, and can preview your action before applying them.
|
|
The accepted expressions are mostly the same as the rename command (see above paragrah):
|
|
your expression will be evaluated with $_ set to the filename, and any modifications
|
|
to this variable will result in the renaming of the file. There's one other variable
|
|
that the rename command does not have: $i, which reflects the file number (starting from
|
|
0) in the current list. This allows expressions such as as <code>$_=sprintf'%03d.txt',$i</code>.
|
|
E;
|
|
br; br;
|
|
b 'Download: ';
|
|
a href => '/download/code/grenamr-0.1.pl', 'grenamr';
|
|
txt " (copy to /usr/bin/ to install)"; br;
|
|
txt "Requires the Gtk2 Perl module (most distributions have a perl-gtk2 package)"; br;
|
|
end;
|
|
|
|
h2 'Example expressions';
|
|
table;
|
|
Tr; td style => 'width: 40%'; code 'y/A-Z/a-z/'; txt ' or '; code '$_=lc'; end; td 'Convert filenames to lowercase'; end;
|
|
Tr; td; code 's/\.txt$/.utf8/'; end; td "Change all '.txt' extensions to '.utf8'"; end;
|
|
Tr; td; code q|s/([0-9]+)/sprintf'%04d',$1/eg|; end; td 'Zero-pad all numbers in filenames'; end;
|
|
Tr; td; code q|s/^.+\.jpg$/sprintf'%03d.jpg',$i+1/e|; end; td 'Replace each image filename with a zero-padded number starting from 1'; end;
|
|
end;
|
|
|
|
h2 'Caveats / bugs / TODO';
|
|
ul;
|
|
li q|Calling functions as 'sleep' or 'exit' in the expression will trash the program|;
|
|
li q|It's currently not possible to manually order the file list, so $i is not useful in every situation|;
|
|
li q|It's currently not possible to manually rename files or exclude items from being effected by the expression|;
|
|
li; lit q|The expression isn't executed in the opened directory, so things like
|
|
<a href="http://perldoc.perl.org/functions/-X.html">-X</a> won't work|; end;
|
|
end;
|
|
|
|
h2 'Screenshot';
|
|
img src => '/img/grenamr.png', alt => 'GRenamR';
|
|
$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' ],
|
|
[ '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 => 'Page Not Found');
|
|
$s->htmlFooter;
|
|
}
|
|
|
|
|
|
|
|
|
|
# U T I L I T Y M E T H O D S
|
|
|
|
package TUWF::Object;
|
|
use TUWF ':html';
|
|
|
|
sub htmlHeader {
|
|
my($self, %o) = @_;
|
|
$o{page} ||= '';
|
|
$o{tab} ||= '';
|
|
html;
|
|
head;
|
|
title $o{title};
|
|
style type => 'text/css';
|
|
lit $self->css;
|
|
end;
|
|
end;
|
|
body;
|
|
div id => 'menu';
|
|
a href => '/', !$o{page} ? (class => 'sel') : (), 'home'; txt ' ';
|
|
a href => '/ncdu', $o{page} eq 'ncdu' ? (class => 'sel') : (), 'ncdu'; txt ' ';
|
|
a href => '/tuwf', $o{page} eq 'tuwf' ? (class => 'sel') : (), 'tuwf'; txt ' ';
|
|
a href => '/demo', $o{page} eq 'demo' ? (class => 'sel') : (), 'demos'; txt ' ';
|
|
a href => '/dump', $o{page} eq 'dump' ? (class => 'sel') : (), 'code dump';
|
|
end;
|
|
if($o{page} eq 'ncdu') {
|
|
div id => 'mtabs';
|
|
a href => '/ncdu', !$o{tab} ? (class => 'sel') : (), 'main'; txt ' ';
|
|
a href => '/ncdu/changes', $o{tab} eq 'changes' ? (class => 'sel') : (), 'changelog'; txt ' ';
|
|
a href => '/ncdu/man', $o{tab} eq 'man' ? (class => 'sel') : (), 'manual'; txt ' ';
|
|
a href => 'http://sourceforge.net/tracker/?group_id=200175', 'bug tracker (sf)';
|
|
end;
|
|
}
|
|
if($o{page} eq 'tuwf') {
|
|
div id => 'mtabs';
|
|
a href => '/tuwf', !$o{tab} ? (class => 'sel') : (), 'main'; txt ' ';
|
|
a href => '/tuwf/man', $o{tab} eq 'man' ? (class => 'sel') : (), 'manual'; txt ' ';
|
|
end;
|
|
}
|
|
if($o{page} eq 'dump') {
|
|
div id => 'mtabs';
|
|
a href => '/dump', !$o{tab} ? (class => 'sel') : (), 'misc'; txt ' ';
|
|
a href => '/dump/awshrink', $o{tab} eq 'awshrink' ? (class => 'sel') : (), 'awshrink'; txt ' ';
|
|
a href => '/dump/grenamr', $o{tab} eq 'grenamr' ? (class => 'sel') : (), 'grenamr';
|
|
end;
|
|
}
|
|
div id => 'main';
|
|
h1 $o{title};
|
|
}
|
|
|
|
sub htmlFooter {
|
|
end 'div';
|
|
p id => 'footer';
|
|
lit 'feedback » ';
|
|
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';
|
|
end;
|
|
end 'body';
|
|
end 'html';
|
|
}
|
|
|
|
|
|
sub htmlChangeLog {
|
|
my ($s, $p) = @_;
|
|
|
|
open my $F, '<', "$ROOT/dat/$p-changelog" or die $!;
|
|
ul style => 'margin-left: 0';
|
|
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;';
|
|
b $1;
|
|
txt " - $2 - ";
|
|
a href => "/download/$p-$1.tar.gz", "$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;
|
|
}
|
|
|
|
|
|
sub htmlPOD {
|
|
my($s, $file) = @_;
|
|
require Pod::Simple::HTML;
|
|
require Encode; # not really necessary, since the docs are ASCII anyway
|
|
|
|
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',
|
|
};
|
|
$p->parse_file($file);
|
|
h1 'Table of Contents';
|
|
lit Encode::decode_utf8($p->index_as_html());
|
|
div class => 'pod';
|
|
lit Encode::decode_utf8($html);
|
|
end;
|
|
}
|
|
|
|
|
|
sub css {
|
|
return <<__;
|
|
* { padding: 0; margin: 0; font: 15px "Lucida Grande", "Arial", "Helvetica", "Verdana", sans-serif; }
|
|
body { background: #222; text-align: center; color: #ccc }
|
|
a { text-decoration: none; color: #666 }
|
|
a:hover { text-decoration: underline }
|
|
#menu { background: #000; border-bottom: 1px solid #666; width: 100%; margin: 0; }
|
|
#menu a { line-height: 25px; padding: 5px 8px; margin: 0 2px; color: #ccc; }
|
|
#menu a:hover, #menu a.sel { background-color: #222; text-decoration: none }
|
|
#main { margin: 30px auto 5px auto; background-color: #000; width: 700px; border: 2px solid #666; text-align: left; padding: 5px 10px 10px 10px }
|
|
#mtabs { margin: 30px 0 -28px 0; }
|
|
#mtabs a { background-color: #222; color: #ccc; font-size: 13px; margin: 0 2px; padding: 0 10px 3px 10px; border: 1px solid #666; border-bottom: 2px solid #666 }
|
|
#mtabs a:hover { background-color: #000; text-decoration: none }
|
|
#mtabs a.sel { border-bottom: 2px solid #000; background-color: #000; }
|
|
#footer, #footer a { color: #444; margin-bottom: 10px }
|
|
h1 { font-size: 19px; color: #888; margin-bottom: 5px; }
|
|
h2 { font-size: 16px; color: #888; margin-top: 25px; margin-bottom: 1px; }
|
|
b { font-weight: bold; color: #fff }
|
|
ul { margin-left: 20px }
|
|
pre, code { font: 11px monospace; }
|
|
pre.code, .pod pre { background: #111; border: 1px dotted #666; margin: 5px 10px; display: block; padding: 5px; }
|
|
.indexgroup ul { margin-left: 5px; list-style-type: none }
|
|
.indexgroup ul ul { margin-left: 20px }
|
|
.pod p { margin: 3px 15px 13px 15px; text-align: justify }
|
|
.pod ul, .pod ol { margin-left: 35px }
|
|
.pod ul li, .pod ol li { margin-right: 15px; text-align: justify }
|
|
.pod pre { padding-left: 0 }
|
|
.pod h1 a, .pod h2 a { color: #888; font-weight: bold; font-size: 19px }
|
|
.pod h1 { margin-top: 50px }
|
|
.pod h2 a { font-size: 16px }
|
|
.pod dd { margin-left: 15px }
|
|
.pod dt a { color: #888 }
|
|
.pod dt { margin-left: 10px }
|
|
.pod i { font-style: italic }
|
|
__
|
|
}
|
|
|
|
|