#!/usr/bin/perl

Just->Another->Perl->Hacker;

package Just;

INIT  { print __PACKAGE__, ' ' }

sub AUTOLOAD { bless [print+($AUTOLOAD=~/::(.+)/)[0], q/ /] } 
sub DESTROY    {}
[download]

This node contains a couple of short non-empty non-cheating perl quines. I've had most of this collection for ages, but have apparently never posted them on perlmonks.

One of these quines (323e) is the shortest non-empty one I know, but it has the disadvantage that it only works in perl 5.6.0 or later.

323a: 44 40

print<DATA>x2 __END__
print<DATA>x2 __END__
[download]

323b: 35 32

print<<''x2,"\n"
print<<''x2,"\n"
[download]

323c: 44 44

$a=q(;print"\$a=q($a)$a");print"\$a=q($a)$a"

323d: 50 48

$\="\47";print,print for'$\="\47";print,print for'

323e: 31 26

print<< x2,v10
print<< x2,v10
[download]

323f: 46 44

$\=v39;print,print for'$\=v39;print,print for'

323g: 58 57

print"$_\Q$_\E\"\n"for"print\"\$_\\Q\$_\\E\\\"\\n\"for\""

323h: 52 52

print"$_\Q$_\E\""for"print\"\$_\\Q\$_\\E\\\"\"for\""

Update 2012-12-12: see also General quine, How I Learned About Quines, Quine Whine, Is there a non-empty error quine in perl?.

perl -e '
                   #
                  ###
                 $OoO=
                "\e[H";
               00;$oOo =
              "\e[1J";sub
             o {print @_;}
            o $oOo ; sub x{
           ($o , $O ) = @_ ;
          sprintf("% 13s%s\n"
         , $o, $O )}   sub O {
        o $OoO ; $c = "*" ; map
       {$o = $c x$_;$O=$c x($_-1
      );$d="@";sub k {$Q = shift;
     map{ substr($Q,rand(length($Q
    ) ), 1) = $d }( 1..length($Q) -
   1);return$Q;} $o=k($o); $_>1?$O=k
  ($O):"";$d="/"; $o=k($o); $_>1?$O=k 
 ( $O ) : ""  ; $a [ $_ ] =x($o, $O );
}(1 ..12);o@a;o x"||";o x"||";sleep 1;o
                 ;;O()
                 ;}O;;
'
[download]

#!/usr/bin/perl#?
#3rdeyeperls#    #
#hllllp#         #
###             #
#              #0#
             $a = 1;
           $b = 1 + 2;
          $c = 1 + 2 + 3;
       $d = 1 + 2 + 3 + 4;
     $e = $a + $b + $c + $d;
  $x=$e/5;$y=$x;print$x;print$y;
#who/what?? is snowing my window #
[download]

use 5.010_000; use warnings; use strict;
for my $l (map [unpack "(A)*", $_], qw" 
\" |*'!~ |%+:( >|(+: }~|:*( |!:( ;(!:^| 
;='*( \"") { for (map { {unpack "(A.)*"}
} qw"^ = = = | [ ] ( ~ ~ ~ (-: [ ] !( ~ 
~ ~ + [ ] %>* * * * ! [ ] ; ; [ ] %= |= 
= [ ] : ' ' ' : [ ] '( } } } *(") { when
($l) { print "@" } print " " } say ""; }
[download]

The Hilbert Dragon

By default, this adds PerlTk graphics to Hilbert Curve. But, as penance for irritating the math gods (Math >> XKCD, even in my book), this one allows you to input any L-system you want.

Update: Forgot to explain that the obfu's pattern is in the (negative) shape of the Penrose dragon, but it makes the Hilbert curve by default. (hence "the Hilbert Dragon").

