Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Meditations

( #480=superdoc: print w/ replies, xml ) Need Help??

If you've discovered something amazing about Perl that you just need to share with everyone, this is the right place.

This section is also used for non-question discussions about Perl, and for any discussions that are not specifically programming related. For example, if you want to share or discuss opinions on hacker culture, the job market, or Perl 6 development, this is the place. (Note, however, that discussions about the PerlMonks web site belong in PerlMonks Discussion.)

Meditations is sometimes used as a sounding-board — a place to post initial drafts of perl tutorials, code modules, book reviews, articles, quizzes, etc. — so that the author can benefit from the collective insight of the monks before publishing the finished item to its proper place (be it Tutorials, Cool Uses for Perl, Reviews, or whatever). If you do this, it is generally considered appropriate to prefix your node title with "RFC:" (for "request for comments").

User Meditations
The Top Ten Perl Poems
2 direct replies — Read more / Contribute
by eyepopslikeamosquito
on Dec 26, 2014 at 02:04

    Following on from The Top Ten Perl Obfus, let's count down the top ten highest rated Perl Monks poems of all time.

    Since I cannot super-search by node reputation, please note that this list is based only on some non-exhaustive searching and my fallible memory. So it's quite likely I've overlooked a deserving poem. If so, please let us know, and I'll correct the root node. Note that, to make the top ten, a poem needs a reputation of at least 120.

    That said, please feel free to mention any poem you consider deserving of a wider audience, even if it does not meet the formal reputation criteria. For example, I'd like to recognize and congratulate liverpole for pulling off a brilliant stunt of posting a poem entitled 600000 nodes as the 600000th PerlMonks node!

    Unlike obfus, I discovered the top ten qualification criteria for poetry is not so clear-cut. For example, what many folks believe to be the finest Perl Monk node of all time, namely 1st Monasterians by Erudil, was posted not as a poem, but a meditation. Though somewhat poetic, I judged that this node did not qualify because it was not a Perl poem and was not posted in the Perl Poetry section. Curiously, a response to this node, namely Re: 1st Monasterians by japhy, did qualify because, though it too was not posted in the Poetry section, it was definitely a Perl poem. Conversely, though posted in the Perl Poetry section, I chose to disqualify Aaah, spring (A Very Special Perlmonks Contest) by boo_radley because it was a poetry competition, rather than a poem. Admittedly, these decisions were somewhat arbitrary, and someone else may have decided differently.

    Now to work.

    No 10: Stayin' Alive (with CPAN) by joecamel Feb 05 2004 rep:120+

    Well, you can tell by the way I use File::Lock
    I'm a Perl Monk: no time to talk
    Got DBI and Test::More,
    been reusin' code since version four

    You know it's all right. It's okay.
    With GD::Graph and Class::Flyweight.
    We don't have time to reinvent
    so we get it from CPAN.

    Whether you're a hacker or whether you're a slacker
    You're stayin' alive, stayin' alive.
    net communicatin' and input validatin',
    And we're stayin' alive, stayin' alive.
    Ah, ha, ha, ha, stayin' alive, stayin' alive.
    Ah, ha, ha, ha, stayin' alive.
    ...

    To the tune of Stayin' Alive by the Bee Gees.

    Though not a prolific poster, joecamel produced a number of fine poems and obfus, such as Everybody was Obfuscating and It Came From the Crypt!. A true Perl Monk artist.

    No 9.3: The Tao of Programming, Chapter 1 by Felonious Oct 08, 2002 rep:120+

    package Tao::Book::1; # The silent void $master_programmer = bless \$programmer, 'Tao'; $master_programmer->spake(qq{ When you have learned to snatch the erro +r code from the trap frame, it will be time for you to leave. }); # 1.1 () = do { open STDOUT, ">/dev/null"; 1 while $mystery; $mystery =~ /(\001|\000)+/; $_ = $mystery; *{'Tao of Programming'} = *_; if ($tao = 'great') { $^O = 'great'; } if ($^O eq 'great') { $^X = 'great'; } if ($^X eq 'great') { $0 = 'great'; } for $user (@world) { $user->{':)'}++ } (sub { $morning->{wind} = @_; return $morning })->(${'Tao of Pr +ogramming'}); }; ...

    Based on The Tao of Programming.

    No 9: The Tragedy of 9/11/2001 by jryan Sep 12 2001 rep:120+

    SHOCK: { fills (my $heart); unbelief (sinks=>'in'); END { my $sorrow; untie my $pain; } } ANGER: { fills (my $heart); curse $the{Dancers}; kill $the{Guilty}; DESTROY {$the{Mastermind}} } GRIEF: { fills (my $heart); bless $the{Dead}; thank (@{$the{Volunteers}}); BEGIN {a new()} } # structure: There are no structures; they have all collapsed. # use strict: There is no discipline; only chaos of madmen. # warnings: There is no warnings; there WERE no warnings.

    No 8: Ogden Nash, 1902-1971 by VSarkiss Aug 20 2002 rep:120+

    # The Cow # by Ogden Nash # # The cow is of the bovine ilk; # One end is moo, the other, milk. # package cow; @ISA = qw(bovine); push @cow, 'moo'; unshift @cow, 'milk';

    # Reflections on Ice-Breaking # by Ogden Nash # # Candy # Is Dandy # But liquor # Is quicker. package candy; @ISA = qw(dandy); package liquor; 1;

    Sadly, VSarkiss passed away around seven years ago. He contributed many excellent nodes during his time here, including this tribute to Ogden Nash.

    No 7.5: Use strict or unlink it by Jouke Apr 13 2004 rep:130+

    A monk who loved die more than exit
    felt blessed foreach time he could use split
    he pushed and he popped
    he chomped and he chopped
    and warned "Just use strict or unlink it!"

    A clever limerick by Jouke.

    No 7: Bohemian Rhapsody (part 1) by katgirl Jun 13 2002 rep:140+

    require(AirGuitar); if($this eq "real life" | "just fantasy"){ $caught = $in{'a-landslide'}; $no = "\from reality"; } open (YOUR, "$eyes"); $look++ => "the skies" && "c"; $money = 0; $sympathy=0; while ($i, $come, $i, $go){ $i = "easy" } $little++; $little--; if ($wind = "blows") { !$matter => me } $parent = "female"; $me = "murderer"; $gun = head{'man'}; &pull_trigger; if($gun eq "loaded"){ die('man') } tell($parent) => $life = "short"; $life = undef; $parent .- $tears; if (!$back eq this(time)){ $day .+1; } { print "Carry on"; redo; } $matter = 0; if($now eq "too late"){ my $time => "come";} my $spine = $shivers--; $body = $aching . all{'the(time)'}; tell(all) => "bye bye"; @you <= "leave"; $face =~ tr/u/th/; $parent = 000; $i != "want" => die; $i => some(time). s/never/born/ . @all;

    I absolutely love this poem! A brilliant tribute to one of the finest songs of all time, Bohemian Rhapsody.

    Sadly, katgirl has been absent for eight years now and so seems unlikely to write any more poems. Given her outstanding talent, that's a pity.

    No 6.9: Great Perl Literature by petdance Oct 03 2001 rep:140+

    scalar @monte_cristo; sub task { kill( SIGHUP, "mockingbird" ); } $_**(1/2); $_**(1/3); $_**(1/4); for ( @whom ) { toll( chr(7) ); } $nights[11]; sub king { return; } $here..$eternity undef $arms; if ( 1 ) { $postman->ring() for (1..2); } grep /Red October/, @_;

    A quiz in the form of a poem. Which book does each Perl code snippet represent?

    No 6.5: Perl Mambo by jkahn Sep 15 2002 rep:140+

    do # to the tune of 'Mambo'; #5, apologies to Lou Bega our (@syntax) = ('syncopated', 'baby'); sub refrain { my (%little_bit_of) = ('regex' =~ /(matching) (string)/); @ little_bit_of{'shell', 'calls'} = `do_that thing`; $little_bit_of{C} = sub { for(@syntax){ $little_bit_of{sed} =~ s!\\!!g; # "strip backwhacks" } }; @ { $little_bit_of{'OO'}->can('be_nice') } = @ little_bit_of{'lisp', 'lists'} = map {$_} splice(@_); @ little_bit_of{'rich', 'language'} = ('easy', 'puns'); @ { $little_bit_of{'Perl'} } = ('number' => 1); return [instrumental bridge]; }

    To the tune of Mambo No. 5 by Lou Bega.

    No 6.3: Monk Levels by MZSanford Jul 24 2001 rep:150+

    bless \@monks; $initiate = recv(MONASTERY,$enlightenment,$daily,0); $novice = seek(MONASTERY,$enlightenment,0); $acolyte = sleep && eat && study $SOPW && redo; $scribe = require disipline; $monk = print MONASTERY rand($wisdom); $friar = accept(MONASTERY,applause); $abbot = seek(MONASTERY,$enlightenment,2); $bishop = join 'E','d','i','t','o','r','s'; $pontiff = push @monks, $improve; $saint = 1;

    A poetic tribute to the PerlMonks Voting/Experience system.

    No 6.1: I Was a Saint (sung to the tune of "I Will Survive") by sauoq Nov 01 2005 rep:150+

    At first I was afraid, I was petrified
    Kept thinking I could never reach those levels up so high
    Then I spent a few minutes thinking maybe it wouldn't take so long
    And I grew strong
    And I resolved to play along

    And so I'm no longer a Saint
    I just walked in to find that where so many were they now just ain't
    I would have taken that screen shot
    Recorded it for posterity
    If I had known for just one second it'd be gone so suddenly
    ...

    To the tune of I Will Survive by Gloria Gaynor.

    Presumably this funny song was composed to get more XP quick in response to Petruchio posting A Level Playing Field the day before. See also: Levels of Monks and Translation of the Perlmonks levels ....

    No. 6: R0z3z 4r3 R3d by dws Mar 10 2001 rep:160+

    Roses are red,
    Violets are blue,
    Taint check your scripts,
    0r 1 w1ll 0wn u.

    Roses are red,
    Tulips are fine,
    Eval that param,
    And u'r b0x w1ll b3 m1n3.

    Roses are funny,
    But this code is a hoot.
    open() that $string,
    And z00n 1'l h4v3 r00t!

    Top 30 Perl Monk dws further clarified the intent of this poem:

    The "l337 sp34k" in the poem alludes to the consequences of deploying poor code, particularly CGIs that don't taint check their parameters. Read it from the point of view of a script kiddie. It's intended to grate on your ears.

    No 5.5: I just want to siiiing! by Petruchio Nov 22 2000 rep:180+

    Monks:
    He's a Perl Hack, and he's okay,
    He hacks all night and he sleeps all day!

    Petruchio:
    I write my code, I take lunch breaks,
    I go to the Monastery!
    Sometimes I post my homework,
    And merlyn yells at me!

    Monks:
    He writes his code, he takes lunch breaks,
    He goes to the Monastery!
    Sometimes he posts his homework,
    And merlyn yells at... him.

    All:
    He's a Perl Hack, and he's okay,
    He hacks all night and he sleeps all day!

    Petruchio:
    I debug code, I call in sick,
    I stay home and play Doom!
    I write annoying letters
    About MonkMail to vroom!
    ...

    To the tune of The Lumberjack Song by Monty Python.

    Quite a bit of interesting PerlMonks history in this ditty ... old homework posts, merlyn, vroom, AgentM and the protracted MonkMail! campaign.

    No 5: The strictures, according to Seuss by toolic May 14 2008 rep:180+

    Do you like use warnings and strict?
    I do not like use warnings and strict.
    Do you like them here or there?
    I do not like them here or there?
    I do not like them anywhere.
    ...

    toolic composed this clever Perl tribute to Dr Suess and Green Eggs and Ham.

    No 4: my @chickens by pjf Oct 04 2001 rep:180+

    use Carp qw/cluck/; my @chickens; sleep until $dawn; cluck $loudly until open $coop; exit $coop; chomp $food and accept($scraps,$seed); shift @straw, pop @eggs and cluck $more; until ($dusk) { seek($many,$worms,$bugs); join flock($other,@chickens) if split /from others/; tell WORLD,"sky is falling" if $airplane; } return 2,$coop and sleep until $dawn;

    After quietly contemplating the chickens in his backyard, subsistence farmer and Perl expert pjf wittily summarizes their behavior in just half a page of Perl.

    By the way, pjf is one of the few monks I've met in real life. In addition to running chickens, he has a keen interest in picking and eating wild plants that you won't find in any supermarket.

    No 3: The Doom of the Noldor by Erudil Jun 13 2000 rep:200+

    # The Doom of the Noldor / The Prophecy of the North # J. R. R. Tolkien - Quenta Silmarillion # # Tears unnumbered ye shall shed; # and the Valar will fence Valinor against you, # and shut you out, # so that not even the echo of your lamentation # shall pass over the mountains. # # On the House of Feanor the wrath of the Valar lieth # from the West unto the uttermost East, # and upon all that will follow them # it shall be laid also. # $_= 'The Doom of the Noldor' or 'The Prophecy of the North'; while( /Doom/ ) { shed("tears "); do { $Valar{'fence_of_Valinor'}++ and $shut_out; } until not( $echo_of_lamentation > $mountains ); for( $West..$uttermost_East ) { map{$_ = $Valar{'wrath'}} (@House_of_Feanor, @followers); } } sub shed{print shift}

    Yet another Erudil classic, this time a Perl poem based on the works of J.R.R.Tolkien.

    No 2: Re: 1st Monasterians by japhy Mar 06 2002 rep:240+

    substr("Erudil to the Monasterians", 0, 1); 1 . Erudil->isa(PerlHacker) .. [ "vroom", @saints, @monastery ]; 2 . undef $^W, close(STDERR) and !$! for 1..100; 3 . -M Erudil > 2*365 and $appreciation{$_}++ for qw( place custodians members ); 4 . do { for (@brothers, @sisters) { listen up, hearken } continue { to: wait() and study() for grep !clue($_) && ignorant($_), Visitors- To-Our-Blessed-Monastery } }; 5 . do { not rebuke($words{harsh} =~ /RTFM/), but }, lead-with-URLs if wisdom->isa( goal-of-theirs); 6 . allow for newbies and instruct(grep $_, @contents); 7. for 0 < grep errant || ignorant, @us; 8 . consider; these: 9 . ($^H & 0x602) and bless($they), for typos < troubles; 10 . $^W and bless($they), for $errors -> (0); 11 . %CGI:: and bless($they), for eval { pass-parameters } and not $@; 12 . eval "use CPAN; 1" and bless($they), for $wheels_not_reinvented > 1e9; 13 . qr// and bless($they), for HTML-time == 0; 14 . insults? ridicule? blessed: are: you, for time and effort < theirs; 15 . grep refuser($_), @those ? (do { not allow flame wars } or disrepute): yourselves or Monastery; 16 . study well::, $$ = 0 for grep cool lost, grep flamewar winner, @men; time < age-of-reason and 17 . those who suffer thus, do { consider: like me, close mouth, select words, carefully, to edify, to inform }; 18 . $_++ for @brothers, @sisters, restorers-of-faith and $^T = time, 19 . good-syntax and efficient- algorithms; 20 . eval { $$ref; 1 } and study, study Perl, study bless$ed, Perl; 21 . Amen and amen;

    japhy converts Erudil's 1st Monasterians masterpiece into a Perl poem.

    No 1: Fish dinner by suaveant Jun 04 2001 rep:320+

    use Carp; unpack fish, spices; croak fish if $alive; study recipe, pop in, time; BEGIN {meal}; tied %bib; scalar fish; fork, split; sqrt lemon; glob tartarsauce; chop, open(MOUTH), chomp; unlink flesh; truncate bone, chomp; untie %bib; push plate; END {meal}; sleep now;

    I found this really funny and upvoted it without hesitation when I first set eyes on it years ago. Admittedly, suaveant marketed this node relentlessly by making it part of his sig. I still feel this is a very worthy number one, a fantastic poem.

    Since reading this poem, I always pronounce the sqrt function as "squirt". :)

    References

    Updated Dec 27 2014: Added poem 5.5, poem 6.1, poem 6.3, poem 6.5 poem 6.9, poem 7.5, poem 9.3 which I had missed in my original post (thanks tye). Omitted 6.7 as it is a poetry competition, not a poem.

