-+  Documenti
 |-  Bibliografia
 |-  Articoli
 |-  Perlfunc
 |-  F.A.Q.
 |-  F.A.Q. iclp
-+  Eventi
-+  Contatti
-+  Blog
-+  Link



 

Versione stampabile.


Roberto Natella
Roberto, 23 anni, à uno studente presso la facoltà di Ingegneria Informatica dell'Università Federico II di Napoli, e utilizza il linguaggio Perl per svolgere i compiti quotidiani nell'utilizzo del sistema operativo Linux.

Vincitore Contest2005

Introduzione

In questo articolo verranno trattati alcuni script Perl che, per la loro originalità, risultano essere istruttivi, o anche solo "divertenti". Molti di essi producono un risultato che di primo acchito non ci si aspetterebbe, e sono formattati graficamente per renderne ancora più imprevedibile (quasi stupefacente, in certi casi) il risultato finale.
In particolare, alcuni di essi sono delle cosiddette "JAPH signatures", ossia dei modi originali di stampare a video la frase "just another perl hacker" o simili, e liberamente reperibili in rete. Questo genere di firme furono per prime utilizzate e rese famose da Randal Schwartz (e da allora usate ad esempio come firma in calce su usenet), e alcune sono disponibili all'indirizzo http://www.perl.com/CPAN/misc/japh .

Questi script sono un aspetto molto curioso della eclettica comunità degli sviluppatori Perl! Altri programmi invece sono delle "offuscazioni", cioè normali programmi appositamente modificati per confondere il lettore.

Ciascuno script è presentato nella sua forma iniziale, e poi ristrutturato e commentato per spiegarne il funzionamento. Ma, per un maggior divertimento, suggerisco di cercare di capirne prima da soli il meccanismo!

Una ultima nota prima di cominciare: il seguente articolo è stato redatto inizialmente in formato plain text, e solo successivamente è stato trasposto in formato HTML, per cui potrebbero essere rimasti degli errori, nei caratteri o altrove, dovuti al cambio di formato. Se ne notate uno, vi prego di avvisarmi!

Hash misteriosi

Ecco un primo script, non troppo grosso, tanto per cominciare:

