główna strona  Perl
jest dobry
na wszystko
 
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 - aby wyświetlić taki zegareczek, można w kodzie dowolnej strony umieścić:
<IMG SRC="http://www.jbw.pl/cgi-bin/atime.cgi">
a w Greenwich jest teraz - do tego wystarczy napisać:
<IMG SRC="http://www.jbw.pl/cgi-bin/atime.cgi?d=0;c=990000">
gdy tymczasem w Tokio - przy pomocy takiego kodu:
<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;
 
opiekun: Janusz Wiśniewski :: rejestracja odwiedzin 1725 gości
mobi