This is the second in my "Perl in a..." series (which was only created because of my lack of creativity in naming these).

#!/usr/bin/perl -w
use strict;

$_="Perl in a box";for(/\S/g){@_=(@_=>lc)}
my($i,$k)=(0,'');for(@_){$_{$_}=$i++}undef
$/;$_=<DATA>;s;\s;;g;for(/../g){my@k=/./g;
@k=(pop@k,@k)if($k[1]ne lc$k[1]);for my $k
(@k){$k=$_{lc$k}}$k.=chr(30+pop(@k)+10*pop
(@k))}$_=$k;s|(.{20})|$1\n|g;eval __DATA__
aPAnLelOAeOnxREaErRxbRrReBAbBeRieBRaRrEoAx
pRBpxABpBeeBaRpBEo      AxbABerRRrEobAEoAx
AbBerRrPrPrPPrPrr        PrPrPrPrPPrPrrPPr
PrrPpBaRrRoEPrPrP        rrPrPPrPrrPPrrPPr
PrPrrPrPrPpBoEAxR        prPrPPrrPrPrPrPPr
rPPrrPrPPrrPPrPrAx      iRBpiRrPrPrPrPrPPr
PrPrrPrPPrPrPrrPPr      rPxAbAeBrRPrPrrPPr
rPrPPrPrPrrPPrrPP        rrPPrPrExRrRxOnPr
PrPrrPrPrPPrPrPrP        rPrrPPrrPPrPrRxiL
nAeLPrrPPrPrrPPr          rPrPPrrPPrrPPrrP
rPrPEbaEEaEbrPPr          PrPrPrPrPrPrrPrP
rPrPPrPrrPPrlBx            RBreOrPrPPrrPPr
rPPrrPPrrPPrPrr            PrPrPrPiOEpiLAn
rPrPrPrPrPrPrPP            rrPrPrPrPrPrPPr
rPEeXlPaAnPrrPr            PrPrPPrPrPrPrrP
rPPrPrPrPrPrLexAiBOiPrrPrPPrrPrPPrPrPrPrrP
PrrPPrPrrPEppEiBBePrrPrPPrrPrPPrrPrPrPPrPr
   PrrPrPPrpXeELrLrxEeEnXaPnAeLaBOeBnpO
      xPxPiEiLnAxRrOiOnBpOOaAlRxOnxR
        rPiXArpOxRRxlBxRBeOoAboBRx

[download]
Update: Changed as per John M. Dlugosz's comment - makes it a little more obfuscated, thanks!

His Royal Cheeziness

Replies are listed 'Best First'.
Re: Perl in a box
by bschmer (Friar) on Jul 10, 2001 at 16:25 UTC
    Here's a breakdown of the code: 
    #!/usr/bin/perl -w
use strict;

    [download]
    No explanation needed 
    $_="Perl in a box";
for(/\S/g){
@_=(@_=>lc)
}

    [download]
    Put all of the characters from $_ into @_ in order after they've been lower cased, but no spaces. 
    my($i,$k)=(0,'');

    [download]
    Variable decalaration 
    for(@_){
$_{$_}=$i++
}

    [download]
    Sets up the magic decoder ring for the first level encoding. For each character in @_, set a value in %_ for the key corresponding to the character to the offset in @_. i.e. $_{p} = 0, $_{e} = 1, etc. 
    undef $/;
$_=<DATA>;

    [download]
    Unset the input record separator and slurp in the encoded info in from DATA. 
    s;\s;;g;
for(/../g){

    [download]
    After blowing away all whitespace in the encoded data, loop over the data 2 characters at a time. 
    my@k=/./g;

    [download]
    Split the characters into @k. 
    @k=(pop@k,@k)if($k[1]ne lc$k[1]);

    [download]
    Reverse the characters in the array if the second one is not lower case. 
    for my $k (@k){
$k=$_{lc$k};
}

    [download]
    Decode the letters in @k with the magic decoder ring to get 2 numbers. 
    $k.=chr(30+pop(@k)+10*pop(@k));

    [download]
    Multiply the first number in @k by 10, add 30 and the first number in @k, turn it into a character and add it onto the string $k, which is different than the $k we used in the for loop above. 
    }

    [download]
    End the for(/../g) loop 
    $_=$k;
s|(.{20})|$1\n|g;

    [download]
    Assign $k to $_ so the substitution looks better and do the substitution to turn $_ into 20 character long lines. 
    eval

    [download]
    Eval the second obfuscated code. Wheew. Are we done yet? Nope. Here's what the second level decoder looks like: 
    $_=q[s;.*;94eae6e840
c2dcdee8d0cae440a0ca
e4                d8
40                d0
c2                c6
d6                ca
e4                14
;s                ;@
_=                /.
./                g;
fo                r(
@_                ){
$_                =c
hr                ((
he                x)
>>1)}$_=join'',@_;pr
int];s; |\n;;g;eval;

    [download]
    In a slightly more readable form: 
    $_=q[
s;.*;94eae6e840c2dcdee8d0cae440a0cae4d840d0c2c6d6cae414;s;
@_=/../g;
for(@_){
    $_=chr((hex)>>1);
}
$_=join'',@_;
print
];
s; |\n;;g;
eval;

    [download]
    This code simply sets up more code that loops through the encoded string (The 94eae6.... string that is put into $_ inside the quoted code to be evaled) 2 characters at a time, turns those characters into a real hex value, which in turn is shifted right 1 bit and turned into a character. After all of the characters have been decoded, they are crammed together and printed. A nice head-scratcher.
[reply]
[d/l]
[select]
Re: Perl in a box
by John M. Dlugosz (Monsignor) on Jul 10, 2001 at 07:04 UTC
    Change the comma on the first line to a => and you can get rid of the space at the right. Now all your lines are flush.
[reply]
Re: Perl in a box
by bschmer (Friar) on Jul 10, 2001 at 15:36 UTC
    Very nice...2 for the price of 1.
[reply]

Back to Obfuscated Code