#!perl -l
# chipmunk (aka Ronald J Kimball) <rjk@linguist.dartmouth.edu>
$_={1..28};$/=[$_,P,a..z,J,$"];print+map{$_&1?$/->{$_}:$/->[$_|1]}
(27,21,19,20,28,1,14,15,20,8,5,18,28,0,5,18,12,28,8,1,3,11,5,18)

Lo stesso script, riscritto in modo più leggibile:

#!/usr/in/perl -l
 
# L'opzione -l equivale all'istruzione
# $\ = $/; chomp $/;
 
$_={
 
     1 => 2,
     3 => 4,
     5 => 6,
     7 => 8,
     9 => 10,
    11 => 12,
    13 => 14,
    15 => 16,
    17 => 18,
    19 => 20,
    21 => 22,
    23 => 24,
    25 => 26,
    27 => 28
 
   };
 
$/=[$_,P,a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,J,$"];
 
# $" contiene uno spazio vuoto (' ');
 
print map{ $_ & 1 ? $/->{$_} : $/->[$_|1] }
 
(27,21,19,20,28,1,14,15,20,8,5,18,28,0,5,18,12,28,8,1,3,11,5,18);

Innanzitutto, $_ viene dichiarato come reference ad un hash anonimo, in cui i numeri dispari da 1 a 27 richiamano i numeri pari immediatamente successivi.
Ad esempio $_->{15} è uguale a 16; in pratica i numeri dispari sono considerati come le chiavi dell'hash.

Poi, $/ ; non bisogna farsi ingannare dal ruolo che le attribuisce l'interprete per default: $/ contiene il carattere che viene considerato come separatore di linea durante la lettura di un file (\n), ma siccome questo non avviene $/ ha il valore di una normalissima variabile, come lo sarebbe $pippo.

$/, come $_, viene utilizzato come reference, che stavolta punta su una lista anonima la quale, come vedremo, ha una proprietà molto particolare. Comunque, questa reference va trattata come qualunque altra reference verso array, per cui $/->[1] è uguale a "P", $/->[3] a "b" e cosÏ via. Il primo elemento di questo array anonimo è a sua volta una reference all'hash $_ precedentemente dichiarato, e conferisce alla lista una caratterista, documentata nella pagina del manuale "perlref" (sezione "Pseudo-hashes: Using an array as a hash"); vediamola molto brevemente.

Data la seguente reference verso un array anonimo

$struct = [{foo => 1, bar => 2}, "FOO", "BAR"];

so che $struct->[1] è uguale a "FOO" e $struct->[2] a "BAR"; inoltre il primo elemento è una reference ad un array, quindi $struct->[0]->{foo} è uguale a 1 e $struct->[0]->{bar} è uguale a 2. Ma, stranamente, se richiamo $struct->{foo} ottengo "FOO", e con $struct->{bar} ho "BAR"... come mai? Questo accade perché il primo elemento è un riferimento ad un hash in cui alle chiavi sono associate dei numeri: l'interprete Perl, non appena lo nota, associa ad ogni chiave un puntatore ad uno degli elementi della lista, quello indicato dal numero da essa contenuto. Così, la chiave "foo" fungerà da "etichetta" all'elemento della lista con indice uguale ad 1, e "bar" all'indice 2. Quindi le diciture $struct->{foo} e $struct->[1] sono considerate uguali.

Ritornando al nostro piccolo script, ecco che troviamo un blocco che tramite la istruzione map rielabora gli elementi della lista di numeri immediatamente successiva, restituendo una serie di caratteri che l'istruzione print provvede a stampare. Vi svelo subito che l'obiettivo dell'autore è stampare la lettera dell'alfabeto associata a ogni numero, a formare la fatidica scritta "Just another Perl hacker", ossia che, passato a map il numero 1, venga stampata la a, col numero 2 venga stampata la b e così via (va fatta eccezione per 27 e 0, che indicano la "J" e la "P", e il 28 che indica lo spazio vuoto). Vediamo nel dettaglio come questo avviene.

$_ & 1 ? $/->{$_} : $/->[$_|1]

Ecco l'operatore ternario determinante per il programma. Avrete fatto
certamente caso anche ad & e |, due operatori che lavorano a livello di bit.

Ora, una piccolissima rinfrescatina di aritmetica binaria per chi ne avesse bisogno. I numeri che in base decimale sono pari, portati in base primaria terminano per 0, viceversa quelli dispari termineranno per 1.
(Il bit all'estremità destra rappresenta la cifra meno significativa)

Quando andremo a fare l'AND tra un numero pari e 1, otterremo questo:

 1010 &    (il 10)
 0001 =    (l' 1)
--------
 0000

E ora, proviamo con un numero dispari:

 1111 &    (il 13)
 0001 =    (l' 1)
--------
 0001

In qualunque caso, gli unici bit che influenzeranno il risultato della operazione sono soltanto quelli all'estrema destra (ossia lo 0 finale del 10 e l'1 finale del 13): tutte le altre cifre dei numeri, confrontate con gli zeri di 0001 restituiranno sempre 0 (FALSE) al momento dell'AND. Per cui "$_ & 1" restituisce vero nel caso di numeri dispari, e falso nel caso di numeri pari.

Tutto questo soltanto per far sì che al richiamo dell'istruzione $/->{$_} si possa essere sicuri che $_ sia un valore dispari, che in caso contrario genererebbe un messaggio di errore (infatti l'hash delle "etichette" non contiene chiavi con numeri pari).

In caso di numeri pari viene invece usata la sintassi "$/->[$_|1]", che
richiama il "$_|1"-esimo elemento della lista $/, trattata come una lista comune. Perché quell'OR ? Anche in questo caso valgono alcune delle considerazioni fatte per l'AND:

 1010 |    (il 10)
 0001 =    (l' 1)
--------
 1011

Come per ogni altro numero pari, l'OR fra 10 e 1 restituisce il numero
immediatamente successivo, 11. Ossia è come se si fosse scritto ++$_ .

L'autore ha fatto questo perché nella lista $/ l'elemento numero 8, ad esempio, non corrisponde alla ottava lettera dell'alfabeto, bensì alla settima, la g; poiché l'elemento 1 della lista è uguale a "P", il secondo è uguale ad "a", il terzo a "b" e via discorrendo. "$_ | 1" rappresenta un tentativo offuscato per far avanzare l'indice di una unità in modo da ovviare all'inconveniente.

Infine, il "+" tra print e map nella "versione offuscata" serve per non
lasciare spazi vuoti senza alterare il funzionamento dello script.

Finito! Abbiamo visto che questo programma, per quanto semplice, contiene qualche piccola caratteristica che rende un JAPH interessante.

Guerre stellari

Un altro script carino, ispirato alla saga di Guerre Stellari:

#!/usr/bin/perl
# autore anonimo
 
undef$/;$_=<DATA>;y/ODA\n / /ds;@yoda=map{length}split;print chr
oct join('',splice(@yoda,0,3))-111 while@yoda;
__DATA__
         00O00O000O00O0000      000O         DD000000O0
        0DO0000000O0000O00     O00000        00O00000O0O
        0000      0O0         O00  O00       00D     0DO
         00O0     0O0        00D    000      DO0D00000D
          0O00    DOD       000000O00000     000  O00O
 DD0000D000O0     000      0O00O0000D00DO    0OD   D00O000D00O0
 00000DO00O0      000     000O        00D0   O0D    O00000O0DO0
 
 0O000   OD0D   O00O0   0000         DDDO000000      O00O000000
  0O000 O00DDO 00000   0O0D00        00O0O00000O    0O00O000000
   0O0O00OD00000DDD   00O  0D0       DDD     D0O    00O0D
    00000O00000000   O00    DO0      D00D00O000      00D00
     D0O00  O0000   000O000O00DO     000  00O0        0OD00
      O00    000   0O000D000O00O0    000   0D0O000000O00O00
       0      0   0O0D        0000   0O0    0O0000000O000O

Lo riscrivo in forma più chiara:

#!/usr/bin/perl
 
undef $/; # Come sopracitato, $/ contiene il separatore di linea in lettura,\n. 
          # Annullandolo, può essere assegnato a una variabile l'intero 
          # contenuto di un filehandle (vedi istruzione sottostante). 
 
$_ = <DATA>;  # Tutto ciò che è scritto dopo il termine __DATA__ non viene
              # considerato come istruzioni da interpretare, ma come un file di
              # testo che viene passato all'interprete al momento della
              # esecuzione (come se si trattasse di una pipe). Quindi è
              # necessario scrivere prima lo script, considerando DATA come un
              # normale filehandle, poi terminare lo script con __DATA__ e
              # inserire il testo.
 
$_ =~ y/ODA\n / /ds; # Sostituisce con uno spazio vuoto tutto quello che è
                     # uguale ad una "O","D" o "A", cancellando anche gli \n .
                     # PS: notare lo "y/ODA" :-)
 
@yoda = map { length ($_) } split (/ /,$_); # $_ viene diviso in gruppetti di
                                            # caratteri, di cui la lunghezza di
                                            # ognuno viene associata a un
                                            # elemento dell'array @yoda .
 
while (@yoda) {
 
  $_ = join('',splice(@yoda,0,3)); # Finché rimangono elementi in @yoda,
                                   # vengono sottratti i primi 3 da questo
                                   # array e vengono uniti assieme formando un
                                   # nuovo numero a 3 cifre.
 
  $_ -= 111;                       # A questo numero viene sottratto 111.
 
  $_ = oct $_;                     # Questo numero passa dalla base decimale
                                   # all'equivalente in base ottale.
 
  $_ = chr $_;                     # Il numero viene convertito nel carattere
                                   # ASCII corrispondente (ad esempio 65
                                   # equivale alla A maiuscola).
 
  print $_;                        # Infine questo carattere viene stampato.
 
}
 
# Ho sostituito gli 0 con degli * per maggior chiarezza, il risultato è uguale.
 
__DATA__
         **O**O***O**O****      ***O         DD******O*
        *DO*******O****O**     O*****        **O*****O*O
        ****      *O*         O**  O**       **D     *DO
         **O*     *O*        **D    ***      DO*D*****D
          *O**    DOD       ******O*****     ***  O**O
 DD****D***O*     ***      *O**O****D**DO    *OD   D**O***D**O*
 *****DO**O*      ***     ***O        **D*   O*D    O*****O*DO*
 
 *O***   OD*D   O**O*   ****         DDDO******      O**O******
  *O*** O**DDO *****   *O*D**        **O*O*****O    *O**O******
   *O*O**OD*****DDD   **O  *D*       DDD     D*O    **O*D
    *****O********   O**    DO*      D**D**O***      **D**
     D*O**  O****   ***O***O**DO     ***  **O*        *OD**
      O**    ***   *O***D***O**O*    ***   *D*O******O**O**
       *      *   *O*D        ****   *O*    *O*******O***O
 
__END__

Il trucco sta nell'associare alle sequenze di zeri consecutivi una cifra (il numero di zeri consecutivi), e da queste cifre ricavare dei caratteri.

Ad esempio, la prima lettera (O) è preceduta da 2 asterischi, la seconda lettera pure è preceduta da 2 asterischi, la terza lettera è preceduta da 3 asterischi; per cui si ottiene il numero 223, e si ha che chr(oct(223-111)) == 'J', che è la prima lettera della frase offuscata.

Per il momento, queste offuscazioni non sono state ancora sufficienti per nascondere ai nostri attenti occhi il segreto della fatidica scritta :-)

L'albero degli operatori

Ecco ora un codice graficamente divertente!

#Clinton Pierce
#note: Requires 5.6.0 or better
 
                    '% * % % * % %<>
               * % ~ * % % * % * * % *      *
       * % % * *   % * % *<> * % ~   % % % * %
     *  * * % * % % % % * % % % % % % * % % * %
     % * % % ^ * % % % % *[] % % * * % * * % %  %
      % * %   % % % % % * * % * * @ *   @ % * % %
    % ^ % * % * % * * % % * %  <> % % % % * % %() %
  % % * * * % % * % % * * % * * * * % * * % % * * *
   %   * * * % % * % % *[]<> % % % % * % * * * % % *<>
 % * *  % % % * * % * * * \ * %\ * * *   %/ \ # % * *
  % % % *\ * /\ * *// %  %\ <>\ // % %/ % \// % * %
    * * *\ \|| \ \/ / % %// \ \ *\ /<> %//  %// % %<>
   * % * %\  \  |   | ||// % || //  \// % // * * * %
   %{} %  * ----\   \ | /   %||//   /  ---/ / * % % *
     % *  *\ ____\   \| |    /  /  /   /----/ * %
            \ ----\     |   /   //    /
                   \     \ /        /'
                    =~m/(.*)/s;$_=$1;
                     s![-\\|_/\s]!!g
                       ;%e=('%',0,
                       '^',132918,
                       '~'=>18054,
                       '@'=>19630,
                       '*' =>0b01,
                       '#'=>13099,
                       '[]'=>4278,
                       '<>'=>2307,
                       '{}'=>9814,
                       '()',2076);
                       for $a(keys
                       %e){$e{$a}=
                       sprintf"%b"
                       , $e{$a};}
                     $y= qq{(}.join(
                     '|',map "\Q$_\E"
                   ,keys %e).qq{)};s/$y
              /$e{$1}/gex;print pack"B*",$_;
 

Che bello l'albero, vero? Un vero peccato abbatterlo :-(

#!/usr/bin/perl
 
                    '% * % % * % %<>
               * % ~ * % % * % * * % *      *
       * % % * *   % * % *<> * % ~   % % % * %
     *  * * % * % % % % * % % % % % % * % % * %
     % * % % ^ * % % % % *[] % % * * % * * % %  %
      % * %   % % % % % * * % * * @ *   @ % * % %
    % ^ % * % * % * * % % * %  <> % % % % * % %() %
  % % * * * % % * % % * * % * * * * % * * % % * * *
   %   * * * % % * % % *[]<> % % % % * % * * * % % *<>
 % * *  % % % * * % * * * \ * %\ * * *   %/ \ # % * *
  % % % *\ * /\ * *// %  %\ <>\ // % %/ % \// % * %
    * * *\ \|| \ \/ / % %// \ \ *\ /<> %//  %// % %<>
   * % * %\  \  |   | ||// % || //  \// % // * * * %
   %{} %  * ----\   \ | /   %||//   /  ---/ / * % % *
     % *  *\ ____\   \| |    /  /  /   /----/ * %
            \ ----\     |   /   //    /
                   \     \ /        /'
 
                    =~ m/(.*)/s;
 
# La stringa racchiusa da '' e contenente simboli quali %,*,ecc. viene passata
# alla regular expression "grezza" m/(.*)/s, la quale semplicemente elimina i
# ritorni a capo (\n) ed assegna alla variabile $1 il contenuto della stringa
# ottenuta.
 
$_ = $1; # $_ ora contiene la stringa
 
$_ =~ s![-\\|_/\s]!!g; # Con questa istruzione cancelliamo i seguenti simboli:
                       # "-","\","|","_","/"; inoltre elimina gli spazi vuoti.
 
%e  =  (
 
        '%' => 0,
        '^' => 132918,
        '~' => 18054,
        '@' => 19630,
        '*' => 0b01,
        '#' => 13099,
       '[]' => 4278,
       '<>' => 2307,
       '{}' => 9814,
       '()' => 2076
 
       );
 
for $a(keys%e) {
 
  $e{$a} = sprintf ("%b", $e{$a} ); # In questa maniera i valori contenuti nel
                                    # l'hash %e vengono convertiti in valori
                                    # binari (es. 2076  100000011100).
}
 
$y  = "(";
 
$y .= join('|',map {"\Q$_\E"} keys %e); # Le chiavi dell'hash %e vengono
                                        # concatenate per formare il pattern
                                        # da utilizzare nella regex successiva.
$y .= ")";
 
# $y ora equivale a:
# (\Q[]\E|\Q^\E|\Q<>\E|\Q~\E|\Q{}\E|\Q@\E|\Q()\E|\Q*\E|\Q#\E|\Q%\E)
 
# I caratteri sono compresi fra \Q ed \E affinché vengano interpretati "alla
# lettera" piuttosto che considerati come caratteri speciali (ad esempio "^"
# non indicherà alla regex di cercare all'inizio della stringa).
 
s/$y/$e{$1}/gex;
 
# Quando la regex trova una delle seguenti sequenze di caratteri
# [] ^ <> ~ {} @ () * # %
# viene sostituita col valore ad essa associato nell'hash %e.
 
# (Esempio: la prima corrispondenza, "%", viene associata alla variabile $1;
# poi, "%" viene sostituito col valore contenuto da $e{$1} ( $e{'%'} ), ossia
# con lo 0. Quando poi invece vengono trovati i caratteri [] vicini, essi
# vengono sostituiti dal contenuto di $e{'[]'}, cioé 1000010110110 (ossia il
# numero 4278 convertito in base binaria.)
 
# Ora $_ contiene una serie di 0 e di 1 (488, per l'esattezza).
 
print pack("B*",$_);
 
__END__

Infine fu pack(): per chi non lo ricordasse, questa funzione, associata al parametro "B*", fa sì che i valori contenuti in $_ vengano scompostiin gruppi da 8, e che questi "ottetti" vengano considerati come i bit diun byte e come tali vengano convertiti nel carattere corrispondente.
Così 488 viene diviso in 61 gruppi di bit, ciascuno equivalente a ognuno dei 61 caratteri della frase stampata dallo script. Ecco uno schemachiarificatore:

(i byte sono considerati little-endian)

01001001  I
00100000
01110100  t
01101000  h
01101001  i
01101110  n
01101011  k
00100000
01110100  t
01101000  h
01100001  a
01110100  t
00100000
01001001  I
00100000
01110011  s
01101000  h
01100001  a
01101100  l
01101100  l
00100000
01101110  n
01100101  e
01110110  v
01100101  e
01110010  r
00100000
01110011  s
01100101  e
01100101  e
00100000
01100001  a
00100000
01110000  p
01110010  r
01101111  o
01100111  g
01110010  r
01100001  a
01101101  m
00100000
01100001  a
01110011  s
00100000
01101100  l
01101111  o
01110110  v
01100101  e
01101100  l
01111001  y
00100000
01100001  a
01110011  s
00100000
01100001  a
00100000
01110100  t
01110010  r
01100101  e
01100101  e
00101110  .

Leggendo dall'alto verso il basso, è finalmente chiaro da dove proviene
la frase finale.

Il cammello Perl

Ecco ora un vero capolavoro, il sorgente-cammello per eccellenza :-)

Autore: Erudil from http://www.perlmonks.com/

#!/usr/bin/perl -w                                      # camel code
use strict;
 
                                           $_='ev
                                       al("seek\040D
           ATA,0,                  0;");foreach(1..3)
       {<DATA>;}my               @camel1hump;my$camel;
  my$Camel  ;while(             <DATA>){$_=sprintf("%-6
9s",$_);my@dromedary           1=split(//);if(defined($
_=<DATA>)){@camel1hum        p=split(//);}while(@dromeda
 ry1){my$camel1hump=0      ;my$CAMEL=3;if(defined($_=shif
        t(@dromedary1    ))&&/\S/){$camel1hump+=1<<$CAMEL;}
       $CAMEL--;if(d   efined($_=shift(@dromedary1))&&/\S/){
      $camel1hump+=1  <<$CAMEL;}$CAMEL--;if(defined($_=shift(
     @camel1hump))&&/\S/){$camel1hump+=1<<$CAMEL;}$CAMEL--;if(
     defined($_=shift(@camel1hump))&&/\S/){$camel1hump+=1<<$CAME
     L;;}$camel.=(split(//,"\040..m`{/J\047\134}L^7FX"))[$camel1h
      ump];}$camel.="\n";}@camel1hump=split(/\n/,$camel);foreach(@
      camel1hump){chomp;$Camel=$_;y/LJF7\173\175`\047/\061\062\063\
      064\065\066\067\070/;y/12345678/JL7F\175\173\047`/;$_=reverse;
       print"$_\040$Camel\n";}foreach(@camel1hump){chomp;$Camel=$_;y
        /LJF7\173\175`\047/12345678/;y/12345678/JL7F\175\173\0 47`/;
         $_=reverse;print"\040$_$Camel\n";}';;s/\s*//g;;eval;   eval
           ("seek\040DATA,0,0;");undef$/;$_=<DATA>;s/\s*//g;(   );;s
             ;^.*_;;;map{eval"print\"$_\"";}/.{4}/g; __DATA__   \124
               \1   50\145\040\165\163\145\040\157\1 46\040\1  41\0
                    40\143\141  \155\145\1 54\040\1   51\155\  141
                    \147\145\0  40\151\156 \040\141    \163\16 3\
                     157\143\   151\141\16  4\151\1     57\156
                     \040\167  \151\164\1   50\040\      120\1
                     45\162\   154\040\15    1\163\      040\14
                     1\040\1   64\162\1      41\144       \145\
                     155\14    1\162\       153\04        0\157
                      \146\     040\11     7\047\         122\1
                      45\15      1\154\1  54\171          \040
                      \046\         012\101\16            3\16
                      3\15           7\143\15             1\14
                      1\16            4\145\163           \054
                     \040            \111\156\14         3\056
                    \040\         125\163\145\14         4\040\
                    167\1        51\164\1  50\0         40\160\
                  145\162                              \155\151
                \163\163                                \151\1
              57\156\056

Se lanciando questo script rimanete a bocca aperta non preoccupatevi, è un normale effetto collaterale! Anche qui c'è il trucco, che ora esamineremo.

Innanzitutto, bisogna dire che non è possibile "mettere ordine" nelle istruzioni senza compromettere il risultato dello script. Questo perché lo script legge prima se stesso (per cui non funzionerà se passato all'interprete tramite lo STDIN, ma soltanto se salvato prima in un file e poi lanciato), poi stampa una versione "in scala" del codice trattato come se fosse un normale disegno in ASCII-art.

Il sorgente viene trattato tramite un filehandle, e vengono man mano letti "blocchi" di caratteri di grandezza 2×2, come questo

XX
XX

e in base al numero e alla posizione degli spazi bianchi presenti in
questi "blocchi" vengono stampate le lettere. Come si nota dal
risultato, blocchi aventi soltanto spazi bianchi fanno stampare uno
spazio bianco, mentre blocchi aventi tutti non-spazi stampano una "X".
Ma ecco una piccola legenda prima dei chiarimenti sul codice:

(gli * rappresentano gli spazi, le X i caratteri non-spazi)

**               **               **
**  " "          *X  "."          X*  "."
 
**               *X               X*
XX  "m"          XX  "J"          XX  "L"
 
XX               X*               *X
**  "^"          **  "'"          **  "`"
 
XX               X*               *X
XX  "X"          *X  "\"          X*  "/"
 
XX               XX               *X
*X  "7"          X*  "F"          *X  "{"
 
X*
X*  "}"

I più attenti noteranno una vaga somiglianza fra il disegno rappresentato dai blocchi dei caratteri e il carattere a loro corrispondente... Infatti il risultato finale è una versione in scala 1 a 4 del disegno rappresentato dal sorgente, ripetuto per quattro volte.

Prima di andare avanti esaminiamo il codice che ottiene il risultato sopra descritto.

$_='
 
eval("seek DATA,0,0;");    # L'istruzione seek con questi parametri manipola in
                           # modo originale il filehandle DATA. Visto che
                           # quest'ultimo è un filehandle che punta al sorgente
                           # dello script alla posizione del token __DATA__,
                           # settando questa posizione allo 0 ottengo un
                           # handle che punta all'inizio del codice sorgente.
 
foreach(1..3) { <DATA>; }  # Butta via le prime tre righe dello script.
 
my @camel1hump;
my $camel;
my $Camel;
 
while(<DATA>){
 
  $_=sprintf("%-69s",$_);  # Aggiunge degli spazi vuoti al termine di ogni riga
                           # in modo che siano tutte della stessa lunghezza e
                           # si possa poi ottenere l'effetto simmetria.
 
                           # PS: provate a settare un valore basso al posto di
                           #     69 :-)
 
  my @dromedary1=split(//); # Ogni carattere della riga letta viene associato
                            # a un elemento dell'array.
 
  if(defined($_=<DATA>)){
 
    @camel1hump=split(//); # Stessa cosa per la riga immediatamente successiva.
 
  }
 
  while(@dromedary1){ # Finché esistono elementi in @dromedary1 viene ripetuto
                      # il ciclo (vengono sottratti a coppie di 2 dagli shift()
                      # sottostanti).
 
    my $camel1hump=0;
    my $CAMEL=3;
 
    if(defined($_=shift(@dromedary1)) && /\S/ ){ # Questa e le condizioni
                                                 # successive sono verificate
                                                 # il carattere non è uno spazio
 
      $camel1hump+=1<<$CAMEL;  # $camel1hump += 8;
 
                               # Per chi non lo ricordasse, l'operatore <<,
                               # detto semplicemente, aggiunge degli zeri
                               # alla destra del numero, portato però in
                               # versione binaria.
 
                               # Esempio: 2  0b10; 2<<2  0b1000 == 8;
                               #          (aggiunti 2 zeri a 0b10)
    }
 
    $CAMEL--;
 
    if(defined($_=shift(@dromedary1)) && /\S/ ){
 
      $camel1hump+=1<<$CAMEL;  # $camel1hump += 4;
 
    }
 
    $CAMEL--;
 
    if(defined($_=shift(@camel1hump)) && /\S/ ){
 
      $camel1hump+=1<<$CAMEL;  # $camel1hump += 2;
 
    }
 
    $CAMEL--;
 
    if(defined($_=shift(@camel1hump)) && /\S/ ){
 
      $camel1hump+=1<<$CAMEL;  # $camel1hump += 1;
 
    }
 
    $camel.=(split(//," ..m`{/J\047\134}L^7FX"))[$camel1hump];
 
    # A seconda dei caratteri nei "blocchi" estratti e del conseguente 
    # risultato finale di $camel1hump, viene aggiunto a $camel, che verrà poi
    # stampato, un determinato carattere (vedi legenda sopracitata).
 
    # \047 e \134 vengono interpolati ed equivalgono a "'" e a "\" .
 
  }
 
  $camel.="\n";
 
foreach $_ (@camel1hump) {
 
  chomp $_;
  $Camel = $_;
 
  y/LJF7\173\175`\047/12345678/;  # Distrattore: trasforma determinati
  y/12345678/JL7F\175\173\047`/;  # caratteri in numeri, poi li riporta come
                                  # prima.
 
  $_ = reverse $_;
  print "$_ $Camel\n";            # Stampa la stringa in modo simmetrico.
 
}
 
foreach $_ (@camel1hump) {
 
  chomp $_;
  $Camel = $_;
 
  y/LJF7\173\175`\047/12345678/;  # Vedi commento di prima.
  y/12345678/JL7F\175\173\047`/;
 
  $_ = reverse $_;
  print " $_$Camel\n";            # Come prima, in maniera rovesciata.
 
}
 
';        # Qui termina la stringa assegnata a $_
 
s/\s*//g; # Cancella tutti gli spazi in $_
 
eval;     # Tramuta in codice Perl la stringa $_, e lo esegue

Il codice è stato inserito nella variabile $_ e poi eseguito con eval() perché nella forma "cammelloidale" quelle istruzioni avrebbero generato errori. In questo modo, invece, si riesce a preservare il disegno e poi ad eseguire il codice, privandolo prima degli spazi di troppo.

Noterete dei caratteri ottali nel codice originale: sono stati messi sia per completare il disegno, sia per mettere un po' di confusione.

A completamento dello script, ecco l'ultima parte, ristrutturata, del disegno:

eval("seek\040DATA,0,0;"); # Come prima, puntatore all'inizio del sorgente.
 
undef $/;                  # Vedi script precedenti.
 
$_ = <DATA>;               # $_ contiene tutto il disegno
 
s/\s*//g;                  # Elimina gli spazi vuoti
 
(   );                     # Una lista vuota in contesto vuoto... utile :)
 
s/^.*_//;                  # Cancella tutto fino a __DATA__ compreso.
 
 
# Ora $_ contiene il seguente insieme di cifre ottali:
 
# \124\150\145\040\165\163\145\040\157\146\040\141\040\143\141\155\145\154\040
# \151\155\141\147\145\040\151\156\040\141\163\163\157\143\151\141\164\151\157
# \156\040\167\151\164\150\040\120\145\162\154\040\151\163\040\141\040\164\162
# \141\144\145\155\141\162\153\040\157\146\040\117\047\122\145\151\154\154\171
# \040\046\012\101\163\163\157\143\151\141\164\145\163\054\040\111\156\143\056
# \040\125\163\145\144\040\167\151\164\150\040\160\145\162\155\151\163\163\151
# \157\156\056
 
map { eval ("print\"$_\""); } $_ =~ /.{4}/g; # La regex passa a map() ogni
                                             # corrispondenza, ossia un numero
                                             # ottale. Poi questo viene
                                             # interpolato da eval() e stampato
 
# Per convertire un ottale in carattere: printf "%c\n",\0101;

Un modo come un altro di citare i diritti d'autore :-)

The Perl Journal

Ora, direttamente dall'Obfuscated Perl Contest, una chicca per i mistificatori
di codice:

/;{}def/#{def}def/$_={/Times-Bold exch selectfont}#/_{rmoveto}#/"{dup}#/*/!/$
;/q{exch}#/x ; {/J q #}#/.{/T q #}#{stringwidth}#{}#{}# 14 string dup dup dup
260 40 moveto 90 rotate ; %/}};$0='"\e[7m \e[0m"';@ARGV=split//,reverse
q(ThePerl). q(Journal) x 220 ; q ; 0 T putinterval exch 7 J putinterval ;
 ; $_= q /m$ pop T($*!$"=!$ " )pop " * true% ? $ " $!" "  !!  !! % !" !"    !
! charpath {!"""}pop $ pop{""!}pop ! neg{!#}pop 220 ! neg _{!!}pop J false %T
charpath  clip " pop 0 " moveto 6{!!}pop $_= 105{!!}pop {$ ! $ " !  #! ##}
pop{dup dup $ ! " pop pop q{"}pop 22{dup show}repeat {"}pop q 22 mul{$ "} pop
neg{!#! $ "}pop ! 8 .65 mul{$ # # $}pop ! neg{"}pop  _ pop{"}pop } repeat pop
" {  $ " ! ! ! $ " ! !" "#"  #"!"""""! #" " # "m/;@ARGV=(@ARGV[-14..-1])x50;q}
 0 "%};s/m[ou]|[-\dA-ln-z.\n_{}]|\$_=//gx;s/(.)(?{$*=''})/('$*.='.(++$#
%2?'':"$0;").'pop;')x(ord($1)-31).'$*'/gee;s/((.(\e\[.m)*|.){77})/$1\n/g;print
; sub showpage {}

Vi evito l'ingrato compito di riordinare il programma, riportandolo di seguito:

$0 = '"\e[7m \e[0m"';
 
@ARGV = split //, reverse q(ThePerlJournal) x 220;
 
$_ = q /m$ pop T($*!$"=!$ " )pop " * true% ? $ " $!" "  !!  !! % !" !"    !
! charpath {!"""}pop $ pop{""!}pop ! neg{!#}pop 220 ! neg _{!!}pop J false %T
charpath  clip " pop 0 " moveto 6{!!}pop $_= 105{!!}pop {$ ! $ " !  #! ##}
pop{dup dup $ ! " pop pop q{"}pop 22{dup show}repeat {"}pop q 22 mul{$ "} pop
neg{!#! $ "}pop ! 8 .65 mul{$ # # $}pop ! neg{"}pop  _ pop{"}pop } repeat pop
" {  $ " ! ! ! $ " ! !" "#"  #"!"""""! #" " # "m/;
 
@ARGV = ( @ARGV[ -14 .. -1 ] ) x 50;
 
s/m[ou]|[-\dA-ln-z.\n_{}]|\$_=//gx;
 
s/(.)(?{$*=''})/('$*.='.(++$#%2?'':"$0;").'pop;')x(ord($1)-31).'$*'/gee;
 
s/((.(\e\[.m)*|.){77})/$1\n/g;
 
print;

Questo è il codice che produce qualche risultato; per il resto si tratta
di "specchietti per le allodole" (funzioni e blocchi che ritornano
valori in contesti vuoti, o regex che trattano la $_ ancora vuota).

C'è comunque da lavorarci per capire qualcosa! Con l'istruzione

$0 = '"\e[7m \e[0m"';

la variabile conterrà uno spazio vuoto dello stesso colore del testo,
formando un rettangolo colorato, che costituirà la parte finale
dell'output.

Poi @ARGV; niente di che, contiene un array fatto dalle lettere,
ordinate al contrario, di "ThePerlJournal"; il tutto ripetuto
(inutilmente) 220 volte.

Dopo, l'istruzione

@ARGV = ( @ARGV[ -14 .. -1 ] ) x 50;

prende i suoi 14 ultimi elementi (ossia la frase iniziale al contrario)
e sovrascrive il vecchio array con questa lista ripetuta 50 volte.
Ancora, è solo un modo molto complicato di fare delle cose semplici.

Poi, la dichiarazione di $_ : cosa ci potrà mai essere di buono in tutta
quella confusione? Comunque, dopo l'istruzione

s/m[ou]|[-\dA-ln-z.\n_{}]|\$_=//gx;

che cancella qualche cosetta, le cose sembrano migliorare

m$  ($*!$"=!$ " ) " * % ? $ " $!" "  !!  !! % !" !"    !!  !""" $ ""! ! !#  !  !
!   %   "   "  !!  !! $ ! $ " !  #! ##  $ ! "   "   "   $ " !#! $ " !   $ # # $
 ! "   "   "   $ " ! ! ! $ " ! !" "#"  #"!"""""! #" " # "m

ma tutto è chiaro dopo la seguente regex:

s/(.)(?{$*=''})/('$*.='.(++$#%2?'':"$0;").'pop;')x(ord($1)-31).'$*'/gee;

Come dite? Non si capisce un fico secco? In effetti, è decisamente il caso di
chiarire ulteriormente!

s/
  (.)(?{$*=''})
/
  (
 
   '$*.= ' . 
 
   ( ++$# % 2 ? '' : "$0;" ) .
 
   'pop;'
 
  ) x (ord($1)-31) . '$*'
 
/geex;

(Riferimenti sulle regular expression: man perlre)

Questa espressione compie una sostituzione per ogni carattere contenuto in $_; inoltre, il blocco (?{$*=''}) , che non influenza in nessun modoil pattern da ricercare, cancella il contenuto della variabile $* prima di lasciar compiere una sostituzione sul carattere successivo trovato (la regex termina per /g). Ora, grazie alla stringa "ee" presente alla fine del l'operatore s///, l'ultima parte della regex viene considerata come un blocco da eseguire preliminarmente (come se fosse passato alla eval() ), e poi da interpolare prima di sostituire.

Il blocco fa sì che, alternativamente, vengano stampati caratteri da @ARGV (con l'istruzione "pop;") o quei rettangoli contenuti in $0. Esaminando con attenzione il codice, sarà chiaro come l'interprete riesce a capire quando stampare la scritta normale e quando il rettangolo colorato fino a formare "The Perl Journal".

La prima volta che la regex trova un carattere da sostituire (il primo, "m"), la istruzione "++$# % 2" restituisce 1 (di nuovo, non bisogna lasciarsi depistare dall'eventuale valore particolare dato di default alle variabili: in questo caso $# è undef e ++$# è uguale a 1). Per cui

('$*.='.(++$#%2?'':"$0;").'pop;')

restituirà la stringa

'$*.=pop;'

dopodiché essa verrà ripetuta (ord($1)-31) volte. Per cui si capisce
come i caratteri di $_ siano stati scelti appositamente per restituire
un determinato codice ASCII e far ripetere l'operazione un determinato
numero di volte. Alla fine avremo:

$*.=pop;$*.=pop;$*.=pop;$*.=pop;$*.=pop;$*.=pop;   # fino a 78 volte

Alla fine di questa trafila, vi è la semplice la stringa "$*;", che indica, al momento della fase di interpolazione del carattere da sostituire, di utilizzare la stringa ottenuta dai 78 elementi pop()ati da @ARGV.

Dopodiché, si passa al secondo carattere di $_; stavolta "++$# % 2"
restituirà 0, e avremo una sequenza differente:

$*.="$0";pop;$*.="$0";pop;$*.="$0";pop;            # fino a 5 volte

Alla fine, la variabile $* che sarà sostituita al carattere di $_ sarà pari a 5 rettangoli consecutivi.

Arrivati al terzo carattere di $_, viene ripetuta la sostituzione iniziale, ossia con le lettere in @ARGV. I precedenti pop() hanno fatto in modo che siano stati cancellati elementi tali da dare l'effetto di "sovrapposizione" nel testo stampato alla fine.

Infine:

s/((.(\e\[.m)*|.){77})/$1\n/g;

in tal modo viene inserito in $_ un \n ogni 77 caratteri (il pattern è fatto in modo da considerare "\e[7m \e[0m", ossia il rettangolino, come un carattere).

Questo script compie tanta fatica, ma per il risultato ne vale la pena :-)

Uno script ambiguo

#Abigail
$;                                   # A lone dollar?
=$";                                 # Pod?
$;                                   # The return of the lone dollar?
{Just=>another=>Perl=>Hacker=>}      # Bare block?
=$/;                                 # More pod?
print%;                              # No right operand for %?

A domanda, risposta:

$;                                   # No, ";" è proprio il nome di una variabile
				     # (referenziata dalla notazione "$;")
 
=$";                                 # No, operatore d'assegnamento per $;
 
$;                                   # No, ora si tratta dell'hash %;
 
{Just=>another=>Perl=>Hacker=>}      # No, serie di chiavi riferita a %;
 
=$/;                                 # No, assegna \n all'ultima chiave
 
print%;                              # No, nell'ultima istruzione può essere
                                     # omesso il ; , per cui stampa %;

Chiedo scusa, ma questo script era una provocazione che andava raccolta :)

Lettere scorrevoli

Tornando ai programmi più "seri", ecco un altro script interessante, di Abigail:

@_=map{[$!++=>$_^$/]}split$æ=>"\@\x7Fy~*kde~box*Zoxf*Bkiaox";$\="\r";
$|=++$*;do{($#=>$=)=(rand@_=>rand@_);@_[$#,$=]=@_[$=,$#]}for($*..@_);
for$:($|..@_-$|){for($|..@_-$:){@_[$_-$|,$_]=@_[$_=>$_-$*]if$_[$_][$º
]<$_[$_-$*][$Æ];print+map{$_->[$|]}@_;select$Ö,$É,$á,"$[.$|"}}print$/

Ancora una volta il risultato supera le nostre aspettative. Ecco la matassa
parzialmente sbrogliata:

#!/usr/bin/perl
 
@_ = map {[ $!++ , $_^$/]} split $æ=>"\@\x7Fy~*kde~box*Zoxf*Bkiaox";
 
$\ = "\r";
 
$| = ++$*;
 
do {
 
  ($#, $=) = (rand @_, rand @_);
 
  @_[$#,$=] = @_[$=,$#]
 
} for ($* .. @_);
 
for $: ($| .. @_ - $|) {
  for ($| .. @_ - $:) {
 
    if (  $_[$_][$º] < $_[$_-$*][$Æ]  ) {
 
      @_[$_-$|, $_] = @_[$_ , $_-$*];
 
    }
 
    print map { $_->[$|] } @_;
 
    select $~E, $~C, $~G, "$[.$|";
 
  }
}
 
print $/;  # Stampa "\n"

Ancora una volta non mancano delle offuscazioni... "=>" usati a sproposito al posto delle "," (sono però equivalenti!), nomi strani di variabili (tutte quelle col nome tipo "$æ" sono da considerarsi equivalenti inusuali della stringa vuota), ma con una buona indentazione non ci saranno molte difficoltà.

@_ = map {[ $!++ , $_^$/]} split =>"\@\x7Fy~*kde~box*Zoxf*Bkiaox";

Questa istruzione crea un array bidimensionale @_, in cui ogni elemento
contiene a sua volta uno dei 125 messaggi di errore dell'interprete
(ottenuti con successive iterazioni di $!++), e il risultato dello XOR
fra uno dei caratteri della "scritta strana" e il ritorno a capo. Guarda
caso, le lettere risultanti dallo XOR formano una frase familiare..

 $i     |         $_[$i][0]                         |  $_[$i][1]
--------+-------------------------------------------+-------------
  0     |                                           |      J
  1     |  Operazione non permessa                  |      u
  2     |  File o directory inesistente             |      s
  3     |  Processo inesistente                     |      t
  4     |  Chiamata di sistema interrotta           |
  5     |  Errore di input/output                   |      a
  6     |  Dispositivo o indirizzo inesistente      |      n
  7     |  Lista degli argomenti troppo lunga       |      o
  8     |  Errore di formato di exec                |      t
  9     |  Descrittore di file non valido           |      h
  10    |  Non ci sono processi figli               |      e
  11    |  Risorsa temporaneamente non disponibile  |      r
  12    |  Impossibile allocare memoria             |
  13    |  Permesso negato                          |      P
  14    |  Indirizzo non valido                     |      e
  15    |  E' necessario un dispositivo a blocchi   |      r
  16    |  Dispositivo o risorsa occupata           |      l
  17    |  Il file esiste                           |
  18    |  Link tra dispositivi non valido          |      H
  19    |  Dispositivo inesistente                  |      a
  20    |  Non è una directory                      |      c
  21    |  E' una directory                         |      k
  22    |  Argomento non valido                     |      e
  23    |  Troppi file aperti nel sistema           |      r

Forse è una tabella che risulta inutile, ma da essa si può incominciare a capire su cosa si basa il trucco usato dall'autore. Infatti vedremo che le stringhe di errore non verranno usate, mentre le lettere della frase sì. Ma andiamo con ordine.

$\ = "\r";

La variabile $\, ricordo, è il separatore di linea dell'output, ossia quello che viene stampato dopo qualsiasi istruzione print(). Con il carattere "\r", "carriage return", l'ultima linea stampata viene cancellata ed ogni print() sovrascriverà la precedente: settando $\ a tale valore avviene una continua "sovrapposizione" di scritte, a formare
l'effetto di animazione finale. Provando a settare questa variabile con "\n" le cose saranno ancora più chiare.

$| = ++$*;

La variabile $*, che in questo caso non è considerata per il suo valore speciale, viene settata ad 1 e $| acquista il suo valore. Quando questa variabile viene settata, il buffering viene disabilitato, ed ogni operazione di scrittura viene effettuata immediatamente (la qual cosa, tuttavia, non influisce sullo script).

do {
 
  ($#, $=) = (rand @_, rand @_);
 
  @_[$#,$=] = @_[$=,$#]
 
} for ($* .. @_);  # Da 1 a 23

Per un numero di volte pari alla grandezza dell'array, due elementi di @_ a caso vengono invertiti fra di loro in modo da mischiare le lettere della frase. Ora viene il bello:

for $: ($| .. @_ - $|) {          # 1 .. 22
  for $_ ($| .. @_ - $:) {        # 1 .. ( 22 .. 1 )
 
    if ( $_[$_] < $_[$_-$*] ) {   # Ho sostituito $_[$_][$º] e $_[$_-$*][$Æ]
                                  # con $_[$_] e $_[$_-$*], visto che il dato
                                  # restituito è lo stesso (la reference che
                                  # punta ad un sub-array).
 
      @_[$_-$|, $_] = @_[$_ , $_-$*];
 
    }
 
    print map { $_->[$|] } @_;
 
    select $~E, $~C, $~G, "$[.$|";
 
  }
}

Si tratta evidentemente di due cicli annidati. Il primo ciclo fa in modo che il secondo ciclo parta da un determinato carattere di @_ (quindi parte da uno e arriva quasi alla fine). Il secondo ciclo esegue delle istruzioni tra il carattere indicato dal ciclo precedente e l'ultimo carattere di @_. Per capire il perché di questo basta esaminare il resto del codice:

if (  $_[$_] < $_[$_-$*]  ) {
 
      @_[$_ - $|, $_] = @_[$_ , $_-$*];
 
}

Prima, però, un piccolo passo indietro. Al momento della creazione di @_, viene aggiunto per ogni iterazione di map() un elemento che viene a costituire parte di un array bidimensionale. Poiché in Perl questo tipo di array non è altro che un array contenente una serie di references ad altri array, anonimi, dando l'illusione della bidimensionalità, un istruzione del tipo $_[1] restituirà un dato di tipo reference, contenente la struttura a cui punta (ARRAY) e un numero esadecimale (es. 0x81070b8). Poiché man mano che @_ viene popolato di references il valore esadecimale associato alla reference cambia, otteniamo qualcosa di simile:

  $i  |  $_[$i][1]  |      $_[$i]
------+-------------+-------------------
  1   |      J      |  ARRAY(0x81070b8)
  2   |      u      |  ARRAY(0x81070e8)
  3   |      s      |  ARRAY(0x8107118)
  4   |      t      |  ARRAY(0x8107148)
  5   |             |  ARRAY(0x8107178)
  6   |      a      |  ARRAY(0x81071a8)
  7   |      n      |  ARRAY(0x81071d8)
  8   |      o      |  ARRAY(0x8107208)
  9   |      t      |  ARRAY(0x8107238)
  10  |      h      |  ARRAY(0x8107268)
  11  |      e      |  ARRAY(0x8107298)
  12  |      r      |  ARRAY(0x81072c8)
  13  |             |  ARRAY(0x81072f8)
  14  |      P      |  ARRAY(0x8107328)
  15  |      e      |  ARRAY(0x8107358)
  16  |      r      |  ARRAY(0x8123bcc)
  17  |      l      |  ARRAY(0x8123bfc)
  18  |             |  ARRAY(0x8123c2c)
  19  |      H      |  ARRAY(0x8123c5c)
  20  |      a      |  ARRAY(0x8123c8c)
  21  |      c      |  ARRAY(0x8123cbc)
  22  |      k      |  ARRAY(0x8123cec)
  23  |      e      |  ARRAY(0x8123d1c)
  24  |      r      |  ARRAY(0x8123d4c)

Si può notare che i valori esadecimali sono via via crescenti. In questo modo, pur mischiando le lettere della frase, essi sono utili per ricomporre l'ordine iniziale.

Così, al momento dell' if() , se il carattere indicato da $_, considerando la frase "Just another perl Hacker", viene dopo il carattere alla sua sinistra, questi due caratteri vengono invertiti. Altrimenti, @_ rimane invariato. Dopo, l'array viene subito stampato
sovrascrivendo il testo precedente (vedi \r)

print map { $_->[$|] } @_;   #  $| == 1

Eppoi viene effettuata una piccola pausa, tramite l'uso "improprio" della chiamata di sistema select(2):

select '', '', '', "$[.$|";  # $~E==$~C==$~G==undef;
                             # "$[.$|" è un numero casuale fra 0 e 0.23

Questa istruzione ritorna un valore dopo un numero casuale di millisecondi, fungendo come una funzione sleep().

Esaminiamo con un esempio il meccanismo di sostituzione dei caratteri:

l ae PtanrheuckrsJHetor   # comincia facendo "spostare" lo " " al posto di "l"
la e PtanrheuckrsJHetor   # ha invertito " " con "a"
lae  PtanrheuckrsJHetor   # stavolta  " " <-> "e"
lae  PtanrheuckrsJHetor   # scambia i due spazi vuoti
lae P tanrheuckrsJHetor   # " " <-> "t"
lae Pt anrheuckrsJHetor   # ATTENZIONE: la "a" viene, nell'ordine, dopo lo " "
lae Pt anrheuckrsJHetor    
lae Pt narheuckrsJHetor   # Inverte la "a" con la "n"
lae Pt narheuckrsJHetor   # ATTENZIONE: la "r" di "Hacker" va dopo la "a"
lae Pt nahreuckrsJHetor   # Ora la "r" è quella a essere spostata
lae Pt naheruckrsJHetor
lae Pt naheurckrsJHetor
lae Pt naheucrkrsJHetor
lae Pt naheuckrrsJHetor
lae Pt naheuckrrsJHetor
lae Pt naheuckrsrJHetor
lae Pt naheuckrsJrHetor
lae Pt naheuckrsJHretor
lae Pt naheuckrsJHertor
lae Pt naheuckrsJHetror
lae Pt naheuckrsJHetorr
lae Pt naheuckrsJHetorr
lae Pt naheuckrsJHetor r  # poiché la "r" è l'ultima, arriva fino alla fine
ale Pt naheuckrsJHetor r  # ricomincia partendo con la "l"

Tutto questo ripetuto per ogni carattere: si parte dal primo carattere, sostituendolo man mano col successivo se questo non viene dopo nella successione "Just another perl Hacker", altrimenti si sposta quel carattere, finché non viene spostato un carattere fino alla suaposizione originaria. Ciò è ripetuto per ogni carattere, finché non è raggiunto l'ordine giusto. Questo algoritmo è noto in letteratura col nome di Bubble Sort.

Spero di essere riuscito a rendere il meccanismo dello script! Da tutto questo si capisce che le stringhe di errore inserite in @_ non erano inutili ma servivano affinché questo array fosse bidimensionale e fosse possibile poi metterlo in ordine tramite i valori esadecimali. Davvero ingegnoso!

Uno sbaglio volontario

Un altro script, anche esso originale:

#John Porter <jdporter@min.net>
eval { 62->lZRopcwjoXyup_yuGpXcxbyu() };
$@ =~ s/"(.*?)"/"ss"/;
print((split//,$@)[map{ord($_)-62}split//,$1],",\n");

Il suo meccanismo è molto semplice, ma è interessante dal punto di vista della
offuscazione: la eval() iniziale

eval { 62->lZRopcwjoXyup_yuGpXcxbyu() };

chiama un metodo inesistente da un oggetto inesistente, senza apparentemente generare errore. Quello che ci interessa però è il contenuto di $@

Can't call method "lZRopcwjoXyup_yuGpXcxbyu" without a package or object 
reference at ./4.pl line 3.

ossia l'errore catturato dalla "eccezione". Dopo, questo viene modificato
cambiando il testo tra le virgolette in questo modo

Can't call method "ss" without a package or object reference at ./4.pl line 3.

E infine

print ( (split//,$@)[map {ord($_)-62} split//,$1], ",\n" );

Con questa il contenuto di $1, ossia "lZRopcwjoXyup_yuGpXcxbyu", viene splittato e passato a map(), la quale restituisce i codici ASCII di questi caratteri dopo avergli sottratto 62. Intanto, la variabile $@ è stata divisa in un array di caratteri, di cui vengono stampati gli elementi con indice uguale ai valori restituiti da map(). Ancora una volta, ne caviamo "just another perl hacker,".

Il gioco del tris

Siamo finalmente giunti all'ultimo script, questa volta però creato da me :-) Si tratta di uno script che permette di giocare a tris contro il computer, e che è stato scritto per occupare il minor numero di caratteri possibile nel sorgente, usando i piccoli accorgimenti che abbiamo anche visto in precedenza. Ecco lo script:

#!/usr/bin/perl -nl
 
# Il gioco del tris più piccolo del mondo
# di Roberto Natella (rnatella@gmail.com)
 
#  1 2 3  <--  Scrivi una cifra da 1 a 9 e premi invio
#  4 5 6
#  7 8 9       X = giocatore       O = computer
 
sub t{grep{$_==($_[0]&$_)}84,273,73,146,292,7,56,448}sub c{$a+$b&pop}sub p{$h=-1
;for$o(1..7){$_=":"x9;$o%2||s/:::/$a&2**++$h?":X:":$b&2**$h?":O:":": :"/eg;print
}}sub f{map{for$}(0..8){return$b+=$}if!c($}=2**$})&&t$_+$}}}$b,$a;0while c$}=2**
int rand 9;$b+=$}}((t$a+=$_)||t$a|$b^511?f:511)^p&&exit if/[1-9]/&!c$_=2**($&-1)

Inizialmente, lo script non stampa nulla, e attende che il giocatore faccia una mossa. Per barrare una casella occorre scrivere un numero da 1 a 9 e premere invio. A ciascun numero è associata una casella (vedi commenti nello script), e ogni volta che il computer o l'utente effettuano una mossa viene stampata la tabella aggiornata. Se viene inserito un carattere non valido al posto di una cifra, si attende ancora che l'utente digiti una cifra correttamente. Il gioco termina quando uno dei giocatori ha fatto tris, oppure quando tutte le caselle sono state occupate.

Ed ecco la versione commentata del codice:

#!/usr/bin/perl -nl
 
# Il gioco del tris più piccolo del mondo
# di Roberto Natella (rnatella - chiocciola - gmail - punto - com)
 
# -n : il codice è da considerarsi come inserito in un ciclo while(<>) { ... }
# -l : inserisce per default "\n" al termine di ogni riga stampata da print()
 
use strict;
use warnings;
 
BEGIN
{
 our $player   = 0;  # Conterrà le mosse del giocatore, nello stesso formato di @winner_moves
 our $computer = 0;  # Mosse del computer
}
 
our $player;
our $computer;
 
my @winner_moves = ( 84,  # 001010100      Equivalente in binario,
                     273, # 100010001      da interpretarsi come elementi
                     73,  # 001001001      di una matrice 3x3
                     146, # 010010010
                     292, # 100100100      es. 84  0 0 1
                     7,	  # 000000111                0 1 0
                     56,  # 000111000                1 0 0
                     448  # 111000000
                   );
 
sub there_is_a_tris
{
  my $moves = shift; # Rappresenta le mosse di un giocatore (computer o utente) passate come parametro
		     # per verificare se c'é stato un tris
 
  return grep { $_  ($moves & $_) } @winner_moves;
 
  # Ipotizziamo che il giocatore abbia giocato finora 100101100
  #
  #   X _ _
  #   X _ X
  #   X _ _
  #
  # Si effettua la AND di $player con tutte le @winner_moves; quando una combinazione vincente
  # è stata trovata (es. 292)
  #
  # 300   100101100 AND
  # 292   100100100 =
  #      --------------
  # 292   100100100
  #
  # il risultato è uguale al secondo operando, e viene restituito il valore booleano TRUE
 
}
 
sub check_if_legal_move
{
  my $move = pop;
  return ($player + $computer) & $move;
 
  # $player+$computer rappresenta tutte le locazioni già occupate
  #
  #    player       computer       total
  #
  #    X _ X         _ O _         X O X
  #    _ _ X    +    O O _    =    O O X
  #    _ X _         _ _ O         _ X O
  #
  #  010100101     100011010     110111111   <-- Il bit più significativo è l'angolo
  #						 in basso a destra del quadrato
  #
  #   1 2 3	Se 1 è il bit meno significativo e 9 il più significativo,
  #   4 5 6     i bit in ciascuna posizione corrisponde ad una casella del quadrato
  #   7 8 9
  #
  # In questo esempio, se il giocatore sceglie una mossa legale (cioé, solo la settima casella)
  # si ha:
  #
  # 447        110111111 AND
  # 2**(7-1)   001000000 =
  #           --------------
  # 0          000000000
  # 
  # Altrimenti, si restituisce un valore diverso da 0 (es. se scelgo la quinta casella)
  #
  # 447        110111111 AND
  # 2(**5-1)   000010000 =
  #           -------------
  # 16         000010000
}
 
sub print_table
{
 
  my $h=-1;
 
  for my $o (1..7)
  {
 
    $_ = ":"x9;
 
    unless ($o%2)
    {
      s/:::/
            $h++;                      # Per ogni terzetto di bit, si deve stampare "X", "O" oppure " ".
            if($player & 2**$h)        # 2**$h è un vettore di bit che parte da
            {                          # $h = 0 => 2**$h = 000000001  e alla fine vale
             ":X:"                     # $h = 9 => 2**$h = 100000000
            } else {                   # Se la casella $h è occupata dal giocatore,
              if($computer & 2**$h)    # $player & 2**$h restituisce TRUE, si stampa "X"
              {                        # e si procede alla prossima iterazione, altrimenti, si ripete
               ":O:"                   # lo stesso per $computer, e si stampa "O" se si ha TRUE,
              } else {                 # altrimenti uno spazio
               ": :"
              }
            }
           /xeg;
    }
 
    print;
 
  }
 
}
 
sub computer_move     # Aggiorna le mosse del computer, e restituisce $computer aggiornata
{
 
  my $n;
 
  foreach $_ ($computer,$player)  # Si provano tutte le mosse, verificando se c'è qualche
  {                               # mossa vincente per il computer; altrimenti, si verifica
    for $n (0..8)                 # se c'è una mossa vincente per il giocatore, e ne
    {                             # si occupa la casella
      $n = 2**$n;
      if ( !check_if_legal_move($n)  &&  there_is_a_tris($_+$n) )
      {
        return $computer += $n;
      }
    }
  }
 
  do {           # Non ci sono mosse vincenti; si sceglie a caso
 
    $n = 2**(int rand 9);
  
  } while (check_if_legal_move($n));
 
  return $computer += $n;
 
}
 
# Programma principale
 
if ( /[1-9]/ && ! check_if_legal_move($_=2**($&-1)) )  # $& contiene la cifra trovata da /[1-9]/
{
 
  $player += $_;
 
  if ( there_is_a_tris($player) )
  {
    print_table();
    exit;
  }
  else
  {
    if ( ($player|$computer)^511 )   # Se la tabella non è stata riempita...
    { 
      if ( there_is_a_tris(computer_move()) )
      {
        print_table();
        exit;
      }
      else
      {
        print_table();
      }
    }
    else
    {
      if ( there_is_a_tris(511) )  # Ritorna sempre TRUE
      {
        print_table();
        exit;
      }
      else
      {
        print_table();
      }
    }
  }
}

Tanto per renderne più chiaro il funzionamento, sono stati usati dei costrutti if al posto di istruzioni concatenate da operatori booleani come && (che ottengono l'effetto equivalente, cioè vengono eseguite condizionalmente). Il trucco sta nel rappresentare le caselle come un vettore di bit, e confrontare tale vettore tutti i vettori "vincenti" per verificare se un giocatore ha vinto. Il resto è la solita solfa di AND ed OR!

La conclusione

Questi erano soltanto alcuni dei tantissimi script presenti in rete... se avete ancora appetito, vi suggerisco di dare uno sguardo al sito indicato nella introduzione, oppure visitare il sito dei Perl Monks

http://www.perlmonks.org

Cercando invece su internet a proposito di "obfuscated perl" o "perl golf", potete trovare archivi relativi a gare fra programmatori che puntano a scrivere lo script meno chiaro oppure più breve (assegnato un problema da risolvere), e che si addentrano nei meandri delle funzionalità sconosciute del linguaggio per ottenere il loro risultati.

Inoltre, c'è un altro script, tra i miei preferiti, di cui non ho parlato.
Questo perchè esiste una spiegazione scritta dallo stesso autore, M.J.Dominus.
Il tutto è reperibile presso

http://perl.plover.com/obfuscated

Buon divertimento con Perl a tutti i lettori!


Ti è piaciuto questo articolo? Iscriviti al feed!











Devo ricordare i dati personali?