#!/usr/bin/perl
use strict;
use warnings;
;$_=q~&6P+H;M`4K]N!L$5@QtDLBO1`4#]AKC(mdfFkDqXF$1dEc+D>$3uAA[>Fm9@P&QN
+[CZ>BJ
X:"*2Bf@Rj)h(@ZIXvH`P6DR0zHAJR#@admir{JKMP,NBZ8IC`*NB$xDHXPJ^DhAH;TVB(
+.kbyTJ
X>J"HbMBX&D!`al{        ]^m)NXnBhYd+ZCpC        MVEA0`H"8(JbX$L"PjDv`H
+'C,lOg
Y:MC,2EB@FT]m*CC  tFAD  G@9.%]p@PlPbEPqX  D"G1  E;eY=M@VdD$dx[q<bD|k`4
+OD8"rT
OBL`$yMELDDHc!tO  DHfD  DadnZ@4+sRF1\\9$  `b3z  Jq\\D2X#%Hd$PD@tieRZ@J
+TE\\)`
HD!hHA.H@4NaMZB@              iFL,"@&6HP              D>sOdDPY{ELj$H@E
+Tm`P)P
T^`l!d<i`Q\\7P]aF;%NOw  0ne|  B$Yd@IF`r7DJy$5B  @PP%  tF@HEf?Fx>.YKJ@H
+]9bwem
!,a!`p]71aEH^`'NcwPXyT  K&0L  \\PEl(D<hLLn9PSS  SL%A  OD`PECT`p*!.0A4j
+yPV{;P
|gev        67`A                    XPDm              /PJ`)TC<OADOmP8a
+pHA|HA
(x:0  `dJX  ALF!  XE@P  $T\\  H`3k  AHF>  fX^{  8@ws%tI@XB`n,Z@@&KfGxN
+h>J`G@
"AX8  `@Hp  'bdD  @_+>  aXJA  zV!T  E>"@  xB2N  @\\C`GKZA>CXiBJJ`*b$I0
+BBldpa
qLHH              jBJA        @uIP                    g1[`IC0BQ@@`\\#&
+q@OCP)
P'B(HpA@F@  hH@$KDdrWI(,C^FQVE\\J4L`HF08  BFX9  TA2?  $]Ap?`lGmDtTQU@d
+MP?DHx
Q0KLi`HH[1  G.R<k`|<Y*Ch+P[@:?DkqKD|T"]L  ;y13  M\\5  Q7Mp[@}O`!gnLT+0
+ZFs>TY
B@)H        `VrE4N.Y<AwCPO(`|tvchG                    mNKiSp,oMLUQ@zGX
+YPqGKH
bf{Q  W/D<`M@"^1WlbFuH@ZYMZOJBS724  w]J@  @R([  @P>YU,^_Sj'@kK$+V[I;MF
+K8PB*C
ka&Q  Z!|"gBHjKfHPNI<\\r@`HI{Sa>G+  >B[]  JDFt  BKdKUSXHMVK@IJ>D9$A6M@
+5CXMyn
!&\\        @;`D  aB@`P_hF@eS@)F0G        %k'l        JxdBRI$Y(B      
+  D@8f
DDxDbvRhd6  2D|<  @HIHFi9"^JyF@pC@Bv(BAN48$!:V[`B&xR  9y_dXE,@r#+WzMXA
+  @D0h
2f:NJGce&)  Vbi%  .\\Y"V]J@QbB9"M@pn)LAD7Zg(hMeZU@[X  yi=8Xxo%wGt.(8az
+  Unq{
NCr?[NkU4[        Olm7[S,u5[Y.EuB:@`*DHx[$B![X              n6t>      
+  lFb1
VRA[O]e4`L0@D`_SX8|YfPHHVx\\<X%"dY.G#`&@@[V_BF  H+af  vBbm  BPP`  J\\^
+Y_AVqj
;]$meQLd6@RNh>E`'mpTvnFzHP.8xJD!")X02b6HX$B%(S  \\83  ">Lx  pI0M  bJK@
+5"{8DD
`Q`xDJRHh(^Z|>U@DAPAFZ@P@D\\<8x@^AMJ^\\~;s{\s}        {}g;        s/(.
+)/join
"",map{ord$1&2**(5-$_)?1:0}0..5/ge;my(%d,%r);sub p{sprintf"%b",0+keys%
+d};$d{
chr$_}=p for 32..126;sub r{$;=1+int log(1+keys%d)/log(2);$_="0"x($;-le
+ngth).
$_ for values%d;%r=reverse%d;s/(.{$;})//?$1:0}$a=$^=$r{r()};while($"=r
+){$^=~
/(.)/;$.=exists$r{$"}?$r{$"}:$^.$1;$a.=$.;$.=~/(.)/;$d{$^.$1}=p;$^=$.}
+eval$a
[download]

(See the readmore for TONS more.)

Sources

This wouldn't have been possible without several incredible sources:

• MathWorld's page on Lindenmayer Systems
• Several pages on Fractint:
  • L-systems in Fractint
  • Fractint L-systems tutorial
  • and the corresponding .L files in /pub/fractals/lsystems
  • especially McWorter.L for most of the cool examples
• Robert M. Dickau's page about 2D L-systems (which inspired the color scheme I used)
• And, for the obfuscation:
  <Reveal this spoiler or all in this thread>

Shameless plug

I made a gallery of fractals that this program (plus ImageMagick) created. (Page also has some of the same background that this node has -- and I haven't yet given proper credit to the L-systems' "inventors"/"transcribers".)

Mandelbrot set inspired me to write my first obfu. I used the Hilbert Curve (as featured in XKCD). It takes an optional numeric argument on the command line (should be a positive integer less than ten, with a default of 5). There's no error checking on the argument, but the rest of the code is warningless under strict+warnings. I might write more about it when I need to procrastinate further. :-) Hint:

#!/usr/bin/perl
use strict;
use warnings;
;$  "=q%ef%;$_  =q~my($i,$  x,$y,$p)=(  0,0,0,pop|  |5);my$r=2
<<  $p      ;m  y@      i=  ma      p[  (1      )x  $r      ,2
],1..$  r;subi  {$i[$x  ][$y]-  -}i;su  bp{((1  <$_[0]  ?$y:$x
        )-          =1          -(          $_          [0
]&1)*2  ,i)for  -1,1}s  ubf{my  ($  p,$f)=  @_  ;$p--;  my@m=(
$f  ,3      -$  f,      1-  $f  );  my  @o  =(  3-  $f      ,$
f,  $f,$f-2)if  $p>0;($_&=  3)  for@o,  @m;@o&  &f  ($p,pop@o)
,@                          m&                  &p
(pop@m  )while(@o||@m)  }f$p,(  $p&1)*  2;subb  {y  ,y4102,b#\
    n,  ;p          ri  nt      }m  ap  {b  fo  r@  $_      }@
i~;y~   \n~~d;  ;s&b&b  &g;$;=  1;  eval;#  %$  _+28;$  x-=$y;
my          ($  pi          )=  '3          .1          41
59  26535'  ;$  ,=  2*2**$  [;  ;my@b=  map[5x  $pi],1  ..$[;s
{}  {q  %S  {$  b[  $x  ][  $y      ]=  0}      S;  su      bp
{($_[0  ]>1?$y  :$x+=-  1+$_[0  ]^2*2,  S)for(0,1)  }suba{($l,
                                $d
)=@_;$  l--;@m  =map$_  *4,5-$  d,3-$d  ,$d;@h=map  $_*4,$d+2,
$d  ,$  d,  3-  $d  if  $l  >0      ;{  a(      $l  ,s      hi
ft  @h)if@  h;  @m  &&p(sh  if  t@m);(  @m+@h)  &&redo  }}a$l,
$l          ^2  *2          ;p  ri          nt          @$
_,$/fo  r@b($x  ,$y,$c  )=qw/0  0*  /;$l=s  hi  ft||4;  $r=$s*
    2*  *$          l;  @b      =m  ap  [(  ''  )x  $r      ],
1..$r;  for(0,1){eval[  qw/$x-  -$x++$  y--$y+  +/  ]->[i$_[0]
];                          $b                  [$
x]  [$y]=$c;}@  m=split//,  [q  w/rdll  urdruu  ld  /]->[i$d];
@h  =s      pl  it      //  ,[  qw  /u  ll  dd  rr  ul      uu
rrddl/  ]->[i$  d]if$l  >0;@m=  sp  lit//,  {q  w/lrdl  rlurud
        ru          du          ld          /}          ->
{$d};@  m=spli  t//,su  bstr'r  dllurd  ruuld'  ,3*i$d  ,3;@h=
sp  li      t/  ,{      qw  /l      ul  ld      rd  rr      uu
lu  urdrddl/}-  >{$d}if$l<  7;@m=split  //,substr'  ulldd'%}e;
[download]

#!/usr/bin/perl

                                       $_='
                                       lx)L
                                    %j-%h-%k-%
                                 s-%y-%x(:gns%x)X
                               ,04//05(zgns%y)1//6
                              8(zqshou#]dZ#-%j\'04
                    ?6>0;1-# :2#-%j$6-#l/#:gns)%h<%
                   j<%s<1:%k<%s+%s,%h+%h,3*%y.34-%h
               <3+%s+%h*%x.01-%k+REKCAHX%k*%h+%h=
                   00\'JUST\'ANOTHER%jPERL**=000:%s
                    <%k(zqs  houHACKER##:|||qshou#
                             ]dZ1l#:';s/\s{1,}//gm;
                               s/[\x41-\x58]//gm;
                                s/(.)/chr(ord($1)
                                    ^0x1)/ge;
                                       eval
                                       ;qaa
[download]

$@=29628;s/./y$   IIVCXL426      (-:V$XIVX
LMCDIVX$dfor$$_   .=5x$&*8%      $@;$$$_=$
_/egfor-4e3..0;   $;=qq/LXX      IV+CXVII+
      CXV            +CX            VI+
      XXX            II+            XCV
      II+            CX+            CXI
      +CX            VI+            CIV
      +CI            +CX            IV+
      XXX            II+            LXX
      X+C               I+C      XIV
      +CV               III      +XX
      XII               +CI      V+X
      CVI               I+X      CIX
      +CV               II+      CI+
      CXI               V+X      LIV
      +X+               XLV      III
      C+C               MII      XV+
      DXI               M+I      MCC
      MCM                  +XXIII
      DCI                  MMV+II
      C+I                  MMVIII
/;$;=~s/\s+//g;            print+
eval(join+q/./,            map-${
$_},+split/\+/,            ~~$;);
[download]

s/./y$IVCXL426(-:$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_/egfor-4e3..0;
print+eval(join+qq/./,+map-${$_},split/\+|\n/,+qq/LXXIV+CXVII+CXV+CXVI
XXXII+XCVII+CX+CXI+CXVI+CIV+CI+CXIV+XXXII+LXXX+CI+CXIV+CVIII+XXXII+CIV
XCVII+XCIX+CVII+CI+CXIV+XLIV+X/)
[download]