(taken from http://orwant.www.media.mit.edu/tpj/contest)
The Perl Journal
0th Obfuscated Contest Entries
Best of Show:Gisle Aas
Category winners:Russell
Caton, Robert Klep, Bob Sidebotham
The entries are keyed 'A' through 'K'; the author-written
solutions are provided after all the entries.
In the spirit of the contest, you can use this Perl snippet
created by waider@waider.ie to extract each entry and save it to a separate
file:
perl -n -e '/Solution/&&exit;if ( /^([A-L])\. / ) {open(OUT, ">$1.pl");
print "$1.pl\n"; print OUT "#\!/usr/bin/perl\n" unless $1 eq "E";
chmod 0755 ,"$1.pl";}else {close OUT if /^\s*Most|^\s*Best|^\s*Honorable/;
print OUT}'
The Submissions
Best Four Line Signature
A. Third-place tie: Krishna Sethuraman
%bar = split(//,'b sefcwPjrnsaJrhelvhiomrqed uahtyklapecttug,x kron');
print @bar{reverse sort {index(join('',a..z),$b)*4%25<=>
index(join('',a..z),$a)*4%25;} keys bar};
B. Third-place tie: Sriranga Veeraraghavan
$_=substr($ARGV[0],0,1);s/ //;$_="#"if/^$/;$c=$"x17;$u=$".$_ x5;$m="$_ $_";
$p=" $_ "." $m"x2 ." $m"x2;$,=$\="\n";$i="$,$c$_ $_$_$u$u$_$u$u";$b=" $_$_$_"
x4 ." $p";$o=$c.$p;$s="$c $_ $u$_ $m$u$u$_$\$c $c$_$\ $c$c$m$,$c$c$u";
print$i,$o,$b,$o,$s
C. Second place: Poul Sørensen
$_="The perl journal\r"; $|=1;
$e='s/([\x41-\x5a])(\W*)([\x61-\x7a])/\l\1\2\u\3/g';
print while select('','','',.1),eval $e || $e=~tr [4567lu] [6745ul];
D. First place: Robert Klep
$Y=-1.2;for(0..24){$X=-2;for(0..79){($r,$i)=(0,0);for(0..15){$n=$_;$r=($x=$
r)*$x-($y=$i)*$y+$X;$i=2*$x*$y+$Y;$x*$x+$y*$y>4&&last}print unpack("\@$n a"
,".,:;=+itIYVXRBM ");$X+=3/80}$Y+=2.4/25}
Most Powerful
Third place: Robert Klep
...for his aforementioned Mandelbrot set generator.
E. Second place: Gordon Lack
#!/usr/bin/perl -w015l12pi.bak
F. First place: Russell Caton
$-=100;while((($@)=(getpwent())[2])){push(@@,$@);}foreach(sort{$a<=>$b}@@){(($_<=$-)||($_==($-+++1)))?next:die"$-\n";}
Most Creative
G. Third place: Stephen McCamant
use Math::BigInt;$|=1;$%=2;($y,$b=>$c,$d)=map{new Math::BigInt $_}4,1,12,
4;a:($=,$-,$%)=($%**2,2*$%+1,$%+1),($y,$b,$c,$d)=($c,$d=>$=*$y+$-*$c,$=*
$b+$-*$d),($;,$:)=($y/$b,$c/$d);$;=~y/+//d=>(print$;,$%-3?'':"."),($y,$c)
=(10*($y%$b),10*($c%$d))=>($;,$:)=($y/$b,$c/$d)until($;-$:);goto a
H. Second place: Steve Lidie
#!/usr/local/bin/perl -w
$_=q/$_=;&^#!;&^#!;&^#!;&^#!;f#r($^=0;$^$^=>1;pu
:h%@#=>&hr%:u?:tr $_=>$^+1=>$~}eval%joi~%'',@#;/;y/!#^&%:?~/pohc sbn/;eval;s/~/length/;#$;
=qw(journal 44311229729931072 lrep 973109310 eht 32260283262259210);frog>$^+1=>$~}eval;f#r
($^=0!;f#r(;/;y/!#^&%:?~/po;eval;print;
__DATA__
311731153101232283311129931073101311625931153111299310731013116240283244280270295273278269
284244283279267275295283284282269265277244310331013116311231143111311631112983121311029731
093101240239311629931122392412412592993111311031103101299311624028324431122972993107240239
283311029725231202562392442502442522482512492442402363106244236310624423631062442363106244
236310624126131033101311631043111311531162983121311029731093101240239284311731143107310131
212462672672462763101310431053103310424626926828523924124124125931123114310531103116232260
283262259210
I. First place: Bob Sidebotham
# $Id: pisig,v 1.21 1996/07/08 19:35:21 rns Exp $
$maxerrors = 220; # needs tuning
$pi = reverse "3.1415926535897932384626433832795028841971693993751058209749445923078164062
862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841
027019385211055596446229489549303819644288109756659334461284756482337867831652712019091456
485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917
153643678925903600113305305488204665213841469519415116094330572703657595919530921861173819
326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860
213949463952247371907021798609437027705392171762931767523846748184676694051320005681271452
635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420
199561121290219608640344181598136297747713099605187072113499999983729780499510597317328160
963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814
206171776691473035982534904287554687311595628638823537820166732315642315632318742318732312
842312832365832369732364722392310116732315642315632328732318742312832312832315842315832319
742319732314772392310116732365632318712318722318742352832315842315832319742319732314772392
310116732315642315632318722318712318732312842312832315842315832319742319732314772392310116
742345642318732328732362832315842315832369732314772392330172392310166732312842312832369682
310882310116742312832312882319682310882310116742352862339642350882310116732312842312882319
632310842310882310116732362832369632360882340169632312742312762314822310119632312742312762
3148223101923396323627623148223101196323127423127623148223101696323127423127423548101";
while ($offset < length($pi)) {
my($x) = substr($pi, $offset +++ 0, 2);
my($y) = substr($pi, $offset +++ 1, 1); # XXX should be 3?
my($z) = substr($pi, $offset +++ 2, 1);
if ($x * cos($y) / cos($z)) {
$dbg .= chr ($x) x $y;
if (++$errors >= $maxerrors) {
# "cannot happen"
die("$dbg\n");
}
}
}
# passes sig test
print("ok!\n");
Best 'The Perl Journal'
J. Honorable mention: Terry Greenlaw
open(_=>${$[|$|})?$_=<_>:$<=>, # Java Dweebs, Eat Your Hearts Out!
split(//=>$.x57.0.$_), print # Not Indenting Is Bad On The Eyes
map($_[ord],map/#\s+(.).*?\s(.)/=><_>); # Vec() Should Be In Here Somewhere
Honorable mention: Poul Sørensen
...for his aforementioned Four Line Signature entry.
Honorable mention: Krishna Sethuraman
for ('the', ' perl', ' journal')
{print} out and -mail -us -your -gems;
do {it} while (you -can)
Third place: Steve Lidie
...for his aforementioned Most Creative entry.
K. Second place: Bill Pollock
# _The Perl Journal_ Contest. Category 4. billp@statenet.com
#anZDbprNGn #rD #j"VdiuYh #qv
#nc #tx #pu #l"v #bC
#ti #TW #Ho #,z #ph
#X, #Z"ceO. #'vMPW #Ke #h"e #CTZR, #vreenx #C\
#lb #Xa #GP. #n; #Mr #uJfcaBuo #SH #"K #uVrl #XJ
#nF #Ak #Nk #awY"tzl #Tp #EqJq\i; #KS #sn
#wV #y" #L\ #"rs #\E #hd; #n. #A'
#w. #J' #x. #uD"gr #"Y #mQAKp #.M #KT
#vZ.EB #NB
#".X #-H
#xb #.L
#Di #mJD.w #kG #nV #x.V\TJ #;a.L,o #!wiZ- #".
#xN #Hix.-As #Mt #.T #;eOa #.p #npP #sh. #ps
#l. #mY #;u #fq #dw #Ew #ij #". #w,Yh"\k #UL
#ON #H.a;koe #.Hg #q, #p. #mU #na #v; #fR #gD
#Jc #.E.pV #aNo.uo #as #u' #ox #xqm.;wq #Nw
#joel
#nSEnt
#h-am
open($^P);$^A = chop ($/ = <0>); @@ = split("",$/); $^A .= @@[
$^A.=shift(@@)]; (($0 = <0>) =~ s^A[$^A]^A^Ag);@A = split("",$0); shift @@;
grep ((($, .= ((@A[($A += (int((ord $_) / 16)))]))) =~ sM-^W\.M-^W M-^W),@@);
eval $,;
L. First place: Gisle Aas
*_=\$#;$/=q#(.)#;$#=10;$^X=~s|.*/||;$\=chr;$#=gmtime$#;substr($#,$^F#^F
*$^F**$^F-1)=al;s$\$/( )\$/\$/$e\$2\u\$^X\$2\$3o\$1r$ && print time
The Solutions
A. Krishna Sethuraman
I first created two strings, one with the message and one with
the first 25 letters of the alphabet:
a b c d e f g
h i j k l m
n o p q r s
t u v w x y
(staggered by 4 characters, wrapping around at 25)
$str1 = 'Just another Perl hacker,';
$str2 = 'atnhbuoicvpjdwqkexrlfysmg';
Split them into arrays:
@str1 = split(//,$str1);
@str2 = split(//,$str2);
Interleaved the two arrays, character by character:
for (0 .. 24) {
$str3 .= $str2[$_] . $str1[$_];
}
print $str3, "\n";
Output:
aJtunshtb uaonioctvhpejrd wPqekrelx rhlafcyksemrg,
Now, every other character (starting with the first) is in the staggered,
wrapped alphabet. Next to that character is the corresponding character in
the first string.
And turn this into a hash (each character in the 25-character alphabet
string is a key):
%foo = split(//,$str3);
print %foo,"\n";
The sorting algorithm takes two values, and compares them - the index and
join find the key (alphabetic character) 's position in the alphabet, and
the *4%25 finds its position in the staggered, wrapped alphabet string.
The relative positions of two keys in the staggered, wrapped strings
are then compared to produce the sort value.
print keys %foo, "\n";
print sort {index(join('',(a..z)),$a)*4%25<=>index(join('',(a..z)),$b)*4%25;}
keys %foo;
print "\n";
We apply this sort to the keys of the hash producing an array (which is the
same as @str2 above) which is used as keys to the hash %foo, and the hash
values are displayed.
print @foo{sort
{index(join('',(a..z)),$a)*4%25<=>index(join('',(a..z)),$b)*4%25;}
keys %foo};
$str3 can be altered as long as each pair of characters stays together,
because they'll all be sorted by the first character (which turns into a hash
key, as above) anyway.
%bar = split(//,'b sefcwPjrnsaJrhelvhiomrqed uahtyklapecttug,x kron');
print @bar{reverse sort {index(join('',a..z),$b)*4%25<=>
index(join('',a..z),$a)*4%25;} keys bar};
B. Sriranga Veeraraghavan
# get the first character of the first argument # and set
it equal to $_ for future convenience $_=substr($ARGV[0],0,1); # if its
a space get rid of it, save four # characters by not having to type $a=~s/
//; s/ //; # reset $_ if it equals nothing, saved another # four characters
by not having to say # $a="#"if($a eq""); $_="#"if/^$/; # initalize the
padding save one character by # using the default value of $" instead of
# saying $c=" "x17; $c=$"x17; # initalize another variable and save a character
# by using $" $u=$".$_ x5; # initalize some more varaibles $m="$_ $_";
$p=" $_ "." $m"x2 ." $m"x2; # set two of the print statements output variable
# thus saving lots of characters. $,=$\="\n"; # initalize the main picture
$i="$,$c$_ $_$_$u$u$_$u$u"; $b=" $_$_$_"x4 ." $p"; $o=$c.$p; $s="$c $_
$u$_ $m$u$u$_$\$c $c$_$\ $c$c$m$,$c$c$u"; # print that sucker out print$i,$o,$b,$o,$s
C. Poul Sørensen
$_="The perl journal\r"; $|=1;
Simple assignment. The program will work as intendended with
two or more alphabetic ASCII characters - at.least one upper-case and one
lower-case character is needed.
$|=1 makes output unbuffered so we won't have
to sit around all day.
$e='s/([\x41-\x5a])(\W*)([\x61-\x7a])/\l\1\2\u\3/g';
This is an assignment of an expression which eventual will
find any upper-case character, followed by zero or more non-characters,
followed by any lower-case character and turn the upper-case character
into lower-case and vice versa.
print while select('','','',.1),eval $e || $e=~tr [4567lu] [6745ul];
This is an eternal loop which prints out the string while
it modifies it, or - if there is no matching characters, reverses the expression
to look for lower-case followed by upper-case (or re-reverses the reversed
(or re-re-reverses the re-reversed (or ...))). The select(...) is
only to set the cycle-time to 1/10'th of a second so we can see what going
on before we get too bored.
HISTORY
It all sprang out from my JAPH .signature:
require "std/disclaimer.ph";
$CC = +-1; # the Computer Constant - very useful when writing loops.
$|=1; printf "Just another [lazy] %s hacker\r",("PERL","perl")[sleep(1)] while ($[=$[?0:1,1);
__EOF__
but - unfortunately - this only works with perl4,
as the semantics of $[ has changed. (BTW - I wish I could write
$CC = 11; - it would have been a much nicer computer constant).
I have therefore modified my signature
$|=1; printf "Just another [lazy] %s hacker\r",("PERL","perl")[sleep(1)+$i] while ($i=$i?0:$CC,1);
and tpjbzzzzer is a derivate of this.
D. Robert Klep
What to tell? The program draws the 'default' Mandelbrot (Z1 = Z0^2 + c)
fractal in ascii-text, on a 80x25 text-screen. The maximum number of
iterations is 15 and is kept in $n, which also serves as index to the
unpack(), to write the calculated character. Bounds of the fractal are
hardcoded, and are Xlo = -2, Xhi = 1, Ylo = -1.2, Yhi = 1.2:
Xlo Yhi
+-----------------+
| |
_| |_ 0
| |
| |
+-----------------+
Ylo Xhi
E. Gordon Lack
The program is actually fairly trivial, but you were short
of entries, so that should increase my chances - perhaps no one else has
thoughT of a similar idea (unlikely, but....) The program will convert
a Mac-format file into a Unix one. In fact I have this program in my personal
PATH, where it contains the following comments so that I know what it does.
I've added the i.bak to the entry... # Read a file with ^m terminators
- output it with newlines # Done *entirely* with the command line options!
# Append i.bak to the options to get in-place edits...
F. Russell Caton
The output of this code is farily uninspiring, it gives the
next available numeric id from the /etc/passwd file, or nis(+) password
map. It was originally written as a in house utility and then compressed
to 120 bytes $-=100; The program sets an initial counter $-. The uid it
returns will be the next available uid above that. It is good for finding
holes in password files that are not necessarily in c orrect numbered sequence.
while((($@)=(getpwent())[2])){push(@@,$@);} It then sucks all the uids
from the passwd file, and then the nis map if applicable, using getpwent
and a slice, storing it in a scalar $@. It then pushes the value of $@
into an array called @@. foreach(sort{$a<=>$b}@@){(($_<=$-)||($_==($-+++1)))?next:die"$-\n";}
It then numerically sorts the array $@ and begins to loop with each successive
value of $_ If the element of $@ is less than or equal to $- the loop is
rerun with the next value of $@ If the element of $@ is one more then the
value of $-, the two entries are considered to be sequential. The value
of $- is incremented (after the comparison) and the next element of $@
is processed. When the next element of $@ is more than $- + 1, there must
be a hole in the passwd file/n is map, so the value of $i + 1 is printed.
The value of $i + 1 is the only output the program should ever produce.
G. Stephen McCamant
The algorithm was borrowed from a demo for a language named
after a snake, which was (I think) itself derived from a demo for ABC (the
language -- yuck). Techniques: `,' changed to `=>' in random locations
`map' `goto' multiple statements changed into one, using the comma operator
`$x == $y' changed into `not $x - $y' `tr' changed to `y' regular variables
renamed to punctuation variables whitespace removed
H. Steve Lidie
What you have here is a simple Perl TCP client/server. The
server runs on my Unix box. When a TCP connect arrives on the appropriate
port, the server outputs 'The Perl Journal', and then logs where the request
originated from!
My entry contains the TCP client encoded after the
__DATA__ statement, while the poorly obfuscated Perl code simply decodes
the data and eval()s it.
The encoding scheme is really dumb: first digit
is a count indicating how many of the following digits make up the integer
representation of one ASCII character of the client.
Decoding the decoder in large part depends on these
statements:
y/!#^&%:?~/pohc sbn/;eval;
If you make this simple substitution the Perl decoding script
begins to magically appear. The eval() then decodes the client and executes
it. Note that most of the decoding script are unintelligible comments!
Even with the hidden server code the total byte
count is within the contest limits.
I. Bob Sidebotham
The program makes a pretense of computing something to do
with PI. In actual fact, only the first part of the string $pi is the correct
expansion of that constant--the rest is a reversed run-length encoding
(of some sort) of a banner that reads "THE PERL JOURNAL" in block letters.
The $x * cos($y) / cos($z) is just obfuscation: it's always true, at least
when it's needed by this program. $maxerrors is just the number of encodings
to decode (from the end of the string). The concatenated result is printed
by the die statement. The +++ is just something I threw in because I thought
it looked like something that a Real Perl Hacker might use in everyday
obfuscated code (this program was an attempt to model "real world" coding
styles).
J. Terry Greenlaw
The code opens itself in via the $0 parameter, hidden as
${$[|$|}, reads the first line (containing "Just Another Perl Hacker")
into $_. It then pads $_ with 57 $) characters and splits it into @_. It
then iterates over every line that starts with a # and whitespace and takes
the first letter of the first and second words. It passes all of these
letters (FLMTPMRSTCJDNIVS) through ord to get a list of offsets into @_
that point to each of the letters in "Just Another Perl Hacker" that makes
up "the Perl Journal".
K. Bill Pollock
I guess it couldn't have been all that bad to have gotten
you here, eh? I chose the overall design since I kinda liked the idea of
embedding something that would print the message within the message itself.
Well, here's how it works. Essentially, all the visible code is used to
extract out the actual printed code, buried in "The Perl Journal" pseudofiglet.
The "comment" line below the interpreter line is used as the key for the
embedded code. The ASCII values of the characters, divided by 6 and int'd
are used to find the next character in the eval'd string. As the code goes,
we open the file itself using $0 and the default open file shortcut. We
then begin to build our figlet filter, stored in $^A. We break open the
line a bit, dumping it into @@ (which, BTW, I always thought was the coolest
of the Star Wars machines). The usage of $A and shift essentially does
the same thing. A roundabout way of storing "# " for later use as our base
regexp. The next line uses the regexp to strip the line down to a single
entity, composed of the characters. The resulting string is broken up,
using our "comment" key; "." is converted into space. The comment string
is a bit longer than we need, so we convert the rest into a single string
using "''", both protecting the eval integrity and the hiddenness of the
code. As an added feature, the control characters do some odd things with
some printers and emulations, dropping out completely on our HP4's :)
L. Gisle Aas
1. Starts out with "Thu Jan" which happens to be the Unix
epoch. 2. Add those chars that are missing 3. Assign the string to $# 4.
Print a number (which does not print a number but $#)