joeLesko.com

Fun With Code

Random stuff I posted on PerlMonks.org between 2001 and 2010. All of the code is executable.

It Came From the Crypt()

                                  $q=
                  q&9RM        8  ba1c
                 HtJprcG        6SJ3dk
 aQM             8  p  j         p8vsY
i3UnT f          kcRJk9w          xW2v
 h2GVK3          YL1gNvf          YEX
  dBQdE           TIdpMu         WD9Y
   CAvK0      BrsuKn9kXUwk     aNpj8q
   ISZgRZkUg2I8W9jJsG8Rg9yeE8LvqZR7A
   Ho PDIRVAVCgafA9MZjFb31Ea5bqr7gCg
   X    zPpgkPsHjTP8iC2TtVYE0PUR b z
   Y    b3  EQiZrZiIm6Nc81WY  qs U g
        7m  QzHM2VjY62II5Bg   7N e k
        kt  7 5JLD86&;$u=$q   =~ s &
        \s    &&xg&&-2;@v=    unpack
        q     &c3&,qq&i\nm       &;
               unshift@v,2       **
               2*2**2*2;%l       =
                map{chr$_}
               reverse@v;$i
             =2*2*2&&$q,$q
             =$i&&8; while(
           $i=~m& [^ *]{$q}
          &x){$y  =   substr
         (crypt(       $&,$&),
         $u,print     );print       !
           $l{$y}      &&$y       ne
           "y"?$y:     $l{$y} ;$i=~
           s+$&+ +x     }$y=~m
          &ymum    ~
          my&