Authentication with U2F Two-factor keys
No replies — Read more | Post response
by cavac
on Dec 19, 2014 at 07:43

    I just uploaded the first Alpha version of Crypt::U2F, which allows you to handle the server side cryptography of the FIDO alliance's Universal 2nd factor authentication method. See also here.

    This is the same one used by Google services and fully supported in Google Chrome.

    Internally, Crypt::U2F requires Yubico's libu2f-server library installed on your system. I implemented this in two Perl modules: Crypt::U2F is the low level module (sand subject to change), that let's you play around with the underlying library. Crypt::U2F::Simple is the one you should use in most cases.

    Let's have a look into the two examples provided with the tarball. For this to work, you need to install libu2f-server and also install libu2f-host, because we need the u2f-host binary to talk to the actual USB dongle. (I'm currently in the process of making a Perl module for libu2f-host as well, but this will only finish after the hollidays.)

    The whole thing is a two part process: First you have register a new key once, then you can authenticate as often as you like. Each part (registering, authentication) itself is a two-part process as well, first you generate a challenge and send it to the client, then you have to validate the response.

    Ok, let's start with registering a key. For this example, we pass around files to and from u2f-host and also save the registered keyHandle and public key into files as well. In a real world scenario, you will probably use HTTP and Javascript to communicate with the key and save keyHandle and the public key into a database. Here's the code:

    The reason we use Base64 is simple, yet annoying: Everything except the public key is either some sort of text or even ASCII JSON. The public key on the other hand is a binary blob. It's just a matter of convenience to turn it into Base64, because that we it works in textfiles and text columns in databases as well. It don't convert directly in the library, because that might make it problematic to cooperate with other implementations of U2F authentications that also use the original C library (which delivers a binary blob), including the u2f-server example binary that comes with it.

    All of the calls to Crypt::U2F::Simple may fail for one reason or another (including new() and DESTROY()), so make sure you check all the return values!

    Let's tackle the authentication part. We'll use the keyHandle.dat and publicKey.dat generated in the previous step:

    As you can see, the process is quite similar: We load the keyHandle.dat and publicKey.dat (the second one we decode_base64()) and initialize Crypt::U2F::Simple with it. Then we generate a challenge and verify it.

    If you want to make sure the verification step actually works, you can comment out the call can try to fuss the result of u2fhost in authReply.dat. Or just comment out the call to u2fhost after you you did one successfull authentication, this one should give you a u2fs_authentication_verify (-6): Challenge error.

    Limitations and Bugs: Currently (Version 0.10), each Challenge/Verify combo has to run in the same instance of the module. I'm still working on finding out how to fix that. Also, sometimes the USB keyfob seems to be in a strange state after plugging in, returning wrongly calculated authentication replies (at least mine does). Unplugging and replugging solves that problem.

    "For me, programming in Perl is like my cooking. The result may not always taste nice, but it's quick, painless and it get's food on the table."
