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; |
|