Brilliant Idea!

                 !                           !
                  !                         !
                   !                       !
                    !                     i


                           ;$_=join(
                        q!!=>map{$!=$!&
                      0;map{s$![^\]! =s!!
                     \$x-Y\\[@!]!Y=$!  =$x
                    ;$!+=s$[q!=>\$x-Y=  [@!
                    ]$!={$g}@$_;$g=i&&  q!!
.   chr   ($!       +0x3E)}([\\$!=>{!!  !$!       =>!   chr   ,
                    [!$!]}]=>[\$!=>\$!=>\$!
                     =>[!$!]]=>[\$!=>\$!=>
                      {$!=>[$!]}=>{!$!=>[
                       $!]}]=>[\\$!=>{$!
                        =>[Y]}]=>[\$!=>
                         {$!=>[!$!]}=>
                           \\!$!]=>[
                            \\$!]))

                  ;        print  =>         !
                 !          print=>           !
                !          print  =>           !
                            print=>
                           print  =>
                             print

Monolith

# A tribue to 2001: A Space Odyssey



      $_=q{earth->dawn("man");
      goto^@$monolith/=0;bless
      %humanity;bone->throw();
      *year+=10000;#tycho=TMA1
      USS_Discovery->(Jupiter)
      [::]>>>=<>=<>=<>==<>=(-)
      ;require 2001;#if($error
      exists($HAL_Malfunction)
      #open($podBayDoors,HAL.)
      or die(); HAL9000->ask("
      What_are_you_doing_Dave?
      ");sing("Daisy")*|sleep}
      ;@universe=qw#15 01 06 4
      01 01 12 2 22 2 14 01 11
      02 00 5 25 1 38 3 07 2#;
      my$God;$monolith="*****"
      ;@light=split/[~^;|]/,$_
      ;;while(my($space,$time)
      =splice(@universe,0,2)){
      $stargate =shift @light;
      eval qq+$stargate+;$warp
      =substr($@,$space,$time)
      ;$space=>print uc $warp;
      $warp;$warp;$warp;$warp;
      $warp;$whoa;$warp;$warp;
      $warp;$warp;$what;$warp;
      $skgnsietgisernwisgsdwe;
      @room;*starChild;@earth}

Perl of Wisdom

use strict ; my $OO=
sub{print(($_[0]
==3)?chr( 10
):chr(68+
$_[0]))
;};my
$o=
qq
c

                     oooooo
                  oOOOOO0OOO0o
                oOOOOOOOO...OOOo
               oO0OOOOO0OOOO..OOo
              oO0OOOOOOOOOOOO..OOo
              o0OOOOOOOOOOO0OOOOOo
              oOOOOOOOOOOOO0OOOOOo
              oOOOOOOOOO00OOOOO0Oo
               o0OOO0OOOOOOOOOOOo
                oOOOOOOOOOOOOOOo
                  oOOOOOOOOOOo
                     oooooo
                                             c;
                                             my
                                            $O0
                                           = 0;
                                          while
                                        ( $o =~
                                      /0  (.*?)
                                   (?= 0)/sgx){
                               my$O=$1;$O0=$O=~
                            tr/Oo//;$OO->($O0)}

DNA Code

                                            $_=q=GCGCAT=;
                                                    $AT=m++;
                                                      $CG=$AT
                                                    -$AT+$AT;
                              $TG=$CG+$AT-$CG;$CAGC=$AT-
    $CG+$CG+$AT-$CG+$AT-$CG-$CG;
 $CAGTC
=q;;;
 %CTACG
      =('C',$AT+$CG+$TG-$AT-$CG
                              +$CG-$TG,'A',$CG-$AT+$CG-
                                                     $AT-$TG-
                                                      $CG+$AT-
                                                     $CG+$TG+
                             $CG,'T',$AT+$TG-$CG+$TG+$AT
   -$CG+$AT-$TG-$CG+$AT+$CG,'G',
 $CG-$AT-
$TG-$CG+
 $AT+$TG+
   $TG+$CG-$AT+$CG);$GCA=$CTACG
                              {T}**$CTACG{G}+$CG;$CTG=$GCA
                                                       *$GCA;
                                                        $GGC=
                                                       $GCA/(
                                $AT+$AT);open(CGGCTA,$0);
      while($CTGCAC=<CGGCTA>){if(
   $CTGCAC
  =~m#(
   q()(q)
       )#x){$CAGC=$AT+$AT-$CG}if
                                ($CAGC){($CGTC)=($CTGCAC
                                                      =~m#^
                                                       \s*(
                                                      [ACGT
                                ])#x);if($CGTC){$CAGTC.=
      $CGTC}}}close(CGGCTA);@CGC=
   ($GCA,
   ($CTG-
       ($GCA+$GCA+$GGC+$TG)),($CTG+$GCA+$GCA-$CTACG{T}),
                                                      ($CTG
                                                      +$GCA
      +$GGC),($CTG+$GCA+$GGC+$CG),($GCA*$CTACG{T})+$CTACG
    {G},(
     $GCA*
        $CTACG{T}*$CTACG{G})+$GGC,$GCA+$CTG,$CTG+$CG+
                                                    $GCA,
                                                   $GGC+
        $CTG-$TG,$CG+$CTG,$CTG+$GGC+$GCA-$AT,$CTG-$GCA-
    $GCA,$CTG
     +$GCA-$TG-$CG,$CTACG{T}*$CTACG{T}*($TG**$CG)*($GCA
                                                 -$CTACG
        {G}),$CTG-$CTACG{T},$CTG-$CG,$CTG+$GCA-$CTACG
     {T});@GC=
        split/T+/,$CAGTC;for $TTC(@GC){$CGTC=$AT-$CG
     +$AT                                         -$CG
     -$AT-$CG+$AT+$CG;$CTGCAC=$AT-$CG+$CG-$AT+$AT-$CG;
        while($CTCCGA=substr($TTC,$CTGCAC,$AT)){$CGTC
           +=$CTACG{$CTCCGA}*(($CG+$TG+$CG-$AT+$CG
                )**$CTGCAC);++$CTGCAC;}print
                  chr($CGC[$CGTC]);}$CTCCGA
                      =             qq;
                      A --        -- T
                       T --      -- A
                        C ---   -- G
                        T --- --- A
                        G ------- C
                         T ----- A
                          A --- T
                           C - G
                             T
                           T - A
                         C ----- G
                        C ------- G
                        T ------- A
                        G ------- C
                         C ----- G
                          T --- A
                           A - T
                             G
                           T - A
                         T ----- A
                        C ------- G
                        G ------- C
                        T ------- A
                         T ----- A
                          G --- C
                           G - C
                             T
                           C - G
                         C ----- G
                        T ------- A
                        A ------- T
                        A ------- T
                         C ----- G
                          T --- A
                           C - G
                             A
                           C - G
                         T ----- A
                        G ------- C
                        A ------- T
                        C ------- G
                         T ----- A
                          G --- C
                           C - G
                             T
                           T - A
                         A ----- T
                        C ------- G
                        C ------- G
                        T ------- A
                         C ----- G
                          A --- T
                           C - G
                             T
                           G - C
                         A ----- T
                        C ------- G
                        T ------- A
                        C ------- G
                         C ----- G
                          C --- G
                           T - A
                             G
                           C - G
                         T ----- A
                        G ------- C
                        C ------- G
                        C ------- G
                         T ----- A
                          A --- T
                           G - C
                             C
                           T - A
                         T ----- A
                        C ------- G
                        G ------- C
                        C ------- G
                         T ----- A
                          G --- C
                           G - C
                             C
                           T - A
                         C ----- G
                        A ------- T
                        C ------- G
                        T ------- A
                         G ----- C
                          A --- T
                           C - G
                             T
                           A - T
                         T ----- A
                        A ------- T
                       ;           ;

Stayin' Alive (With CPAN)

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

        STAYIN' ALIVE (WITH CPAN) - LYRICS

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

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.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Well now, I search low and I search high,
If I used Java, I think I'd die.
Got lots of modules from which to choose,
I'm a Perl hacker and I just can't lose.

You know it's all right. It's okay.
With Finance::Quote and Text::Template.
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.
Date manipulatin' and web authenticatin',
and we're stayin' alive, stayin' alive.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Ah, ha, ha, ha, stayin' alive, stayin' alive.
Ah, ha, ha, ha, stayin' alive.

Code goin' nowhere. Somebody help me.
Somebody help me, yeah.
Code goin' nowhere. Somebody help me.
Somebody help me, yeah. Stayin' alive.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Well, you can tell by the way I use Proc::Lock,
I'm a Perl Monk, no time to talk.
Got CGI and Tk::More,
and I grok the Schwartzian Transform.

You know it's all right. It's okay.
With Net::POP3 and Sort::Array.
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.
String transliteratin' and SQL generatin',
and we're stayin' alive, stayin' alive.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Ah, ha, ha, ha, stayin' alive, stayin' alive.
Ah, ha, ha, ha, stayin' alive.

Code goin' nowhere. Somebody help me.
Somebody help me, yeah.
Code goin' nowhere. Somebody help me.
Somebody help me, yeah. Stayin' alive.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Angsty Poetry

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

     Inspired by Rik, the People's Poet (RIP)

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# Wall

oh Larry Wall,
sometimes it must be difficult
not to feel at all
that you really are a wall.
when Python programmers try to push you over it,
are they the ones that fall?
or are you, Larry Wall?
or *are* you Larry Wall?

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# NodeReaper

NodeReaper
near my code
taking showers
that are cold,
but always near my code.
NodeReaper, are you coming to my node?
or am I coming to yours?
we're in different threads, NodeReaper,
but we're both using strict.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

# Job Anguish Poem

oh god,
why
am I the only Perl programmer in my company?
why
must I write code into the late hours of the night,
long after everyone has gone home?

I bet I'm the first person who's ever felt
as lonely as this.

could it be
that I'm going to grow up
to be a great guru and visionary,
and all those Java monkeys at my job
are going to end up in the unemployment lines
when the economy takes a dive?

yes, I think it could.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~