|
Perl wpadł mi w ręce gdy rozglądałem się za sprawnym narzędziem do skryptów CGI. Początkowo próbowałem to robić w BASH-u, ale okazał się zbyt toporny. Pascal, C czy C++ pomimo licznych zalet, przed którymi chylę czoła, nie radzą sobie tak brawurowo z przetwarzaniem tekstów. Do tego możliwość natychmiastowego uruchamiania programu bez żadnej kompilacji czy konsolidacji modułów jest urzekająca.
|
|
Perl jest wszędzie
Cały ten serwis jest napisany w Perlu. Dziesiątki mniejszych i większych programów dostępnych na widocznych i niewidocznych stronach. Armia małych pomocników.
Dla tych, którzy się jeszcze nie zorientowali: CGI to jest taki program, który buduje źródło strony www i podaje go przez serwer do przeglądarki tak jakby to był zwykły plik HTML. Dzięki temu strona może się modyfikować w locie i wyświetlać coraz to inną zawartość, jak w tym prostym przykładzie:
Czas lokalny
<IMG SRC="http://www.jbw.pl/cgi-bin/atime.cgi"> a w Greenwich jest teraz
<IMG SRC="http://www.jbw.pl/cgi-bin/atime.cgi?d=0;c=990000"> gdy tymczasem w Tokio
<IMG SRC="http://www.jbw.pl/cgi-bin/atime.cgi?d=9;c=0000CC"> Tak, ten kod zadziała wpleciony w tekst dowolnej strony www, po prostu połączy się z tym małym programikiem i dostanie od niego aktualny rysunek. Ponieważ tarcza zegara jest ze swej natury 12-godzinna, towarzyszy jej mała kropeczka: u dołu po lewej oznacza godziny poranne, po prawej u góry - popołudniowe.
W sąsiedniej kolumnie pokazany jest program, który to robi. Wymyśliłem sobie, że wygodnie by było móc rysować grafikę bezpośrednio w tekście programu. Taki program zawarty jest cały w jednym pliku, więc nie można zgubić żadnej jego części podczas chaotycznej instalacji. Tworzymy prostokątne tabliczki tekstowe, rozmieszczając piksele rysunku przy pomocy dowolnych znaków na tle wypełnionym spacjami. Powstanie jednokolorowy rysunek w formacie PNG, w którym puste miejsca będą przezroczyste, o ile oczywiście ktoś nie używa starszych wersji MSIE.
Zdefiniowano 12 położeń wskazówek, co odpowiada dokładności do 5 minut. Dzięki złożeniu wskazówki z dwóch różnych znaków można ją wyświetlać w krótkiej i długiej wersji.
Właściwym wykonaniem pliku PNG zajmie się moduł tbm.pm, który można obejrzeć w ostatniej kolumnie. Ten kawałek został wydzielony, ponieważ można go używać do generowania obrazków z wielu różnych programów. Na przykład przyciski opisane na stronie zasady są tworzone w ten właśnie sposób.
|
atime.cgi: zegarek
#!/usr/bin/perl -w
use strict;
use CGI qw(:standard);
use tbm;
my $col = param('c') || '000000';
my @ani = (
[ #0
' ',
' xxxxx p ',
' xx * xx ',
' x * x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' xx xx ',
' a xxxxx ',
' ',
],
[ #1
' ',
' xxxxx p ',
' xx xx ',
' x * x ',
' x * x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' xx xx ',
' a xxxxx ',
' ',
],
[ #2
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x *x ',
' x oo x ',
' x oo x ',
' x o x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' xx xx ',
' xxxxx ',
' a ',
],
[ #3
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x ooooo**x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' xx xx ',
' a xxxxx ',
' ',
],
[ #4
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x o x ',
' x oo x ',
' x oo x ',
' x *x ',
' x x ',
' x x ',
' xx xx ',
' a xxxxx ',
' ',
],
[ #5
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x * x ',
' xx xx ',
' a xxxxx ',
' ',
],
[ #6
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x * x ',
' xx * xx ',
' a xxxxx ',
' ',
],
[ #7
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x * x ',
' xx xx ',
' a xxxxx ',
' ',
],
[ #8
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x o x ',
' x oo x ',
' x oo x ',
' x* x ',
' x x ',
' x x ',
' xx xx ',
' a xxxxx ',
' ',
],
[ #9
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x**ooooo x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' xx xx ',
' xxxxx ',
' a ',
],
[ #10
' ',
' xxxxx p ',
' xx xx ',
' x x ',
' x x ',
' x* x ',
' x oo x ',
' x oo x ',
' x o x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' xx xx ',
' a xxxxx ',
' ',
],
[ #11
' ',
' xxxxx p ',
' xx xx ',
' x * x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x o x ',
' x x ',
' x x ',
' x x ',
' x x ',
' x x ',
' xx xx ',
' a xxxxx ',
' ',
],
);
my $minute = 60;
my $hour = 60 * $minute;
my $round = (5 * $minute) / 2;
my $q = param('d'); # time-zone difference in hours relative to GMT
my $gmt = defined($q); # ...or local time without parameter
$q = 0 unless $q;
my $t = param('t') || time + $round; # system time if not supplied
my ($s, $m, $h) = ($gmt) ? gmtime($t+$q*$hour) : localtime($t);
my $mx = int($m/5); # minute-hand index
my $ap = ($h < 12) ? 'a' : 'p'; # set am/pm dot;
++$h if $mx > 6; # adjust hour
my $hx = ($h%12); # hour-hand index
my @pic; # assembly final image
merge(\@pic, $ani[$mx], "xo*$ap");
merge(\@pic, $ani[$hx], 'o');
print
header(-type=>'text/png',-expires=>'+1m',
-Content_disposition=>'inline;filename="time.png"'),
tbm::tbm(\@pic, $col)
;
sub merge
{
my ($dst, $src, $chr) = @_; my $tr = "s/[^$chr]/ /go";
my $i; # wipe out unwanted chars
foreach my $i (0..@$src-1)
{
$_ = $src->[$i];
eval($tr);
$dst->[$i] |= $_
}
}
|
tbm.pm: tworzenie pliku PNG
#!/usr/bin/perl -w
package tbm;
use strict;
use Compress::Zlib;
sub chunk # make chunk of given name and data
{
my ($name, $data) = @_; $data = '' unless defined($data);
my $body = "$name$data";
return pack('N', length($data)) . $body . pack('N', crc32($body));
}
sub ihdr # make header of given width and height
{
my $w = shift||1; my $h = shift||16;
return chunk('IHDR',
# w h bit col cmp flt inl
pack(' N N C C C C C',
( $w, $h, 1, 3, 0, 0, 0))
);
}
sub tbm # make complete PNG from table reference
{
my ($ref, $col) = @_;
my $h = @{$ref} or return '';
my $w = length($ref->[0]) or return '';
my @pal = map(map(hex($_), unpack('A2'x3, $_)), ('C'x6, $col));
my @data;
$w = 32 if ($w > 32); $h = 32 if ($h > 32);
foreach (@{$ref})
{
$_ = substr($_.' 'x32, 0, $w); tr/ /0/; s/[^0]/1/g;
push(@data, (0, map(ord($_), split(//, pack("B*", $_)))));
}
return "\211PNG\r\n\32\n"
. ihdr($w, $h)
. chunk('PLTE', pack('C*', @pal))
. chunk('tRNS', pack('C*', (0)))
. chunk('IDAT', compress(pack('C*', @data)))
. chunk('IEND')
;
}
1;
|
|
|