Perl Worst Practices

[Hue-Bond]

My last obfuscation was impressive on first sight, but rather disappointing at the time of breaking it, until the point that I almost posted a followup apologizing for it :^). So I decided to quit doing that lame things and make something I could be proud of. And this is the result, a little program that incorporates some tens of gotchas (to me, at least) that I've found in the documentation. They're not necessarily worst practices, but I thought it would be a nice title. Sometimes titles are more difficult that the things they give name to.

It changes its behaviour from time to time (maybe), although it can be some weeks until it decides to do so. I won't be surprised if it doesn't run on win* or older Perls (5.8 required, although the script doesn't explicitly use it), indeed I had to remove a couple of features to make it work on 5.8.7. A pity. On the bright side, and definitely not a worst practice, it's strict and warnings clean -- there's a warning but it's on purpose ;^).

It's possible that it runs too slowly on your machine; if that happens, you can alter the variable $d at the top of the script. It specifies a wait time, so increasing it will make the program run slower (although it's unlikely you will need this). Setting it to zero will make it run as fast as possible. If it's slow, you could try 15 as a first approach, and see. I forgot to check for the less-than-zero condition, but it doesn't seem to break.

Oh, and it also features a small hidden text that summarizes my overall opinion about the monastery.

Usage:
    -m: use medium-sized font
    -s: use small font (default, and overrides -m so it's pretty useless)
    -t: specify text to show instead of the default (there's another way to do this)

Example: ./pwp.pl -mt '100th post!'

(Hmm, I have a feeling I'm forgetting something...)

Update: It seems to segfault on Debian with Perl 5.8.4. I will investigate it further today. Fixed.

Update 2: Fixed termcap lookup errors.

use warnings; use strict; our $d = 20;
* ,= *EUID;-JAPH=~join'\s*',('(\S+)')x4;use Getopt::Std;getopts('smt:'
+,\ %;);
$^]=v109 if$; {m}and!$;{s} ;%~=$ ^]eq's'?(q AoA,6,q NaN,11):reverse(14
+,q rar,
7,q pop);eval join'',map{$^[=chr qw/26 6 10 7 0/[$_]+0105;$_||($^[x=2)
+;$/ = $
_==3?'use Symbol; ':'';local$ ;=chr qw/6 1 0 5 3/[$_]+77;$ a=$ _==3?';
+${*alt=
*{$q=gensym}} ':'';$ S::I=$_==1?'our$X;our$ s=($X=~$q);':' ';$S::S=(qw
+|qr/$q/
\$s sub{$$q;} \*alt $q|)[$_];"package $^[;${/}sub $; {our\$k=shift ;ou
+r\$q$a=
shift;${S::I}bless $S::S,\$k;}";}0..4;$/=( );our($ORS,%I,$I,%~,$OFS,$R
+S,%a,$~
,$l);sub I;sub v;sub ::{$5}if(open$/,'<',\$RS){while(read$/,$_,$=){$,=
+$_;next
unless ${*${P E R L M O N K S  __ v46}{">|z<|2"^"m?;p=`"}}->();//and($
+I,$ ~)=
$ ^]eq's'?($l,$.):($:,$^);$I{255-$I^0x55}=$ ~;}(*.,*^,*l,*:)=(*",*;,*=
+,*b);$a
{ a}='$~=join"",@ ~';our@RS;sub a{local$_=(caller(fileno$/==0))[3];&u;
+v36.$_}
@RS=sort{sub b{local$/;@; =join' ',$ ^X=>'-e"print\''=>@_,'\';"|';eval
+ for<>}
@~= map{pack"B8",$ _}grep!/^0{3}/&&!/^1/,map{unpack"B*",$ _}split//,de
+fined$;
{t}?$ ;{t}:defined$ a{&::}&&CORE::length($ a{& ::})?$a{& ::}:'';@ ~=sp
+lit//,q
^Z&q>^^<0G\x01V> ^join<  >=> map{y ^1-9^ --^=>s ^[0-9]^chr^e; $ _}spli
+t qr^^,
unpack<b{}4>,chr rand 16if!@~;$l+=ord for@ ~;return$l%2?-1:1}@RS[0177,
+0377]if
* K::X;b a;undef$ I;open$ I,'<'=>\3or die-OPEN1.$!;eval'"BEGIN{use Eng
+lish}"'
;*^]=-+CORE'GLOBAL'undef;$a{a}='sub BEGIN{sub CORE::length{(undef,loca
+l$_)=@_
;index$_,""=>$l*$l}}';{package S;our@l;@l[split//,hex join'','b'..'d']
+=([0,-1
],[1,fileno((bless\($ .=rand )=>--$-),$/)==0],[-1,0],[0,1]);*l=*l=sub{
+splice@
_,6,0=> splice@_,0,1;our@I=(shift,shift);()=return wantarray?():bless{
+mnm=>[@
I],mmn=>$I[1]-1,mww=>0,mmw=>$I[0]-1,mwn=>0,mwm=>shift,mnw=>shift,mmm=>
+[shift,
shift],},shift;sub END{$OFS->Tgoto('cm',0,0,*~);$OFS->Tputs('ve',1,*~)
+;}}}our
@I;b a;our@a;$ ^]=$ _ and((splice@a,($|,1,!!!$ORS)[$a++||$|],$|,0)or m
+ap{$_+=
$^]}@a)or@a=map{sprintf$6,$_/$_,$_,$_,$_,$_*$_}@a for qw/10 55 46 0/;@
+ :=grep
length,split/(??{local($ ,,$^)=((index+($.="."),"",42),substr$_,pos,1)
+;$_ eq$
^and substr$.,0,$,,""and last for@a;substr$.,0,$,,"";})/,'UE.0.ogcnoVe
+sZeXMh'
;*ORS =*|;map{push@ / ,($/[-1]|| 0)-112+ord}split//,'pzw';$ _= * ^]^ 8
+.49.48x
48.48.55;@ ^[=(split//)[@ /];$^[[$ _*2+1]=$ ^[[$_*2]=$^[[$_]for revers
+e 0..2;
splice@I,6+@ I,0,qw/O O 0 0 @/,not do{push@I,(localtime)[8]?@ : :@ ^[}
+=>'@';{
local$/;@/=($~{q LoL} *+CORE->length($~),$ ~{q yay});$,=S->l(@/,ref\$ 
+.,4,-1,
ref\$.);$ ^]=S->l(@/,<$I>=>eval'$ORS ++;2',$/[ref\$.]-1,$/[1]);$a{a}='
+@RS=();
splice@RS,@RS,0=>int rand 2for split/'.'/,$~;';}@/=();our@OFS;$d/=1e3;
+sub END
{for$^[(\@/,\@OFS){select+(),((),()),(),5e-1 if$^[==\@OFS;for($.=our$I
+=ref\$.
;eval'$I++if!$ ^[->[$.]'||$ORS;$. ++){$ ^=$^[==\@/?@I:-1;if(-rand 1==r
+and -1)
{$ .="0+(/SDLF?.2:EFLSE?:<GOSD,22'FHBS/,-#FASD#/4=FAS&9/*SDFL!< /LHA'!
+gUyA3".
"Bf'HAS5#/,HABV'0#81SD";BEGIN{(*b,*I,*;,*^],*RS,*a)=\('&Ut'^'h4:',@{['
+^'^'~']
},'~xyv0]_PR{.LRRjxDDO'^'<=>?~&*#7[z) ?M;%42','s',@{[0..255]},%ENV)}ou
+r$,="s"
."DFH!%83SOFS*(?rOfUI`96dFGASf:'2LDHGf snujfdla&HUFA6(?lBSDJl8 SIF_1 E
+'F^'4".
"sAQFI,a.9SDFJHlN";warn"\n"x$~{q dad}.($ .^$,);BEGIN{sub RS{I sub{$OFS
+->Tputs
('vi',1,* ~)};shift->();}(*,,*.,*EUID,*:)=(5,1,*K::X,4)}BEGIN{*~=$::{"
+{>b<h/"
^"(j&s={"},*u=sub{s/.*:{2}//}}goto+v73}else{$: and do{for($ .-(@I-1)..
+$ .){$^
+=$ ^[==\ @ /?-(1):1;BEGIN{sub CORE::length{return CORE::length(@_)}}d
+o{print
"by Hue-Bond\n"if oct ref${ P E R L M O N K }>< >or/(??{substr$ \,2+po
+s,1})/}
unless$ :!~/n(?{m#(?{$_})#&&sprintf q#\# %02x#,ref\$..q#@ OFS##&&$ sub
+str{42}
})An#"@{[defined$I&&length$I&&(sprintf$I.("6611"^"bg|a")||do{&u(q"$I/x
+;print{
$OFS->Tgoto('cm',$^[->[$_][0]=>$^[->[$_][1],*~),*~}$I[$^ ]if((defined$
+ ^[->[$
_]&&$ _>=ref\ $.)&&($RS[$^[ ->[$_][--$ -]/$ ~{q HoH}]?(not hex substr(
+$ I{ord
substr$~,int($^[->[$_][--$-]/$~{q bob})=>1},2 *$^[-> [$_][1],2)&1 <<$~
+{q mom}
-1-$^[->[$_][--$-]%$ ~{q LoL}):(hex substr($I{ord substr$ ~,int($ ^[->
+[$_][--
$ -]/$~{q pop} )=>1},2*$^[->[$_][1],2) &1 <<$~{q AoA}-1-$^[ ->[$_][--$
+-]%$~{q
HoH})));}select +(),(),((),()),$d;eval '"BEGIN{* CORE::GLOBAL::open=su
+b{\ $_=
q^?n/j_pp!|m5|meF*I,SnpI{^^q ^|!}/eJ7m3/t0W_)Z,B{./`@^^eval}}"';}or do
+{$^[==\
@/and print * ^]^qq' ~,= <\cv\cz\ci-\cab29JJ\cz\c\\cpE\cheeded.\n';las
+t}}last
if$I==@ I-1;}}I:}BEGIN{(*l,*ORS,*^)=(split//,0552);sub I{v sub{$OFS->T
+require
(qw/cl cm/)};shift->();}*ORS=\('%3$*'. * 1{'p$0?'^'>e}z'}.'$.*c')}{pac
+kage S;
our@l;sub I{our$I=$_[our$ S=0];I:our$ww=$I->{mmm}[0]+$l[$I->{mwm}][0];
+our$wn=
$I->{ mmm}[1]+$l[$I->{mwm}][1];$.=((our@I=0..3)=>'');our$l=join' els',
+map{our
($j,@t,$t)=unpack"b2",$_;"if(\$I->{mwm}==@{[('ref\$.',1..$#I)[$_]]}){i
+f(\$w@{
[((qw/w n/)x2)[$_]=>$::I [0],((v62)x2=>(v60)x2)[$_]]}\$I->{'m@{[((v109
+)x2 =>(
v119)x2)[$_],((qw/w n/)x2)[$_]]}'}){return undef\$I->{mmm}if\$S;if(\$I
+->{mnw}
== 4){\$I->{'m@{[(('m')x2=>(v119)x2)[-1+$_]=>((qw/n w/)x2)[$_]]}'}@{[@
+t=split
//,$ j and(0+$ t[0] ^0 +$t[1])?'--':'++'] };\$I->{mwm} = $I[-3+$_]}els
+if(\$ I
-> {mnw }==2){\$I->{'m@{ [(('w')x2=>(v109)x2)[- 1+$_]=>((qw/n w/)x2)[$
+_ ]]}'}
@{[$ t=$ j and(0+substr($t,0,1) ^0+substr($t,1,1))?'++':'--']};\$I->{m
+wm}=$I[
- 2+$ I[-3+$_] ] }else{\$ K::X=int qq'${*_{qq^>|z<|`^^ qq^m?;p=2^}}'}\
+$ S ++;
goto I}}";}@I;defined eval"$l;1"and$I->{mmm}=[$ ww,$wn]or return;!!$ l
+}}BEGIN
{* ,=\('#d4k!k#f '^'s!f\'l$m-s') ;*;=\@ARGV;sub v{local$/=v10;$OFS=Ter
+m'Cap->
Tgetent({"h=l,"^"<x>a" =>${\undef},"k#x}; "^'$p(8~d'=>$ .});shift->();
+}}while
($,-> I&&$ ^]->I){eval'package S';splice@ /,@/, 0,$,->{mmm}||<$I>;spli
+ce@ OFS
,0,fileno$ /== 0=>$^]->{mmm} ||();eval'package main;';}b a;require POS
+IX;$ .=
new POSIX::Termios;$.->getattr;$.=$ .->getospeed;eval"$^";RS sub{$OFS-
+>Tputs(
'cl',1,* ~)};package S;}else{die-OPEN2.$!}BEGIN{$RS=<<"EOF"
0004040404040404040400 004242424242424242423c000000 214 255
0018040404030404041800 003c42422418244242423c000000 215 146
0001010202040808101000 004040404040404040407e000000 133 230
0000000e101010100e0000 000000003a44444438205c423c00 201 205
0010080404040404081000 001010107c10101010120c000000 131 222
000e080808080808080e00 0018244242424242422418000000 241 154
0000000000000004040408 000000003c42023e42423e000000 134 203
00001212121212120c0000 007e404040784040404040000000 255 236
0006080808300808080600 0000000042422418244242000000 209 210
0000140814000000000000 003c424242463a02424438000000 128 147
0000000404000004040408 4040202010101008080404020200 145 246
001c040404040404040000 000000007e04081010207e000000 198 208
00001f0404040404040000 000808001808080808083e000000 254 195
00001f10101e01110e0000 004266665a5a4242424242000000 159 231
00000e04040404040e0000 0018244242427e42424242000000 227 235
0000000e121212160a021c 003c4242424242724a463c040200 205 251
00000012121212160a0000 001824242418324a444c32000000 223 140
000000001f001f00000000 0000000022222a2a2a2a14000000 151 221
00001212121e1212120000 0042426262524a46464242000000 226 228
001010141a121212120000 000e040404040404444438000000 194 224
00001c12121c1010100000 0000000000000000000000007e00 250 245
000a0a0a00000000000000 003c424204080808000808000000 136 149
0000000c020e12160a0000 007f080808080808080808000000 203 254
0010101214181412110000 000000003c42427e40423c000000 193 207
0000001115151f0a0a0000 0204080810101010100808040200 221 130
0000000019260000000000 001c2040405c624242423c000000 212 156
00000e0404040404040438 1e10101010101010101010101e00 224 241
00000e12202022120e0000 000000005c62424242625c404000 237 218
0000000000000000000000 2010080804040404040808102000 213 131
0000111b1b151511110000 3c04040404040404040404043c00 231 247
000000121212120c0c0000 000000003a46424242463a020200 220 219
00000c0c12121e12120000 001414143e14143e141414000000 235 137
00000c12212121120c0603 007c424242427c48444242000000 251 248
00001c222e2a2f201e0000 000000000000000000081c080000 234 132
001010141a1212121c0000 007e02040808102020407e000000 200 240
0000000204080402000000 003c424240300c0242423c000000 150 249
00000e11111111110e0000 003c424240404e4242463a000000 154 237
0000001a15151515150000 0000000000000000000000000000 199 213
0000000000000000003f00 0000000000003e00000000000000 245 135
00001010101010101e0000 3008080808080408080808083000 230 215
0000000808000008080000 000000081c080000081c08000000 144 144
00001c12121c12121c0000 000000005c624240404040000000 232 216
000004040a0a1111000000 1824420000000000000000000000 244 244
000000110a04040a110000 004040405c62424242625c000000 210 200
00000e11010608101f0000 000818280808080808083e000000 152 155
0004001c04040404040438 007e020404080810102020000000 192 157
001c040404040404041c00 0000020408102010080402000000 247 150
0000000000000008080000 000000003c42424242423c000000 132 197
00001e10101c1010100000 000202023a46424242463a000000 236 206
00000000001f0000000000 0000000000000000000000000000 135 138
0000112a14040a15220000 0202040408080810102020404000 143 133
0000040c14040404040000 00324a4c3808101c32524c000000 155 143
0000121a1a161612120000 00000000342a2a2a2a2a22000000 228 199
0000080808080008080000 007e40407c42020242423c000000 139 159
0000001008040810000000 000000082a1c081c2a0800000000 148 128
0000081e08080808060000 00040c14142424447e0404000000 222 158
00081e28281c0a0a3c0800 1008040000000000000000000000 142 202
00000e11110e11110e0000 0022222214140808080808000000 146 243
00000c120c0d12120d0000 0000201008040204081020000000 140 148
0000111515151f0a0a0000 000000003c42404040423c000000 253 201
00000e11010601110e0000 003e08080808080808083e000000 153 227
0000141436143614140000 0000000018180000180808100000 137 145
0000001e020408101e0000 0042424242242424181818000000 208 252
0000060a0a121f02020000 00083c4a4a281c0a4a4a3c080000 158 142
000000141a121212120000 0000000022222214140808000000 196 220
00000e11110f01110e0000 000000005c624242424242000000 147 196
000011110a040404040000 003c42424242424242423c000000 243 229
00001c12121c1412120000 0000000042424242463a02423c00 248 211
0000001212120c0c081010 001808080808080808083e000000 211 198
0000111214181412110000 0008080808080808000808000000 225 139
00000e1101060004040000 20524a0400000000000000000000 149 212
0000000000000000000000 000c1210107c1010101010000000 138 204
0000000e101806021c0000 0000000000000000001808081000 217 134
000012120c0c0c12120000 004040405c624242424242000000 242 194
0804000000000000000000 007e40404078404040407e000000 202 239
00001e02040c08101e0000 003c42420204040810207e000000 240 152
0007081e08080808080000 000000007e00007e000000000000 204 151
0000000c121212120c0000 003c42424040404042423c000000 197 233
0000000c121e10100e0000 0078444242424242424478000000 207 238
0002040808080808040200 002222222222222a2a2a14000000 130 253
00001f0102040408080000 007e0204081c020242423c000000 157 153
00000e12202020100e0000 0000000808083e08080800000000 233 129
0000000b0d080808080000 0078444244784442424478000000 216 232
00001e10101c10101e0000 000000003c42201804423c000000 239 217
0000121212120c0c0c0000 000000004242424242463a000000 252 223
0002020e121212160a0000 0042444850605048444242000000 206 225
00001c12111111121c0000 0002020006020202020222221c00 238 192
0004040400000000000000 1414141400000000000000000000 141 136
0004001c04040404040000 0608080808081008080808080600 195 209
000000141a1212121c1010 0808080808080808080808080800 218 214
00000004041f0404000000 007c424242427c40404040000000 129 250
00000e10100c02021c0000 0042422424181824244242000000 249 242
0010100808040202010100 0808080800000000000000000000 246 141
00000e11101e11110e0000 0040404044485070484442000000 156 193
00000c12212121120c0000 00424242427e4242424242000000 229 226
0000000e121212160a0202 001c224e525252524e201e000000 219 234
EOF
}

[liverpole]

Hi Hue-Bond,

I'm getting the following error and coredump:

liverpole@mynode % perl ./pwp.pl -mt '100th post!'
Subroutine CORE::length redefined at (eval 14) line 1, <> chunk 1.
Use of uninitialized value in length at ./pwp.pl line 30, <> chunk 1.
splice() offset past end of array at ./pwp.pl line 33, <> chunk 1.
Argument "*main::$/" isn't numeric in <HANDLE> at (eval 4385) line 2.
Argument "*main::$/" isn't numeric in <HANDLE> at (eval 4385) line 2, 
+<TERMCAP>
chunk 1.
failed termcap lookup on xterm at ./pwp.pl line 72
Segmentation fault (core dumped)

I am running version 5.8.0 of Perl on RedHat Linux release 9.

[Hue-Bond]

failed termcap lookup on xterm at ./pwp.pl line 72

I think this is the cause for it, although I don't understand how is it possible that the terminal "xterm" isn't defined in the termcap database. Maybe you and wazoox could try running it in a text console, assuming the terminal "linux" won't give trouble!

It also amuses me that the error appears at different lines on each system :)

$ TERM=foobar ./pwp.pl -ta
Subroutine CORE::length redefined at (eval 14) line 1, <> chunk 1.
Can't find a valid termcap file at ./own-11-obfu-11.pl line 76

Update: Oops, some <tt> tags had slipped into the quoted text.

[wazoox]

Doesn't work for me neither (Perl 5.8.8 on slackware current):

Subroutine CORE::length redefined at (eval 14) line 1, <> chunk 1.
failed termcap lookup on xterm at - line 70
Modification of a read-only value attempted at - line 35.
END failed--call queue aborted.
Can't call method "Tgoto" on an undefined value at - line 24.
END failed--call queue aborted.

[Hue-Bond]

McDarren reported a segfault in 5.8.4. It's something strange. This segfaults:

use warnings; use strict;
our $I = "f";
$I = undef; 
open $I, '<', \3 or die "open in mem: $!";
bless \$a, 0;
$I = ref \$a;

But this doesn't:

use warnings; use strict;
our $I = "f";
undef $I;           ## <---
open $I, '<', \3 or die "open in mem: $!";
bless \$a, 0;
$I = ref \$a;

Fixed version follows: I've updated the OP.

[duckyd]

howdy, it fails for me too, on Mac OS X Tiger:

jeff@goo$ perl ./hue-bond.pl 
Subroutine CORE::length redefined at (eval 14) line 1, <> chunk 1.
failed termcap lookup on xterm-color at ./hue-bond.pl line 70
Can't call method "Tgoto" on an undefined value at ./hue-bond.pl line 
+47.
END failed--call queue aborted.
Can't call method "Tgoto" on an undefined value at ./hue-bond.pl line 
+24.
END failed--call queue aborted.
jeff@goo$ perl -v

This is perl, v5.8.6 built for darwin-thread-multi-2level
(with 2 registered patches, see perl -V for more detail)

Copyright 1987-2004, Larry Wall

Perl may be copied only under the terms of either the Artistic License
+ or the
GNU General Public License, which may be found in the Perl 5 source ki
+t.

Complete documentation for Perl, including FAQ lists, should be found 
+on
this system using `man perl' or `perldoc perl'.  If you have access to
+ the
Internet, point your browser at http://www.perl.org/, the Perl Home Pa
+ge.

jeff@goo$

[teamster_jr]

the following errors:

Can't call method "Tgoto" on an undefined value at 556329.pl line 50.
END failed--call queue aborted.
Can't call method "Tgoto" on an undefined value at 556329.pl line 27.
END failed--call queue aborted.

can be fixed by adding:

use Term::Cap;
our $OFS=Tgetent Term::Cap;

to the start of the file.
which makes it sort of work, but i might be missing something....

alex

[Hue-Bond]

Of course the program does Tgetent at the appropriate moment. It's that some systems do weird things when $/ is undef:

use Term::Cap;         
$/=undef;              
my $t=Term::Cap->Tgetent ({TERM=>undef, OSPEED=>38400});
__END__
failed termcap lookup on xterm at - line 3

So I had to stick a local $/ = "\n" there as a quick fix.

[alpha]

Damn thing is not even Deparse'able :/

...
While deparsing obf1.pl near line 39,
Unexpected our($,)
CHECK failed--call queue aborted.

[Hue-Bond]

Damn thing is not even Deparse'able

Yes. That's a feature!

[Anonymous Monk]

use warnings;
use strict 'refs';
(our $d = 20);
(*, = *EUID);
((-'JAPH') =~ join('\\s*', (('(\\S+)') x 4)));
use Getopt::Std;
getopts('smt:', (\%;));
(($;{'m'} and (not $;{'s'})) and ($^] = v109));
((%~) = (($^] eq 's') ? ('o', 6, 'a', 11) : reverse(14, 'a', 7, 'o')))
+;
eval(join('', map({($^[ = chr(((('26', '6', '10', '7', '0'))[$_] + 69)
+));
($_ or ($^[ x= 2));
($/ = (($_ == 3) ? 'use Symbol; ' : ''));
(local $; = chr(((('6', '1', '0', '5', '3'))[$_] + 77)));
($a = (($_ == 3) ? ";\${*alt=\n*{\$q=gensym}} " : ''));
($S::I = (($_ == 1) ? 'our$X;our$ s=($X=~$q);' : ' '));
($S::S = (('qr/$q/', '\\$s', 'sub{$$q;}', '\\*alt', '$q'))[$_]);
"package $^[;$/sub $; {our\$k=shift ;our\$q$a=\nshift;$S::Ibless $S::S
+,\$k;}";} (0..4))));
($/ = ());
our($ORS, %I, $I, %~, $OFS, $RS, %a, $~, $l);
if (open($/, '<', (\$RS))) {
    while (read($/, $_, $=)) {
        ($, = $_);
        (&${*${'E'->P('L'->R('O'->M('K'->N('__'->S(v46)))));}{'SCALAR'
+};}() or next);
        (// and (($I, $~) = (($^] eq 's') ? ($l, $.) : ($:, $^))));
        ($I{(255 - $I) ^ 85} = $~);
    }
    ((*., *^, *l, *:) = (*", *;, *=, *b));
    ($a{'a'} = '$~=join"",@ ~');
    our(@RS);
    sub a {
        (local $_ = (caller((fileno($/) == 0)))[3]);
        &u;
        (v36 . $_);
    }
    sub b {
        local $/;
        (@; = join(' ', $^X, q[-e"print'], @_, q[';"|]));
        eval($_) foreach (<ARGV>);
    }
    (*K::X and (@RS = (sort {(@~ = map({pack('B8', $_);} grep(((!/^0{3
+}/) && (!/^1/)), map({unpack('B*', $_);} split(//, (defined($;{'t'}) 
+? $;{'t'} : ((defined($a{&main::}) && length($a{&main::})) ? $a{&main
+::} : '')), 0)))));
    use File::Glob ();
    ((not @~) and (@~ = split(//, (('Z&q>' ^ glob("0G\cAV")) ^ join(gl
+ob('  '), map({(tr/1-9/ -(/, s/[0-9]/chr($_);/e);
    $_;} split(qr//, unpack(glob('b{}4'), chr(rand(16))), 0)))), 0)));
    ($l += ord($_)) foreach (@~);
    return((($l % 2) ? (-1) : 1));} @RS[127, 255])));
    b(a());
    undef($I);
    (open($I, '<', (\3)) or die(((-'OPEN1') . $!)));
    eval('"BEGIN{use English}"');
    (*^] = (-'CORE::GLOBAL::undef'));
    ($a{'a'} = qq[sub BEGIN{sub CORE::length{(undef,local\$_)=\@_\n;in
+dex\$_,""=>\$l*\$l}}]);
    {
        package S;
        our(@l);
        (@l[split(//, hex(join('', ('b', 'c', 'd'))), 0)] = ([0, (-1)]
+, [1, (fileno((bless((\($. = rand)), (--$-)), $/)) == 0)], [(-1), 0],
+ [0, 1]));
        sub END {
            $main::OFS->Tgoto('cm', 0, 0, *~);
            $main::OFS->Tputs('ve', 1, *~);
        }
        (*l = (*l = sub {
            splice(@_, 6, 0, splice(@_, 0, 1));
            (our(@I) = (shift(@_), shift(@_)));
            (() = return((wantarray ? () : bless({'mnm', [@I], 'mmn', 
+($I[1] - 1), 'mww', 0, 'mmw', ($I[0] - 1), 'mwn', 0, 'mwm', shift(@_)
+, 'mnw', shift(@_), 'mmm', [shift(@_), shift(@_)]}, shift(@_)))));
        }
        ));
    }
    our(@I);
    b(a());
    our(@a);
    ((($^] = $_) and (splice(@a, (($|, 1, (!(!(!$ORS)))))[(($a++) or $
+|)], $|, 0) || map({($_ += $^]);} @a))) or (@a = map({sprintf($6, ($_
+ / $_), $_, $_, $_, ($_ * $_));} @a))) foreach (('10', '55', '46', '0
+'));
    (@: = grep(length($_), split(/(??{local(\$ ,,\$^)=((index+(\$.="."
+),"",42),substr\$_,pos,1);\$_ eq\$\n^and substr\$.,0,\$,,""and last f
+or\@a;substr\$.,0,\$,,"";})/, 'UE.0.ogcnoVesZeXMh', 0)));
    (*ORS = *|);
    map({push(@/, ((($/[-1] || 0) - 112) + ord($_)));} split(//, 'pzw'
+, 0));
    ($_ = (*^] ^ (8.49.48 x 48.48.55)));
    (@^[ = (split(//, $_, 0))[@/]);
    ($^[[($_ * 2) + 1] = ($^[[$_ * 2] = $^[[$_])) foreach (reverse((0.
+.2)));
    splice(@I, (6 + @I), 0, ('O', 'O', '0', '0', '@'), (!(do {
        push(@I, ((localtime)[8] ? @: : @^[))
    }, '@')));
    {
        local $/;
        (@/ = (($~{'o'} * 'CORE'->length($~)), $~{'a'}));
        ($, = 'S'->l(@/, ref((\$.)), 4, (-1), ref((\$.))));
        ($^] = 'S'->l(@/, <$I>, eval('$ORS ++;2'), ($/[ref((\$.))] - 1
+), $/[1]));
        ($a{'a'} = "\@RS=();\nsplice\@RS,\@RS,0=>int rand 2for split//
+,\$~;");
    }
    (@/ = ());
    our(@OFS);
    ($d /= 1000);
    sub END {
        foreach $^[ (((\@/), (\@OFS))) {
            (($^[ == (\@OFS)) and select((), ((), ()), (), 0.5));
            sub BEGIN {
                ((*b, *I, *;, *^], *RS, *a) = (\('NaN', @{[' '];}, q[B
+EGIN{use Term'Cap}], 's', @{[(0..255)];}, %ENV)));
            }
            sub BEGIN {
                sub RS {
                    I(sub {
                        $OFS->Tputs('vi', 1, *~);
                    }
                    );
                    shift(@_)->();
                }
                ((*,, *., *EUID, *:) = (5, 1, *K::X, 4));
            }
            sub BEGIN {
                ((*~ = $main::{'STDOUT'}), (*u = sub {
                    s/.*:{2}//;
                }
                ));
            }
            sub BEGIN {
                sub CORE::length {
                    return(length(@_));
                }
                
            }
            for (($. = (our $I = ref((\$.)))); (eval('$I++if!$ ^[->[$.
+]') or $ORS); (++$.)) {
                ($^ = (($^[ == (\@/)) ? @I : (-1)));
                if (((-rand(1)) == rand((-1)))) {
                    ($. = q[0+(/SDLF?.2:EFLSE?:<GOSD,22'FHBS/,-#FASD#/
+4=FAS&9/*SDFL!< /LHA'!gUyA3Bf'HAS5#/,HABV'0#81SD]);
                    (our $, = q[sDFH!%83SOFS*(?rOfUI`96dFGASf:'2LDHGf 
+snujfdla&HUFA6(?lBSDJl8 SIF_1 E'F^'4sAQFI,a.9SDFJHlN]);
                    warn((("\n" x $~{'a'}) . ($. ^ $,)));
                    goto I;
                }
                else {
                    unless (($: and do {
                        foreach $_ (($. - (@I - 1)) .. $.) {
                            ($^ += (($^[ == (\@/)) ? (-1) : 1));
                            unless ((not ($: =~ /n(?{m#(?{$_})#&&sprin
+tf q#\# %02x#,ref\$..q#@ OFS##&&$ substr{42}
})An#"@{[defined$I&&length$I&&(sprintf$I.("6611"^"bg|a")||do{&u(q"$I/x
+))) {
                                do {
                                    (((oct(ref(${'E'->P('L'->R('O'->M(
+'K'->N)));})) > glob(' ')) || /(??{substr\$ \,2+pos,1})/) and print("
+by Hue-Bond\n"));
                                };
                            }
                            (((defined($$^[[$_]) and ($_ >= ref((\$.))
+)) and ($RS[$$^[[$_][(--$-)] / $~{'o'}] ? (!(hex(substr($I{ord(substr
+($~, int(($$^[[$_][(--$-)] / $~{'o'})), 1))}, (2 * $$^[[$_][1]), 2)) 
+& (1 << (($~{'o'} - 1) - ($$^[[$_][(--$-)] % $~{'o'}))))) : (hex(subs
+tr($I{ord(substr($~, int(($$^[[$_][(--$-)] / $~{'o'})), 1))}, (2 * $$
+^[[$_][1]), 2)) & (1 << (($~{'o'} - 1) - ($$^[[$_][(--$-)] % $~{'o'})
+))))) and print({($OFS->Tgoto('cm', $$^[[$_][0], $$^[[$_][1], *~), *~
+);} $I[$^]));
                        }
                        select((), (), ((), ()), $d);
                        eval(qq["BEGIN{* CORE::GLOBAL::open=sub{\\ \$_
+=\nq^?n/j_pp!|m5|meF*I,SnpI{^^q ^|!}/eJ7m3/t0W_)Z,B{./`\@^^eval}}"])
                    })) {
                        do {
                            (($^[ == (\@/)) and print((*^] ^ " ~,= <\c
+V\cZ\t-\cAb29JJ\cZ\034\cPE\cHeeded.\n")));
                            last;
                        };
                    }
                }
                (($I == (@I - 1)) and last);
            }
        }
        I: ;
    }
    sub BEGIN {
        ((*l, *ORS, *^) = split(//, 362, 0));
        sub I {
            v(sub {
                $OFS->Trequire('cl', 'cm');
            }
            );
            shift(@_)->();
        }
        (*ORS = (\(('%3$*' . *1{'NAME'}) . '$.*c')));
    }
    {
        package S;
        our(@l);
        sub I {
            (our $I = $_[our $S = 0]);
            I: (our $ww = ($$I{'mmm'}[0] + $l[$$I{'mwm'}][0]));
            (our $wn = ($$I{'mmm'}[1] + $l[$$I{'mwm'}][1]));
            ($. = ((our(@I) = (0..3)), ''));
            (our $l = join(' els', map({(our($j, @t, $t) = unpack('b2'
+, $_));
            "if(\$I->{mwm}==@{[(('ref\\$.', (1 .. $#I)))[$_]];}){if(\$
+w@{[((('w', 'n') x 2))[$_], $main::I[0], ((((v62) x 2), ((v60) x 2)))
+[$_]];}\$I->{'m@{[((((v109) x 2), ((v119) x 2)))[$_], ((('w', 'n') x 
+2))[$_]];}'}){return undef\$I->{mmm}if\$S;if(\$I->{mnw}\n== 4){\$I->{
+'m@{[(((('m') x 2), ((v119) x 2)))[((-1) + $_)], ((('n', 'w') x 2))[$
+_]];}'}@{[((@t = split(??, $j, 0)) && (((0 + $t[0]) ^ (0 + $t[1])) ? 
+'--' : '++'))];};\$I->{mwm} = $I[(-3) + $_]}elsif(\$ I\n-> {mnw }==2)
+{\$I->{'m@{[(((('w') x 2), ((v109) x 2)))[((-1) + $_)], ((('n', 'w') 
+x 2))[$_]];}'}\n@{[(($t = $j) && (((0 + substr($t, 0, 1)) ^ (0 + subs
+tr($t, 1, 1))) ? '++' : '--'))];};\$I->{mwm}=$I[(-2) + $I[(-3) + $_]]
+ }else{\$ K::X=int qq'${*_{'SCALAR'};}'}\$ S ++;\ngoto I}}";} @I)));
            ((defined(eval("$l;1")) and ($$I{'mmm'} = [$ww, $wn])) or 
+return);
            (not (not $l));
        }
        ;
    }
    sub BEGIN {
        (*, = (\'PERLMONKS'));
        (*; = (\@ARGV));
    }
    sub v {
        (local $/ = v10);
        ($OFS = 'Term::Cap'->Tgetent({'TERM', ${(\undef);}, 'OSPEED', 
+$.}));
        shift(@_)->();
    }
    while (($,->I and $^]->I)) {
        eval('package S');
        splice(@/, @/, 0, ($$,{'mmm'} || <$I>));
        splice(@OFS, 0, (fileno($/) == 0), ($$^]{'mmm'} || ()));
        eval('package main;');
    }
    b(a());
    require POSIX;
    ($. = 'POSIX::Termios'->new);
    $.->getattr;
    ($. = $.->getospeed);
    eval("$^");
    RS(sub {
        $OFS->Tputs('cl', 1, *~);
    }
    );
}
else {
    die(((-'OPEN2') . $!));
}
sub BEGIN {
    use warnings;
    use strict 'refs';
    ($RS = "0004040404040404040400 004242424242424242423c000000 214 25
+5\n0018040404030404041800 003c42422418244242423c000000 215 146\n00010
+10202040808101000 004040404040404040407e000000 133 230\n0000000e10101
+0100e0000 000000003a44444438205c423c00 201 205\n001008040404040408100
+0 001010107c10101010120c000000 131 222\n000e080808080808080e00 001824
+4242424242422418000000 241 154\n0000000000000004040408 000000003c4202
+3e42423e000000 134 203\n00001212121212120c0000 007e404040784040404040
+000000 255 236\n0006080808300808080600 0000000042422418244242000000 2
+09 210\n0000140814000000000000 003c424242463a02424438000000 128 147\n
+0000000404000004040408 4040202010101008080404020200 145 246\n001c0404
+04040404040000 000000007e04081010207e000000 198 208\n00001f0404040404
+040000 000808001808080808083e000000 254 195\n00001f10101e01110e0000 0
+04266665a5a4242424242000000 159 231\n00000e04040404040e0000 001824424
+2427e42424242000000 227 235\n0000000e121212160a021c 003c4242424242724
+a463c040200 205 251\n00000012121212160a0000 001824242418324a444c32000
+000 223 140\n000000001f001f00000000 0000000022222a2a2a2a14000000 151 
+221\n00001212121e1212120000 0042426262524a46464242000000 226 228\n001
+010141a121212120000 000e040404040404444438000000 194 224\n00001c12121
+c1010100000 0000000000000000000000007e00 250 245\n000a0a0a00000000000
+000 003c424204080808000808000000 136 149\n0000000c020e12160a0000 007f
+080808080808080808000000 203 254\n0010101214181412110000 000000003c42
+427e40423c000000 193 207\n0000001115151f0a0a0000 02040808101010101008
+08040200 221 130\n0000000019260000000000 001c2040405c624242423c000000
+ 212 156\n00000e0404040404040438 1e10101010101010101010101e00 224 241
+\n00000e12202022120e0000 000000005c62424242625c404000 237 218\n000000
+0000000000000000 2010080804040404040808102000 213 131\n0000111b1b1515
[phone]c04040404040404040404043c00 231 247\n000000121212120c0c0000
+ 000000003a46424242463a020200 220 219\n00000c0c12121e12120000 0014141
+43e14143e141414000000 235 137\n00000c12212121120c0603 007c424242427c4
[phone] 251 248\n00001c222e2a2f201e0000 000000000000000000081c0
[phone]\n001010141a1212121c0000 007e02040808102020407e000000 20
+0 240\n0000000204080402000000 003c424240300c0242423c000000 150 249\n0
+0000e11111111110e0000 003c424240404e4242463a000000 154 237\n0000001a1
[phone] 0000000000000000000000000000 199 213\n00000000000000000
+03f00 0000000000003e00000000000000 245 135\n00001010101010101e0000 30
+08080808080408080808083000 230 215\n0000000808000008080000 000000081c
+080000081c08000000 144 144\n00001c12121c12121c0000 000000005c62424040
[phone] 216\n000004040a0a1111000000 18244200000000000000000000
+00 244 244\n000000110a04040a110000 004040405c62424242625c000000 210 2
+00\n00000e11010608101f0000 000818280808080808083e000000 152 155\n0004
+001c04040404040438 007e020404080810102020000000 192 157\n001c04040404
+0404041c00 0000020408102010080402000000 247 150\n00000000000000080800
+00 000000003c42424242423c000000 132 197\n00001e10101c1010100000 00020
+2023a46424242463a000000 236 206\n00000000001f0000000000 0000000000000
+000000000000000 135 138\n0000112a14040a15220000 020204040808081010202
+0404000 143 133\n0000040c14040404040000 00324a4c3808101c32524c000000 
+155 143\n0000121a1a161612120000 00000000342a2a2a2a2a22000000 228 199\
+n0000080808080008080000 007e40407c42020242423c000000 139 159\n0000001
+008040810000000 000000082a1c081c2a0800000000 148 128\n0000081e0808080
[phone]c14142424447e0404000000 222 158\n00081e28281c0a0a3c0800 
+1008040000000000000000000000 142 202\n00000e11110e11110e0000 00222222
+14140808080808000000 146 243\n00000c120c0d12120d0000 0000201008040204
+081020000000 140 148\n0000111515151f0a0a0000 000000003c42404040423c00
+0000 253 201\n00000e11010601110e0000 003e08080808080808083e000000 153
+ 227\n0000141436143614140000 0000000018180000180808100000 137 145\n00
+00001e020408101e0000 0042424242242424181818000000 208 252\n0000060a0a
+121f02020000 00083c4a4a281c0a4a4a3c080000 158 142\n000000141a12121212
+0000 0000000022222214140808000000 196 220\n00000e11110f01110e0000 000
+000005c624242424242000000 147 196\n000011110a040404040000 003c4242424
[phone]c000000 243 229\n00001c12121c1412120000 0000000042424242463
+a02423c00 248 211\n0000001212120c0c081010 001808080808080808083e00000
+0 211 198\n0000111214181412110000 0008080808080808000808000000 225 13
+9\n00000e1101060004040000 20524a0400000000000000000000 149 212\n00000
+00000000000000000 000c1210107c1010101010000000 138 204\n0000000e10180
+6021c0000 0000000000000000001808081000 217 134\n000012120c0c0c1212000
+0 004040405c624242424242000000 242 194\n0804000000000000000000 007e40
[phone]e000000 202 239\n00001e02040c08101e0000 003c4242020404
+0810207e000000 240 152\n0007081e08080808080000 000000007e00007e000000
+000000 204 151\n0000000c121212120c0000 003c42424040404042423c000000 1
+97 233\n0000000c121e10100e0000 0078444242424242424478000000 207 238\n
+0002040808080808040200 002222222222222a2a2a14000000 130 253\n00001f01
+02040408080000 007e0204081c020242423c000000 157 153\n00000e1220202010
+0e0000 0000000808083e08080800000000 233 129\n0000000b0d080808080000 0
+078444244784442424478000000 216 232\n00001e10101c10101e0000 000000003
+c42201804423c000000 239 217\n0000121212120c0c0c0000 00000000424242424
+2463a000000 252 223\n0002020e121212160a0000 0042444850605048444242000
+000 206 225\n00001c12111111121c0000 0002020006020202020222221c00 238 
+192\n0004040400000000000000 1414141400000000000000000000 141 136\n000
+4001c04040404040000 0608080808081008080808080600 195 209\n000000141a1
+212121c1010 0808080808080808080808080800 218 214\n00000004041f0404000
+000 007c424242427c40404040000000 129 250\n00000e10100c02021c0000 0042
+422424181824244242000000 249 242\n0010100808040202010100 080808080000
+0000000000000000 246 141\n00000e11101e11110e0000 00404040444850704844
[phone]\n00000c12212121120c0000 00424242427e4242424242000000
+ 229 226\n0000000e121212160a0202 001c224e525252524e201e000000 219 234
+\n");
}

After some work with Deparse.pm ..... Bwahahaha ]:)