The Top Ten Perl Obfus
3 direct replies — Read more / Contribute
by eyepopslikeamosquito
on Dec 14, 2014 at 03:24

    Following on from The First Ten Perl Obfus, I thought it would be fun to count down the top ten highest rated Perl Monks obfus of all time.

    Since I cannot super-search by node reputation, please note that this list is based solely on my memory of spectacular obfus I've seen over the years. So, if I have overlooked an obfu gem, please let us know, and I will correct the root node. Note that, to make the top ten, a node needs a reputation of at least 240.

    No 10: Fun With Reserved Keywords by blokhead Sep 11 2003 rep:200+

    #!/usr/bin/perl not exp log srand xor s qq qx xor s x x length uc ord and print chr ord for qw q join use sub tied qx xor eval xor print qq q q xor int eval lc q m cos and print chr ord for qw y abs ne open tied hex exp ref y m xor scalar srand print qq q q xor int eval lc qq y sqrt cos and print chr ord for qw x printf each return local x y or print qq s s and eval q s undef or oct xor time xor ref print chr int ord lc foreach qw y hex alarm chdir kill exec return y s gt sin sort split

    Constraints are the heart of obfu.

    Here blokhead constrains himself to using lowercase alphabetic characters only, no punctuation at all. Combining with an exact right hand margin produces a visually stunning and surprising block-shaped obfu.

    See also:

    No 9: Mandelbrot flythrough by blokhead Feb 17 2004 rep:200+

    Note that this obfu is formatted with pre tags so that the PerlMonks default line-breaking of code at 70 characters does not spoil the visual presentation.

    #!/usr/bin/perl
     $r=25; $c=80;
                                                  $xr=6;$yr=3;$xc=-0.5;$dw=$z=-4/
                                                  100;local$";while($q=$dr=rand()
                                                 /7){$w+=$dw;$_=join$/,map{$Y=$_*
                                                 $yr/$r;
      join""                                    ,map{$                  x=$_*$
     xr/$c;($                                   x,$y)=                 ($xc+$x
      *cos($                                   w)-$Y*               sin$w,$yc+
                                               $x*sin              ($w)+$Y*cos
      $w);$                                   e=-1;$                    a=$b=0
    ;($a,$b)   =($u-$v+$x,2*$a*               $b+$y)                    while(
    $ u=$a*$   a)+($v=$b*$b)<4.5  &&++$e     <15;if                     (($e>$
      q&&$e<   15)||($e==$q and   rand()     <$dr))  {$q=$e;($d0,$d1)   =($x,$
      y); }                        chr(+(   32,96,+  46,45,43,58,73,37  ,36,64
     ,32)[$                        e/1.5]   );}(-$   c/2)..($c/2)-1;}   (-$r/2
     )..($     r/2)-1;select$",     $",$", 0.015;                       system
    $^O=~m     ~[wW]in~x?"cls":     "clear";print                       ;$xc=(
    $d0+15     *$xc)/16;$yc=($       d1+15*$yc)/                        16;$_*=
    1+$z for                         $xr,$yr;$dw                     *=-1 if rand
    ()<0.02;                          (++$i%110                      )||($z*=-1)}
    

    This beautifully formatted obfu produces a mind-boggling visual effect when run; you truly feel like you are flying through a mandelbrot! Just works out of the box on both Unix and Windows. Brilliant work. Two in a row from blokhead!

    No 8.5: Propose. by Falkkin Aug 18 2004 rep:200+

    #!/usr/bin/perl -w use strict; my$f= $[;my $ch=0;sub l{length} sub r{join"", reverse split ("",$_[$[])}sub ss{substr($_[0] ,$_[1],$_[2])}sub be{$_=$_[0];p (ss($_,$f,1));$f+=l()/2;$f%=l ();$f++if$ch%2;$ch++}my$q=r ("\ntfgpfdfal,thg?bngbj". "naxfcixz");$_=$q; $q=~ tr/f[a-z]/ [l-za-k] /;my@ever=1..&l ;my$mine=$q ;sub p{ print @_; } be $mine for @ever

    Update: this one was added later after tye kindly pointed out that I had missed this heart-warming obfu.

    When run, the above obfu asks: kristen, will you marry me?

    Beautiful.

    Believe it or not, this was a real marriage proposal, in the form of a Perl obfu, posted by Pennsylvanian CMU PhD student Falkkin to fellow Perl Monk Vortacist, aka Kristen. To applause and congratulations all round, Falkkin's innovative marriage proposal was publicly accepted by Vortacist just thirteen minutes later.

    As pointed out by the eagle-eyed ambrus, this touching marriage proposal has since been immortalized in a phd comic strip.

    No 8: There can be only one! by Erudil May 15 2000 rep:300+

    #!/usr/bin/perl -w # there can be only one use strict; $_='$_={one(( one($")<<1)^one( $/))}{{one((one($;) <<($^=(one($/)>>1)>>1) +1)+one($/)>>1)}{{{one((( one($;)<<$^+1)+one($/)>>1)-$ ^)}{{{one(((one($;)<<$^+1)+one( $/)>>1)-1)}{one (one($"))}{{one ((one($;)<<$^)^ (one($")>>1)+1) }{one((one($;)< <$^)-$^)}{{one( ((one($;)<<$^)- $^)+1)}}{one((( one($;)<<$^+1)+ one($/)>>1)-1)} {one(($~=$=)<<1 ^one($")>>1)}{{ {one((one($;)<< $^)-one($/)-1)} {one(((one($;)< <$^+1)+one($/)> >1)-$^-1)}{one( one($"))}}{one( one($/)<<$^+1)} {one((one($;)<< $^)-one($/)-1)} {one(((one($;)< <$^+1)+one($/)> >1)-$^-1)}}}{{{one(((one($;)<<$^)-$^)-$^)}}}{one( one($"))}}{one(($~=$=)<<1^one($")>>1)}}{{one((one ($;)<<$^)-(one($")>>1)+1)}{one((one($;)<<$^)-(one ($")>>1)+$^+1)}}{{one(($~=$=)<<1^(one($")>>1)+$^+ 1)}{one((one($;)<<$^)-one($/)-1)}{one(((one($;)<< $^+1)+one($/)>>1)-$^-1)}}{one($=^(one($")>>1))';s ;{one;chr;g;y;{ne}}\012\040;.rd.;sd;eval;print;#1

    Following on from perhaps the best first post ever made, namely My 2 cents worth, the master strikes again! This one (pun intended) must surely rate as the best ever second post.

    No 7: 3-D Stereogram, Self replicating source. by Toodles Oct 15 2001 rep:300+

    #!/usr/bin/perl # Copyright (c) Marcus Post, <marcus@marcuspost.com> # # # # $_=q,my(@f|@c|x$_=q.my(@f|@c|x$_=q.my(@f|@c|x$_=q.m(@f||@c|x$_=q.m(@f| +|@c|xx @w);@a=@f=<DAT%@w);@a=@f=<DAT%@w);@a=@f=<DAT%@w;@a=@f=<DAAT%@w;@a=@f=< +DAAT%% A>;seek(DATA|0!A>;seek(DAA|0!!A>;seek(DAA|0!A>;seek(DAA|0!!A>;seek(DAA +|0!!AA |0);@c=<DATA>;Y|0);@c<DATA>;Y||0);@c<DATA>Y||0);@c<DATA>Y|||0);@c<DATA +>Y|||| until(($_=pop(zutil(($_==pp(zuttil(($_==p(zuttil(($_==p(zutttil(($_==p +(zuttt @c))=~/^_/){};Qc))=~/^_/){};Qc)))=~/^_/{};Qc)))=~/^_/{};Qc))))=~/^_/{} +;Qc))) unshift(@a|$_)xnshift(@a|$_)xnshhift(a|$_)xnshhift(a|$_)xnshhiift(a|$_ +)xnshh ;for(1..3){pri%;for(1.3){pri%;ffor1.3){pri%;ffor1.3){pri%;ffor11.3){pr +i%;fff nt(shift(@c));!nt(shft(@c));!ntt(hft(@c));!ntt(hft(@c));!ntt(hftt(@c)) +;!nttt }for(@f){my($sY}for@f){my($sY}for@f){my($sY}for@f){my($sY}for@f){mmy($ +sY}foo );split//;$_=sz);splt//;$_=sz);splt//;$_=sz);splt//;$_=sz);splt//;$_== +sz);ss hift(@c);$_=~sQhift(c);$_=~sQhift(c);$_=~sQhift(c);$_=~sQhift(c);$_=~s +QQhiff /(.{15}).*/\1/x/(.{15})*/\1/x/(.{15})*/\1/x/(.{15})*/\1/x/(.{15}})*\1/ +xx/(.. ;@w=split//;fo%;@w=split/;fo%;@w=split/;fo%;@w=split/;fo%;@w=spllit;fo +%%;@ww r(@_){$w[$s+15!r(@_){$w[$s15!r(@_){$w[$s15!r(@_){$w[$s15!!(@_){$$w[s15 +!!!(@@ -$_]=(($w[$s]eY-$_]=(($w[$s]YY-_]=(($w[$s]YY-_]=(($w[$s]YY-_]=((($[$s] +]YY-__ q"|")?".":$w[$zq"|")?".":$w[$zq|")?"."::$[$zq|")??."::$[[$z|")???.::$$ +[[$z|| s]);$s++;}for(Qs]);$s++;}for(Qs];$s++;}}or(Qs];$$s+;}}orr(Qs]$$s++;}}o +rr(Qss 1..75){unless(x1..75){unless(x1.75){unnlss(x1.775){uulsss(x1.75){uuuls +ss(x11 $w[$_]ne''){$w%$w[$_]ne''){$w%$w$_]nee''{$w%$$w$_]nn''{{$w%$$w_]nnn''{ +{$w%$$ [$_]=$w[($_-1)![$_]=$w[($_-1)![$_=$w[[($_-)![$_==w[[($$_-)![$__w[[[($$ +_-)![[ ];}}print(joinY];}}print(joinY];}prinnt(joinY;}prinntt(joinY;}pinnntt( +joinYY ""|@w);print"\z""|@w);print"\z""|w);;print"\z"|w);;pprint"\z"|w;;pppri +nt"\zz n";}print@a;,;#n";}print@a;.;#n";priint@a;.;#n;priintt@a;.;#n;piinntt@ +a;.;## y!|zY\!%x!,Q!;#y!|zY\!%x!.Q!;#y!zY\!!%x!.Q!;#!zY\!!%x!!.Q!;#!z\!!!%x!! +.Q!;## s{Q.*\n}[]g;#<>s{Q.*\n}[]g;#<>sQ.*\nn}[]g;#>sQ.*\nn}[]]g;#>sQ.\nnn}[]] +g;#>ss eval;#EndFini!$eval;#EndFini!$eal;#EEndFin!$eal;;##nddFin!$ea;;###nddF +in!$ee __DATA__ 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000110000000110000000000000000011100000000000000000 000000000001110000001110000000000000000111110000000000000000 000000000011110000011110000000000000001111111000000000000000 000000000011110000011110000000000000001111110000000000000000 000000000011110000011110000000000000001111100000000000000000 000001111111111111111111111110000000001111100000000000000000 000011111111111111111111111100000000000111100000000000000000 000111111111111111111111111000000000000111100000000000000000 000000000011110000011110000000000000000111100000000000000000 000000000011110000011110000000000000000111100000000000000000 000000000011110000011110000000000000000111100000000000000000 000000000011110000011110000000000000000011100000000000000000 000001111111111111111111111110000000000011100000000000000000 000011111111111111111111111100000000000011100000000000000000 000111111111111111111111111000000000000001100000000000000000 000000000011110000011110000000000000000001100000000000000000 000000000011110000011110000000000000000001100000000000000000 000000000011110000011110000000000000000000000000000000000000 000000000011100000011100000000000000000000000000000000000000 000000000011000000011000000000000000000011110000000000000000 000000000000000000000000000000000000000111111000000000000000 000000000000000000000000000000000000000111110000000000000000 000000000000000000000000000000000000000011110000000000000000 000000000000000000000000000000000000000000000000000000000000 000000000000000000000000000000000000000000000000000000000000

    This original idea of creating a Perl obfu stereogram produced rave reviews when posted.

    The code is certainly mind-bogglingly clever and elaborate. Unfortunately, I've never been able to relax my eyes enough to see these stereogram thingos, so the (stunning if you can see it) visual effect of this obfu was lost on me.

    Though obviously a brilliant coder, Toodles only posted four times and disappeared from PM shortly after stunning us with his original obfu.

    No 6: Saturn by eyepopslikeamosquito Oct 10 2004 rep:300+

    Note that this obfu is formatted with pre tags so that the PerlMonks default line-breaking of code at 70 characters does not spoil the visual presentation.

    #!/usr/bin/perl
                                                                               ;;;;;;
                                                                           ;;;;;;;;;;;
                                                                       ;;;;;;;;;;;;;;;
                                                                    ;;;;;;;;;;;;;;;;;
                                                                 ;;;;;;;;;;;;;;;;;;;
                                                               ;;;;;;;;;;;;;;;;;;;;
                                                             ;;;;;;;;;;;;;;;;;;;;;
                                         +$I=sub{+s+^+     ;;;;;;;      ;;;;;;;;;
                                      $"x$_[1]+gem;$/x$_#   ;;;;        ;;;;;;;;
                                   [0].$_.$/};$W=sub{$~=!q~            ;;;;;;;
                                ~.pop();system($^O=~Win?ClS:#         ;;;;;;;
                              'clear'),print,select$Z,$Z,$Z,!"       ;;;;;;
                             "||$~for@_};$H=sub{+join$/,map($_#     ;;;;;;
                            x$_[0],pop=~m-.+-g),!_};$_=!Mima,s--   ;;;;;
                           "@{['=9+)w'^RINGS]}\%;local@{[Saturn^# ;;;;;
                          wNXIBP]}"-see;s-^#!..+?$/(?=$"+;)--is  ;;;;
                         y-;-'-;s-\w-~-gi;$S=$_;#--Beautiful]  ;;;;
                         @S=m-.+-g;$N=1+.6-!th_,$--=-82-$---  ;;;
                        $_.=$"x-(y---c-$-)for@S;$R=sub{$i#  ;;;  -d
                        =0;join$/,map{$j=$%;join!_,grep#  ;;;  Rhea
                        !($j++%$_[$%]),m-.-g}grep!($i#  ;;;  -Titan
                        ++%$_[0]),@S};$L=join!_,map#  ;;;  -Huygens
                        ~~reverse.$/,@S;@R=(&$I(q-  ;;;  -&&20,051,
                        $_=_^q-q-),&$I(20,41-!q-  ;;;  -,$_=F|K),$
                        I->(15,31,$_=&$R(4-!q-  ;;;  -)),&$I(13-!"
                      ;;",28,$_=&$R(3)),&${  ;;;  _^_^I}(10,20-!"
                    ;;;;;",$_=$R->(2)),q-  ;;;  -&&$S);@O=map&{"
                  ;;;;;;  "&&$H}($_,&${  ;;;  R.!-_}($_))x$_,!"
                 ;;;;;     "+2..2*~~2  ;;;  @Y=reverse@R#Dione
               ;;;;;;       &${m--  ;;;  S|A|T|U}(@R,$N)||!q-
             ;;;;;;;          b-  ;;;  &$W(@O[0,1,2,1,0!=!q-
            ;;;;;;;            ;;;;  -],!1!~~1);&$W($S.!q-
          ;;;;;;;;;        ;;;;;  -,$L,0.16)for$%..5+!q-
         ;;;;;;;;;;    ;;;;;;;;;    Cassini-;&{$W||q-
        ;;;;;;;;;;;;;;;;;;;;;;         -}(@Y,1.6)
       ;;;;;;;;;;;;;;;;;;;;
      ;;;;;;;;;;;;;;;;;;
     ;;;;;;;;;;;;;;;;
    ;;;;;;;;;;;;;;
    ;;;;;;;;;;;
      ;;;;;;
    

    Ahem. This is mine. I am a space nut and had just finished watching Contact. I was deeply moved by the opening sequence of that movie, starting from the Earth, moving past Mars, Jupiter, Saturn, ..., the Milky Way, the Local Group, until the vast scale of the Universe and its billions of galaxies is slowly revealed.

    The other primary influence was Erudil's famous camel code, which splits a camel into four camels. I naturally tried to top that, splitting Saturn into four, then nine, then sixteen Saturns, adding a back and forth tilting effect for good measure.

    Luckily, I was also playing a lot of golf at the time, which was needed to compress the desired code into the Saturn shape. Once I had done that, I set about tweaking the code to match the Saturnian theme. For example:

    $_=!Mima,s-- '=9+)w'^RINGS Saturn^wNXIBP S|A|T|U}(@R,$N)

    I derived the Saturn shape from this beautiful Voyager space probe photograph.

    No 5: spiraling quine by Len Jun 20 2002 rep:300+

    Unix version:

    #!/usr/bin/perl $_=' $q ="\ 47"; wh ile ($ ;= $z += .5 ){ %c= $r=0;$/ ="";whi le(2 0+ $z>($;+=.05)){$c{int$ _+ 2 6+ 2*($ r+= .0 2) * s in$ ;}{1 -$_ +1 0+ int $r*c o s $ ;} =1for(0. .1) }$ t =r ever se;$ /. =` c le ar `. " #! / usr /bi n/ pe rl \n\ $_ =$q \n" ; fo r$y (1..20){$c{$_} { $ y }? $ /.=chop$t : ($/ . =" \4 0") for(0. .53) ; $/. ="\n"}pri nt"$/$ q; s; ". chr(9 2)."s;;g;eval\n "} ';s;\s;;g;eval

    Windows version:

    #!/usr/bin/perl $_=' $q= "\4 7" ;wh ile($;=$z+=.5 ){ %c =$r =0;$/="";while( 21+$ z> ( $; +=.05)) {$c{i nt $ _+ 26 +2*( $r+=. 0 1 9 )*s in $; }{1 - $_ +10+int$r*c os$; }=1 f or(0..1)}$t=re v e r s e; $/. =`cl s` ." #! /u sr /bi n/ pe rl \n\ $_=$q\n" ;f or $y (1. .20){ $c {$ _ } { $y }? $ /.= chop$ t:( $/ . ="\4 0")for( 0..53 ); $ /.=" \n"}system("cls ") ;p ri nt "$/$q;s ;". c h r(92) ."s; ; g; eva l\n" } ';s;\s;;g;eval

    A beautifully formatted obfu producing a dazzling visual effect when run. Well done Len.

    No 4: find-a-func by Erudil Aug 29 2001 rep:300+

    #!/usr/bin/perl -w # find-a-func use strict; $_='$;="per l";map{map {s}^\s+}} ;$_{$_}++unless(/[^a- z]/)}split(/ [\s,]+/)i f(/alpha. *$;/i../w ait/)}`$; doc\040$; toc`;;;@[=k eys%_;$; =20;$:=15;;for(0..($;*$:-1 )){$;[$_]="_" ;}until($%++>3*$;||@]>2*$:-3){@_=split(//,splice(@[,rand( @[),1));if(3>@_){next;}$~=int(rand($;));$^=int(rand($:)); $-=$~+$^*$;;my$Erudil=0;{if($Erudil++>2*$:){next;}$a=(-1, 0,1)[rand(3)];$b=(-1,0,1)[rand(3)];unless(($a||$b)&&$~ +$a*@_<=$;&&$~+$a*@_>=0&&$^+$b*@_<=$:&&$^+$b*@_>=0){re do;;}my$llama=0;;for(0..$#_){unless($;[$-+$a*$_+$b* $;*$_]eq$_[$_]||$;[$-+$a*$_+$b*$;*$_]eq"_"){$llam a++;last;}}if($llama){redo;}push@],join("",@_);f or(0..$#_){$;[$-+$a*$_+$b*$;*$_]=$_[$_];}}}@_ =sort@];unshift@_ ,"Find:","-"x5;for$a(0. .$:-1){for$b(0. .$;-1){$~=("a".."z") [rand(26)];$_ ="$;[$a*$;+$b]". $";s;_;$~; ;print;}$_=s hift@_|| $";;print$ ",$", $_,$ /;$_ =shi ft@_ ||$ ";pr int $"x $;, $"x $;, $", $", $_ ,$/;; ;}' ;;; s[\s+] $$g; eval; __DATA__ The use of the llama image in association with Perl is a trademark of O'Reilly & Associates, Inc. Used with permission.

    Needs "perldoc" on the path. Can be quite slow to run as it mangles the output of "perldoc perltoc", but well worth the wait. Full deconstruction provided by grinder.

    Another Erudil classic.

    No 3: How to (ab)use substr by Erudil May 03 2001 rep: 400+

    #!/usr/bin/perl -w # how to (ab)use substr use strict; my $pi='3.14159210535152623346475240375062163750446240333543375062'; substr ($^X,0)= substr ($pi,-6);map{ substr ($^X,$.++,1)=chr( substr($pi,21,2)+ substr($pi,$_,2))}(12,28,-18,-6,-10,14);map{$^O=$"x( substr ($pi,-5,2)); substr ($^O,sin(++$a/8)*32+ substr ($pi,-2)/2+1,1)=$_; substr ($^O,sin($a/4)*( substr ($pi,2,2))+ substr ($pi,-7,-5)-1,1)=$_;print"$^O$/";eval($^X.('$b,'x3). substr ($pi,-3,1).'.'. substr ($pi,9,2));}(map{chr($_+ substr ($pi,21,2))}( substr ($pi,8)x3)=~/../g);

    Yet another Erudil classic. A work of art.

    No 2: Things are not what they seem like. by Abigail Jul 13 2000 rep:400+

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

    Short. Elegant. Witty. A masterpiece from the inimitable Abigail.

    Deconstruction provided by btrott.

    No 1: camel code by Erudil Dec 06 2000 rep:700+

    #!/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

    The highest rated PM node of all time. For a long time, you could buy thinkgeek T-shirts with this obfu printed on it! They seem to be out of print now though, at least the thinkgeek link is broken. I loved Erudil's response to all the attention:

    <Elvis> Thankyew ... Thankyew verra much! </Elvis>

    References

    Updated Dec 18 2014: Added obfu 8.5 which I had missed in my original post (thanks tye).

The First Ten Perl Obfus
No replies — Read more | Post response
by eyepopslikeamosquito
on Dec 14, 2014 at 03:14

    Following on from The First Ten Perl Monks, I thought it would be fun to explore the origins of PerlMonks Obfuscated code.

    What was the first PerlMonks Obfuscated code?

    As far as I can tell, it was written on Oct 13 1999 by the early PM developers at the very end of this ancient command line examples faq. Of course, this was well before the PerlMonks official opening on 23 Dec 1999. So, if we disqualify this pre-historic (accidental) obfuscation, the first deliberately obfuscated PerlMonks node was probably OBFUSCATE!!! by the thirteenth Perl Monk jdube on Dec 30 1999 at 04:51.

    PerlMonks Obfuscation Founding Father: jdube

    As was typical of early Perl Monks, jdube also had an everything2 account. Curiously, jdube further authored a companion POETRY!!! node, presumably a crude attempt to pressure vroom into creating PerlMonks Obfuscated code and Perl Poetry sections. Well, by using all caps and three exclamation marks in the node titles he was certainly shouting at vroom.

    Anyway, it seems jdube's clever ploy worked because vroom did indeed create our much loved Obfuscated code and Perl Poetry sections later that same fateful day, Dec 30 1999. By the way, I was shocked to see that the historic Poetry and Obfuscated Sections by vroom has received just one up-vote (mine). If you feel this historic node is worth more than that, you know what you need to do.

    An interesting piece of trivia is that jdube's medieval OBFUSCATE!!!/POETRY!!! barrage took place in the (now obsolete) perlcraft arena. It seems this ancient "perlcraft" section has since been re-branded as Cool Uses For Perl.

    Tragically, our PerlMonks poetry and obfu founding father jdube does not appear in the first ten official Obfuscated nodes, listed below. Sadly, he never did write an official PerlMonks obfuscated node. Sadder still, Perl Monk number 13 jdube was last seen wandering around the monastery in May 2000, and his account now sits abandoned and disabled. Perhaps being the thirteenth user proved unlucky. I wonder what jdube is doing nowadays. Will he return one day to write us another obfu or poem?

    Obu No 1: #!/usr/bin/perl by BBQ (last here Apr 07 2009)

    Created: Dec 30 1999, Rep: 14, 3 replies.

    %A=('r'=>"\n","\t"=>'#','/'=> 's','f'=>'p',"b"=>'n');@C=qw (e ! r/ / e );foreach $k (sort keys %A){ @B=(" ",'u','i',"\b",'l');$s .=qq{$k$B[$x++]$A{$k}$C[$x] \b};if ($x==1){$t=$k.$B[$x-1].$A{$k};}#ops } print$A{r}.$s;#i h8 left over \s's

    The first official PerlMonks obfu was concocted in Brazil by Perl Monk number eleven BBQ, who has the further distinction of being the first foreign Perl Monk. In addition to being the first foreign monk, BBQ is the first non-insider Perl Monk without a companion everything2 account.

    This historic obfu, which still works with modern perls, displays its node title #!/usr/bin/perl on the screen when run. It is a bit trickier than that though, in fact it writes the following 33 characters to stdout:

    CR LF TAB SPACE #! SPACE BACKSPACE /usr/ SPACE BACKSPACE bin/ SPACE BA +CKSPACE f BACKSPACE pe SPACE BACKSPACE rl CR LF SPACE BACKSPACE

    Though not in Erudil's class, that was a decent first attempt from BBQ. And he was well aware of its historical significance commenting:

    I'm actually kinda proud I made it 1st into the obfuscated code bin. :o)
    after vroom manually adjusted the node ownership to its rightful owner.

    Obu No 2: WWWWolf's .signature by WWWWolf (last here Apr 11 2002)

    Created: Jan 06 2000, Rep: 6, 0 replies.

    $_='%?&%[=&+=?%=[%&+&%[*?]&=&~[;&+&{=?[?&%&[&{[%&^=?=[&%&]=?%~&~[?&+&~ +YiFF! =[=~| Weyfour WWWWolf (aka. Urpo Lankinen), a lupine technomancer |=?* +_=}?] %}&};| ICQ:4291042 | wwwwolf@iki.fi | http://www.iki.fi/wwwwolf/ |&;&= +~?]'; tr/?~=*;%&[{}]+_^ (),.:@\/\n0-9!|a-zA-Z/0-9acde/d; $_=pack("H*",$_); p +rint;

    The second PM obfu is also from outside the USA, this time from Oulu, Finland. This one is not especially obfuscated, just the .signature file of WWWWolf (Weyfour WWWWolf's Web of Weird Things).

    Yet again, we see a companion WWWWolf everything2 account. Though he hasn't visited PM since 2002, the artistic WWWWolf appears to be still active, focusing on Drupal, writing, and photography nowadays. So we may yet see a surprise return visit.

    Obu No 3: ArrayHashMonster.pm by Anonymous Monk

    Created: Feb 03 2000, Rep: 2, 0 replies.

    $monster = new ArrayHashMonster ... ; print $monster->[1]; # This might print `Janvier' print $monster->{Jan}; # This can *also* print `Janvier'

    This seems to be just an advertisement for Dominus's ArrayHashMonster CPAN module.

    Obu No 4: Yearbook fun by Xavier (last here Jun 30 2000)

    Created: Feb 04 2000, Rep: 9, 6 replies.

    $a="User-Agent:PlMk";$u=" xavier.penguinpowered.com ";$h="GET / HTTP/1.\n";$u =~s/\n//gs;$d=`echo "$h$a "|nc $u 80`;$d=~s/.+?ml\r (.+)/$1/s;$d=~s/\n+|\s+ \ / /gsx;$d=~s/<a.+?f="(.*? )">(.+?)<\/a>/$2($1)/sgx; $d=~s/<(br|p|li)>/\n/g;$d =~s/<.+?>//gsx;print"$d";

    Not especially obfuscated, just something to put in his high school yearbook, with limited space available. Yet again, we see a companion everything2 account.

    Obu No 5: Tricks with tr/// by japhy (last here Oct 08 2014)

    Created: Feb 09 2000, Rep: 18, 6 replies.

    # to squish a string y sssscccc; y cccscsss; y yyysc; # to get the string length y yyyc; # to clear a string y ccccdddd; y dddcdccc; y yyycd;

    Jeff "japhy" Pinyan is by far the highest rated Perl Monk among the first ten pioneer obfuscators. He was also a Perl Mongers pioneer, joining the first Perl Mongers user group, in New York City in the late 1990s.

    His first (whimsical) obfu above plays around with Perl's tr (aka y) modifiers. These modifiers, and their companion m// and s// modifiers, are a lot of fun and very popular with obfuscators. For example, I remember a playful merlyn japh:

    $Old_MacDonald = q#print #; $had_a_farm = (q-q:Just another Perl hacke +r,:-); s/^/q[Sing it, boys and girls...],$Old_MacDonald.$had_a_farm/eieio;

    and a $A++ obfu from mtve:

    y ccccd x s vvchr oct oct ord uc ave x s vvucve le s vvuc ave x s vvchr oct oct oct ord uc bve x eval

    This sort of syntactic flexibility is why Perl is, and seems likely to remain for the foreseeable future, the premier language for writing elegant and amusing obfuscated code.

    Obu No 6: Use the arrow keys by Foochre (last here Jun 29 2001)

    Created: Feb 15 2000, Rep: 10, 2 replies.

    #!/usr/bin/perl use Curses;keypad initscr;nodelay 1;box qw{| -};($l,$d,$k,@f)=(1..3,[1 +0,10]);& n;while(){refresh;@f=([$f[0][0]+$d%2-($d==1)*2,$f[0][1]+$d%2-1+($d==2) +*2],@f); select$f,$f,$f,.06;($c=getch)+1and$d=4-($c%2?2:0)-($c<260);addch@{pop@ +f},' 'if @f>$l;$l+=$_=inch@{$f[0]};if(!/ /){/\d/||die;addstr 0, 60,$l;&n}addch@ +{$f[0]}, 'O'}sub n{while(){@v=(rand 24,rand 80);inch(@v)eq' '&&last}addch@v,''. +rand 10}

    Was this the first obfu to attempt fancy "visual effects"? Displaying mind-blowing visual effects became wildly popular with obfuscators that followed, for example:

    Obu No 7: My 2 cents worth by Erudil (last here Sep 18 2008)

    Created: Mar 02 2000, Rep: 216, 13 replies.

    #!/usr/bin/perl -w # my 2 cents worth use strict; $_='$_=tue($=+(two ($;)>>(two($;)>>2+2))){tue (too(two(tue($=+(two($;)>>(two ($;)>>2+2))))+(two($;)>>2+2))){tue (too(two(tue($=+(two($;)>>(two($;)>>2+ 2))))+(two($;)>>2+2))-2){tue(too(two(tue ($=+(two($;)>>(two($;)>>2+2)))))){tue(too( too(two($;)>>(two($;) >>2+2)))){tue(too($=+ +(two($;)>>2+2))){tue ((two($;)<<2)-2){tue ((two($;)<<2)-(two($; )>>2+2)){tue(too(two( tue($=+(two($;)>>(two ($;)>>2+2)))))){{tue (too($=+(two($;)>>2)+ (two($;)>>2+2))){{tue (too($=+(two($;)>>2)- 2)){{{tue(too($=+(two ($;)>>(two($;)>>2+2)) -2)){tue(too(too(two( $;)>>(two($;)>>2+2))) ){tue(too(too(too(too (two($;)>>(two($;)>>2 +2)))))){{tue(too($=+ (two($;)>>2)-2))}tue( too($=+(two($;)>>(two ($;)>>2+2))-2)){tue(( two($;)<<2)-((two($;) >>2>>2)<<2))}tue(too( too(two($;)>>(two($;) >>2+2))))}}tue(too($= +(two($;)>>2)+(two($;)>>2+2)))}}tue(too($=+( two($;)>>2+2)))}}tue(too((two($;)<<(two($;)>> 2>>2))+(two($;)>>2)))}}}tue((two($;)<<2)-((two ($;)>>2>>2)<<2)-(two($;)>>2>>2))}}}tue(too($=+( two($;)>>2)-2))}}}tue(too($=+(two($;)>>(two($;) >>2+2))-2))}}}tue(too(too(two($;)>>(two($;)>>2+ 2)))+(two($;)>>(two($;)>>2+2))-2);';y;{};..;sd; s;two;ord;g;s;too;hex;g;s;tue;chr;g;eval;print;

    Wow! Erudil wrote only 13 nodes, all with 100+ rep, and including the highest rated PM node of all time! Given the above masterwork was his "first attempt", I trust you can see why he is a PerlMonks legend, still revered and fondly remembered today.

    This node has the further distinction of being the first ever "block-buster obfu", given its 200+ reputation. Erudil elevated Perl obfu to a true art form.

    Obu No 8: Smile! by Anonymous Monk

    Created: Mar 04 2000, Rep: 9, 1 replies.

    # smiley - ($R=q#for (split/&/ =>q;4a&75@^ 73&74@20^41 &@6e@@6f^&@74 ^68&&65@72&20 &^50@65&@72 ^@6c&@20^48 @@61&@63& 6b@65&72;) {print &@pack ^c@&=> hex$_} ;print "\n"#) =~s,[&^@\s]+, ,g;eval$R

    Obu No 9: recursive self modifying eval japh by Anonymous Monk

    Created: Mar 13 2000, Rep: 6, 3 replies.

    $_='",",/[J|]$/?m)^.J)?(m~"(.+?)"~):s](^(.)(.*\)\?p.*)|(\)\?)(.' .'*))\|(.)]$4$2$6$3$5|]<<eval:s<([\w -%])(?=[^|]*$)><pack+q*c*,' .'(ord$1)-++$i%3>eg!~eval#@|xslvuuipfem#pwht%uimwssd$yvyO'=>eval

    Obu No 10: Tribute to Larry by whitton (last here Apr 07 2000)

    Created: Mar 28 2000, Rep: 9, 0 replies.

    #!/usr/bin/perl -- what is larry wall? @_=qw(l a r r y w a l l);for(0..1){$_[$_] =~ y#a-z#e-w#;} $_[3]=$_[$#_].' ';$_[4]=~s$y$h$;($_[5],$_[6])=($_[6],$_[5]); ++$_[6];$_[7]=chr 3+ord $_[7];$_[8]=~y~a-z~g-t~;print @_,".\n"

    Where are they now?

    Sadly, most of the obfu pioneers listed above have not been sighted for five years or more, the only exception being japhy ... though he only drops in occasionally nowadays.

    References

perl + Qt, the easy way
2 direct replies — Read more / Contribute
by vkon
on Dec 13, 2014 at 08:53
    here is a recently tried by me approach, which appears to be coolest thing since sliced bread.

    Code speaks louder than words.
    Here I go:

    runs just fine, wow...
    As for today - when there is no usable PerlQT on CPAN - this brings tons of possibilities.

    Yep, python is a nice lib... Long live Inline::Python !

Multi-stage flip-flop?
7 direct replies — Read more / Contribute
by RonW
on Dec 10, 2014 at 18:30
    In a response to a SOPW post, I wrote:
    while (<>) { if (/^#ERRORS/ .. /^CELLS/) { push(@errors, $_); } elsif (/^CELLS/ .. /^\s*$/) { push(@errors, $_); } else { ...; # other processing } }

    Which doesn't work.

    Occurs to me that it might be a useful enhancement to allow .. conditionX to be an additional stage to the preceding condition1 .. condition2, creating a linked cascade of flip-flops:

    if (/match1/ .. /match2/) { doStage1(); } elsif (.. /match3/) { doStage2(); } elsif (.. /match4/) { doStage3(); } else { doOtherProcessing(); }

    The semantics would be an extension of .. In the second example, match1 would trigger stage 1 (doStage1() will be called). Then match2 will end stage 1 and trigger stage 2 (doStage2() will be called). Then match3 ends stage 2 and triggers stage 3 (doStage3() will be called). Finally, match4 resets the cascade.

    Thoughts?

    Updated to mention the first example doesn't work.

    Updated second example and the description of the semmantics.

Would you suggest alternative names for Perl 6?
12 direct replies — Read more / Contribute
by rsFalse
on Dec 05, 2014 at 11:00
    I was upset when I knew that Perl 6 is a different language and not compatible with Perl and have the similar name, and appeared after Perl v5. Its is messy; practically humans think that number which goes after the name means version or something like that.
    I think that a name for that new language could have to match /^Perl\s?\D.*$/i or /^\w+\sPerl$/i, but not /^Perl\s?\d+$/i.
    Maybe it could be something like "Perlix", "Perlox", "Perl*". I liked Perlox or Perlex, where maybe -ex could mean 'extended', and -ox could mean that it has optimized (o) regexes (say DFA on simple search pattern), and it doesn't count spaces in regex by default (x).
    Now it is like forbidden for Perl v1..5 to have v6.

    UPD. Sorry for mis-searching. And thanks for very nice nodes, especially very funny very first!
Gaps in the Maps of pm.orgs
5 direct replies — Read more / Contribute
by wjw
on Nov 29, 2014 at 11:37

    I recently graduated to a situation where I might have time to explore Perl in a more 'social' context: by that I mean in meat-space. To my mild consternation, a look at the map of North American Perl Monger groups only to find that I am on the eastern edge of the great northern void.

    There are a couple of these desolate areas represented on the map, Some of these are perhaps more easily explained away than others I suppose. States with lower population densities or fewer urban areas are somewhat understandable as geographical deserts of Perl desolation. However, to my way of thinking, that does not explain all of these holes in the map of North America.

    Looking at the world map is even more strange to me. Perl is such a friendly, though quirky sort of language. It seems like it would bring people together more readily....

    One area in particular is odd to me, and the source of my mild regret. I currently reside on the Northwest corner of the Minneapolis/St. Paul area of Minnesota. This is not a massive or dense urban area, but it is not small either. There are numerous higher education institutions, a broad variety of industries are represented in the region, and yet no pm group. One would think that combined with the previously mentioned advantages, the winters we have here, would lend it to be an ideal place to attract a good number of Perl users interested in jaw-jacking over a beer or two. Come to think of it, there are some pretty good beers available here too....another reason which would support congregating on occasion.

    Apparently not.

    Searches on various engines indicate there have been efforts to establish such a group to no effect over the years. Once again, I find myself grateful for this site. I guess for now, my contact with the world of Perl will continue to be ethereal... . Not complaining, just saying... .

    PS. If someone knows of something my quick search missed, please do let me know. I could use a beer....

    Update:Thanks to those of you that responded. I am looking into opensource/linux and sundry tangential subjects in the area to see what might be leveraged. I do appreciate the encouragement, though I do want to investigate the reasons that it has not been done successfully previously first before I tackle something like this. Doing it poorly would probably be more damaging than not doing it at all...

    ...the majority is always wrong, and always the last to know about it...

    A solution is nothing more than a clearly stated problem...

Opinion: where Perl5 wasn't attractive for me
14 direct replies — Read more / Contribute
by rsFalse
on Nov 19, 2014 at 05:59
    As a newbie, I was dissapointed of:
    1) Perl does not have integer division operator. It must call "use/no integer" to change type. Python has: / - normal division, // - integer division. Sugar.
    To use things such as "ceil/floor", I need to "use POSIX"... Aren't they basic?
    2) It is not problem for me to read dollars in single variables. But it is annoying to read them in some-dimensional arrays (it's noisy), e.g. $array[$i][$j] > $array[$i][$j-1].
    3) It is strongly recommended to "use strict" and make variables "my", then why it is not default? Whay all the code must have so much my my my my...?
    4) Doesn't work - "$_ = reverse"; If in subroutine I can write "$_ = shift", why can't I write so in main (I need to write "$_ = shift @_").
    5) It was strange that "cho(m)p" returns last symbol, not a string w/o last symbol. Ruby's cho(m)p I like more, because I can proceed on string: gets.cho(m)p.split.do_smth...
    6) Can't use blocks using "and/or":
    "$i > 5 or {print "No"; last}" (overcome - "$i > 5 or (print "No"), last"; comma is tighter than "or" but it is counter-intuitive for me)
    7) It was suprise for me that when I used "$hash{length}" it interpreted (length $_) as "length"; Surprise was that ++ has magic (I need to know exceptions) and -- has not; Surprise that "use bigint" doesn't DWIM in some cases.
    8) Difficult exception is that "print (1+1)*2" != "print 2*(1+1)" == "print STDOUT (1+1)*2". I think "print(..." should better wait until the end of block or ";".
