I had quite a bit of fun tearing this apart. I truly hope that I have successfully de-obfuscated it. I have to admit that it took longer than I initially thought that it would.
#!/usr/bin/perl -w
use strict;
sub p {
# I've replaced the literal newlines with \012 so that it will fit o
+n one line
$_ = "\c];\a\012 \3SE\$\5!.\f)\012 Ut4)\aHI#\5\f%)\01
+2 ";
# Delete all spaces and newlines.
tr/ \n//d;
# The g & m modifiers mean global & multi-line.
# This regex matches against $_ (the default).
# Match any character 1 or more times but minimally (non-greedy), fo
+llowed by a
# zero-width positive look-ahead assertion for a digit or an end of
+line.
# This stores two strings in @_. There is a 4 in $_ so $_[0] will c
+ontain the
# string up to but not including the 4 and the rest of the string wi
+ll go into
# $_[1] (as there are no newlines in $_, the end of the string match
+es $).
@_ = /.+?(?=\d|$)/gm;
# Set $FORMAT_LINES_PER_PAGE ($=) to 0 (same as the default value of
+ $|).
$= = $|;
# Transliterate all characters from " to / into \f through space.
# That is chr(34) - chr(47) and chr(12) - chr(32).
tr,"-/,\f- ,;
# Set $SUBSCRIPT_SEPARATOR ($;) to $_
$; = $_;
# y{;E!\a4.;@\012 \0-z} ^</*:>\012 nb^d;
# Wowza! Where to begin?
# The d modifier means delete found but unreplaced characters
# I start by remove the newlines (\012) and equal number of spaces f
+rom both sides.
# If multiple transliterations are given for a character, only the f
+irst one is used.
# So that leaves this, which changes ; to <, E to /, ! to *, \a to :
+, 4 to > and deletes the rest,
# leaving '</*:>:' in $_
tr{;E!\a4.@\0-z}{</*:> nb}d;
# map { s/\W # //xg; } @_;
# The x modifier allows whitespace and comments in the regex.
# This removes all non-"word" characters from @_
map { s/\W//g; } @_;
# Add the characters produced to @_
@_= map { chr(
# ($= = @{[/ ./gx ]})
# Set $FORMAT_LINES_PER_PAGE to the size of the anon array of matc
+hes.
($= = @{[/./g]})
? # If there are matches, then true else false.
# If true, do the math, return only $-
( $- = ++$= ** 3, $% += $-,)[0]
: # If false, divide $% by 2.
# This occurs for the third value passed into map (namely a null
+ string).
$% / 2
)}@_,q++; # Pass map (@_,'');
# First pass, $= is 5, $- is 125, $% is 125 and 125 is passed to chr
# Second pass, $= is 4, $- is 64, $% is 189 and 64 is passed to chr
# Third pass, $= is 0, $% is 189 and 94.5 is passed to chr
# @_ is now qw( } @ ^ )
map {
# s[(.) ]~@_=map{$_^$',$_^$+}@_~ex;
# The e modifier means evaluate the right side of the expression.
s!(.)! # match and capture one character
# $+ is $LAST_PAREN_MATCH (first character of $_)
# $' is $POSTMATCH (second character of $_)
# Process each element in @_
# Pass the results of the bitwise XORs back into @_
@_ = map { $_ ^ $', $_ ^ $+;} @_
!e; # End of s///
}/../g;
# globally match for two characters
# First pass, $_ is '<:', ends with @_ containing
# qw(G A z | d b)
# Second pass, $_ is '/*', ends with @_ containing
# qw(m h k n P U V S N K H M)
# Third pass, $_ is '>:', ends with @_ containing
# qw(W S R V Q U T P j n o k l h i m t p q u r v w s)
# ${;}=~s{.}%map{$_^= ${&}}@_;$\.=shift();%ges;
# The ges modifiers mean global, evaluate, treat as single line.
$; =~ s!.!
# Process $SUBSCRIPT_SEPARATOR, match each character.
map {
$_ ^= $&
# Bitwise XOR each element of @_ with the last successful match.
} @_;
$\ .= shift();
# Append first element of @_ to $\, this is also the value that the
+matched character becomes.
!ges; # End of s///
# At this point $; is a big string containing
# 'JJuJusJustJust Just aJust anJu...Just another Perl hackeJust anothe
+r Perl hacker'
# $POSTMATCH will be set to ''
# $OUTPUT_RECORD_SEPARATOR ($\) will be set to 'Just another Perl hack
+er'
$\ .= $/;
# Append a newline (default value of $INPUT_RECORD_SEPARATOR ($/)) to
+$\
print $';
# Print the null in $' followed by "Just another Perl hacker\n" that i
+s in $\
}
p # Start the fun!