Sub signatures, and a vexing parse
2 direct replies — Read more / Contribute
by davido
on Nov 18, 2014 at 16:53

    I was experimenting with the experimental subroutine signatures feature of Perl 5.20 today along with the much maligned prototypes feature of old, and encountered a most vexing parse that interested me. So I wanted to mention it here.

    First, something that is not a problem:

    *mysub = sub : prototype(\@\@) ($left,$right) { ... };

    This parses correctly, and will generate a subroutine named mysub with a prototype of \@\@, and with named parameters of $left and $right, which when called will contain array refs. But this doesn't do much. My real goal was generating several similar subroutines, and called upon map in a BEGIN{ ... } block to do the heavy lifting.

    Here is a contrived example that isn't terribly useful, but that works, and demonstrates the issue:

    use strict; use warnings; no warnings 'experimental::signatures'; use feature qw/say signatures/; use List::Util qw(all); BEGIN { ( *array_numeq,*array_streq ) = map { my $compare = $_; sub :prototype(\@\@) ($l,$r) { @$l == @$r && all { $compare->($l->[$_],$r->[$_]) } 0 .. $#$l } } sub { shift == shift }, sub { shift eq shift } } my @left = ( 1, 2, 3 ); my @right = ( 1, 2, 3 ); { local $" = ','; say "(@left) ", ( array_numeq @left, @right ) ? "matches" : "doesn't match", " (@right)"; }

    Do you see what the problem is? The compiler doesn't care for this at all, and will throw a pretty useless compiletime error:

    Array found where operator expected at mytest2.pl line 14, at end of l +ine (Missing operator before ?) syntax error at mytest2.pl line 14, near "@\@) " Global symbol "$l" requires explicit package name at mytest2.pl line 1 +4. Global symbol "$r" requires explicit package name at mytest2.pl line 1 +4. Global symbol "$l" requires explicit package name at mytest2.pl line 1 +5. Global symbol "$r" requires explicit package name at mytest2.pl line 1 +5. Global symbol "$l" requires explicit package name at mytest2.pl line 1 +6. Global symbol "$r" requires explicit package name at mytest2.pl line 1 +6. Global symbol "$l" requires explicit package name at mytest2.pl line 1 +7. BEGIN not safe after errors--compilation aborted at mytest2.pl line 17 +.

    Q: So what changed between the first example, that works, and the second example, that doesn't?

    A: Lacking other cues, the compiler parses  sub : as a label named sub, and thinks that I'm trying to call a subroutine named prototype... and from that point on things are totally out of whack.

    Solution: +. Anything that can remind the parser that it's not looking at a label will do the trick. Parenthesis around the sub : ... construct works, but + is easier, and probably more familiar to programmers who use + to get {....} to be treated as an anonymous hash ref constructor rather than as a lexical block.

    With that in mind, here's code that works:

    use strict; use warnings; no warnings 'experimental::signatures'; use feature qw/say signatures/; use List::Util qw(all); BEGIN { ( *array_numeq,*array_streq ) = map { my $compare = $_; + sub :prototype(\@\@) ($l,$r) { @$l == @$r && all { $compare->($l->[$_],$r->[$_]) } 0 .. $#$l } } sub { shift == shift }, sub { shift eq shift } } my @left = ( 1, 2, 3 ); my @right = ( 1, 2, 3 ); { local $" = ','; say "(@left) ", ( array_numeq @left, @right ) ? "matches" : "doesn't match", " (@right)"; }

    ...or how a single keystroke de-vexed the parse.

    A really simple example that breaks is this:

    my $subref = do{ sub : prototype($) ($s) { return $s; }; # Perl thinks sub: is a lab +el here. };

    I don't really see any way around the parsing confusion in the original version that doesn't work. That perl considers sub : to be a label in the absence of other cues is probably not something that can be fixed without making sub an illegal label. But if I were to file a bug report (which I haven't done yet), it would probably be related to the useless error message.

    This example is fairly contrived, but it's not impossible to think that subs with signatures and prototypes might be generated in some similar way as to fall prey to this mis-parse.

    Credit to mst and mauke on irc.perl.org#perl for deciphering why the compiler fails to DWIW.


    Dave

The First Ten Perl Monks
6 direct replies — Read more / Contribute
by eyepopslikeamosquito
on Nov 16, 2014 at 08:31
The future of Perl?
26 direct replies — Read more / Contribute
by BrowserUk
on Nov 03, 2014 at 23:03

    Does it have one? Discuss.

    I express no opinion, because I'm not looking for an argument. No prompts, cribs or alternatives; because I don't want to influence what if any discussion ensues, one way or the other.

    I'm seeking, if not a consensus; then at least a census. A (possibly anonymous) expression of opinion from as many people who feel that they have a) a vested interest; b) an opinion worth expressing.

    No counter arguments; no condemnations; though I might have follow-up questions; which you are of course, perfectly entitled to ignore.


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
RFC: MooX::Role::Reconstruct (was MooX::Restore)
1 direct reply — Read more / Contribute
by boftx
on Nov 03, 2014 at 01:05

    After quite a bit of playing around I have what I think might be a viable approach:

    MooX::Role::Reconstruct

    Of particular interest is test 05 and 06 in the t/subclasses directory.

    I would appreciate thoughts on how it is implemented, how to improve the documentation, and how to expand the tests. I want to see how it plays with MooX::StrictConstructor in particular, but am unsure just how to include tests for that.

    In the meanwhile, I hope someone finds this of interest. I expect to release it to CPAN within the week unless I receive a reason not to from my fellow monks or one of the Moo demi-gods.

    You must always remember that the primary goal is to drain the swamp even when you are hip-deep in alligators.
How to make a progress counter for parsing HTML with HTML::TreeBuilder
2 direct replies — Read more / Contribute
by ambrus
on Oct 30, 2014 at 12:33

    This is the true story of a trivial bug I made in a perl program yesterday.

    This program parses a 3 megabyte sized HTML file using the HTML::TreeBuilder module. The program takes less than 30 seconds to run, but that'ss still boring to wait and I'd like to see whether it hangs, so I decided to add a progress counter. Now, as I haven't written all of the program yet, much of the time is currently spent in just parsing the HTML file and building a tree representation in memory from it. Thus, I needed a progress counter in the HTML parsing itself (as well as one in the rest of the program).

    Before I added the progress counter, all of the HTML parsing happened in just one call of the HTML::TreeBuilder->parse_file method. If I kept that, if would be difficult to add a progress counter in it. Thus, I changed the code to instead read the HTML file in 64 kilobyte chunks, feed them each to the parser with the HTML::TreeBuilder->parse method, and print progress after each according to how much of the file is read.

    I thus wrote this.

    use HTML::TreeBuilder; my $filename = ...; my $tree = HTML::TreeBuilder->new; { open my $fileh, "<", $filename or die qq(error opening input h +tml file "$filename": $!); binmode $fileh; my $filesize = -s $fileh; while (read $fileh, my $buf, (1<<16)) { $tree->parse($buf); printf(STDERR "Parsing html, %2d%%;\r", int(100*tell($ +fileh)/($filesize+1))); } $tree->eof; print STDERR "Parsing html complete. \n"; }

    This worked fine. I got a comforting progress counter with percentages rolling quickly on the screen.

    Later, however, I wanted to work around a bug in the HTML, namely some missing open tags. This can be done mechanically, because this is a generated HTML file, but it was easier if I could modify the text of the HTML before parsing it to the tree, because otherwise the tree would have a wrong shape that would be difficult to fix.

    Thus, I chose to do some substitution on the text of the HTML before parsing it. This was easier by slurping the whole HTML file and doing substitutions on the whole thing. So I changed the code to slurp the file contents, substitute it, but then I still wanted to feed it to HTML::TreeBuilder in chunks to get a nice progress counter. No big deal, I wrote this.

    use HTML::TreeBuilder; my $filename = ...; my $tree = HTML::TreeBuilder->new; { printf STDERR "Reading html file.\n"; open my $fileh, "<", $filename or die qq(error opening input h +tml file "$filename": $!); binmode $fileh; local $/; my $filec = <$fileh>; eof($fileh) or die qq(error reading input html file); printf STDERR "Substing html file.\n"; $filec =~ ...; my $filesize = length $filec; printf STDERR "Substed html has length %d\n", $filesize; my $filetell = 0; while (my$buf = substr $filec, 0, (1<<16), "") { $filetell += length $filec; $tree->parse($buf); printf STDERR "Parsing html: %2d%%;\r", int(100*$filet +ell/($filesize+1)); } $tree->eof; print STDERR "Parsing html complete. \n"; }

    This didn't work. The progress counter started showing very high numbers, going up to tens of thousands of percents. I stopped the program because I was worried it got into an infinite loop repeatedly parsing the same part of the file over and over again, and will build an infinite tree.

    After a while, I found the problem. It turns out that the HTML was parsed correctly, only the progress was displayed wrong.

    Can you spot the bug? I'll reveal the solution under the fold.

RFC: MooX::Restore
1 direct reply — Read more / Contribute
by boftx
on Oct 28, 2014 at 23:01

    I saw this module come across recently: MooseX::Role::UnsafeConstructable

    I immediately thought of a few use-cases where I want to instantiate an object from, say, a database row but having init_arg => undef, in my Moo code would prevent that.

    As it turns out, it is fairly simple to create a Moo::Role that can provide a new method, possibly named restore that can ignore the init_arg directive and allow one to instantiate a Moo object from a hash or hashref that would otherwise be blocked. A side benefit is that such a method could still call builders and whatnot if needed for attributes that were not stored in the database row.

    My questions are these: a) does anyone else have a similar use-case where it would be handy to do something like my $obj = MyClass->restore( $db_rowref );, bypassing init_arg restrictions, and b) what would be the correct name for such a Role? (I really think "UnsafeConstructable" is a bad choice.)

    I realize there are a few (or more) warts on this, especially where init_arg is used to rename an attribute. I would love to hear thoughts on what one would expect to happen in those cases.

    You must always remember that the primary goal is to drain the swamp even when you are hip-deep in alligators.

Add your Meditation
Title:
Meditation:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others avoiding work at the Monastery: (9)
    As of 2014-12-27 22:02 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (177 votes), past polls