This started as a test script while I was learning about bit operations, and it slowly evolved into an obfuscated JAPH. I know it exceeds the traditional "4 line rule", but I thought that it would be fun to limit the digits used to only 0 and 1, given the theme. It was not golfed in any way.

Enjoy!

```
\$_=[[[[{},[]],{0111,'01110111',1000,'11100101'},[[]]],{0001,'01111110'
,0110,'00011010',0100,'011001000011111001111010',0010,'00000100',0011,
'01010101000100000001111110100010101000000000101000110000010001001010'
.'10100',0101,'011100001001010100000001'},[[]]]];%_=%{\${\${\$_}}};
\$s=eval{\$O=0,\$C=0,\$t='This is my 100th PM post';sub{\$O++,\$C=@_?\$C:eval
pack('b*',vec(pack('b*',\$_{1<<(1<<0<<1)*((1<<0+1<<0)+1<<0)}),\$O-1,1<<0
)?\$_{1<<0}:\$_{1<<(1<<1<<1)-1}).\$C.pack('c',vec(pack('b*',\$_{1<<((1<<0)
+(1<<1*1<<1)+1<<0)}),(\$O-1)%((1<<0*1<<1)+1<<0),1<<(1<<0+1<<0)+1)).pack
('b*',vec(pack('b*',\$_{1<<((1<<0+1<<0)+(1<<1<<1))}),\$O-1,1)?\$_{1<<((1+
1<<0)+1)}:\$_{1<<0}).vec(\$t,\$O-1,1<<(1<<1<<1)-(1<<0))};};;\$o=pack('b*',
\$_{((1<<1)**(1<<1)-1)**(1<<1)});for(0..unpack('%b*',\$o)-(1<<1)){\$c=\$_-
((\$_-\$_%(1<<1<<1))/(1<<1<<0*1<<1)+(\$_%(1<<1+1<<0)?1:0));;\$i=(vec(\$o,\$c
,(1<<1<<0+1<<0))+(vec(\$o,\$c+1,(1<<1<<1))<<(1<<1<<0+1))>>((1<<1<<1<<1>>
1)-\$_%(1<<1<<1<<1>>1)-(1<<1<<0+1)*(\$_%(1<<1<<1>>1<<1)?0:1)));\$i+=\$i%(1
<<1)?-1:1 if(((\$_+1)%((1<<1+1<<1)+(1<<1)+(1<<1)))&&!((\$_+1)%((1<<1)**(
1<<1)-1))||\$_+1==(1<<(1<<1+1<<1>>1))+(((1<<1)+1)<<1));\$T=vec(pack('C',
\$i),0,(1<<1<<1>>1<<1))+vec(pack('b*',\$_{(1+((1<<1)**(1<<1))**((1<<1)**
(1<<1)-1))}),\$_,1)*(1<<(1<<(1<<1)))+(1<<((1<<1**1<<1)+1));;print pack(
'c',(\$T+=\$T==(1<<((1<<1+1<<1>>1)+1))?0:(1<<(((1<<1+1<<1)>>1)+(1<<0*1<<
1))))-=\$_%(1+(((1<<1+1<<1)>>1)+(1<<0*1<<1)<<1))==0?(1<<(((1<<1*1<<1<<1
)+(1<<1<<1>>1))>>1)):0);&\$s}print pack('c',\$s->(1<<0)^unpack('c',(pack
('b*',\$_{(1<<1*1<<1*1<<1)*((1<<1)**(1<<0<<1)-1)**(1<<1<<1>>1<<0)}))));

Hint: the bit shifts are fun, but they aren't the main point of the obfuscation.

Tested on

• perl 5.005_03 built for i386-linux (little endian)
• perl 5.6.0 built for sun4-solaris (big endian)
• perl 5.6.1 built for MSWin32-x86-multi-thread (little endian)
• perl 5.8.0 built for i386-linux-thread-multi (little endian)
• perl 5.8.3 built for i686-linux (little endian)
• perl 5.8.4 built for i386-linux-thread-multi (little endian)

Replies are listed 'Best First'.
Re: Bits & pieces
by jdalbec (Deacon) on Jul 16, 2005 at 03:18 UTC
B::Deparse gets rid of the bit shifts, but it breaks the code by omitting the parentheses after not below. After reinstating the parentheses and running the code through Perl::Tidy it's still not very readable. I've inserted some comments inside and outside the code to keep track of what's going on. Comments generally refer to the statements preceding them.
```\$_ = [
[
[ [ {}, [] ], { 73, '01110111', 1000, '11100101' }, [ [] ] ],
{
1,
'01111110',
72,
'00011010',
64,
'011001000011111001111010',
8,
'00000100',
9,
'010101010001000000011111101000101010000000001010001100000100010010101
+0100',
65,
'011100001001010100000001'
},
[ [] ]
]
];
(%_) = %{ \${ \${ \$_; }; }; };
Most of the structure of \$_ is obfuscation. Let's start over with %_ since \$_ is never used again except for the localized \$_ in the for loop.
```undef \$_;
%_ = (
1 => '01111110', # '~'
72 => '00011010', # 'X'
64 => '011001000011111001111010', # '&|^'
#                  012345678901234567890123
8 => '00000100', # ' '
9 =>
'010101010001000000011111101000101010000000001010001100000100010010101
+0100',
#012345678901234567890123456789012345678901234567890123456789012345678
+9012
#          1         2         3         4         5         6
+ 7
65 => '011100001001010100000001'
#                  012345678901234567890123
);
Some of these (little-endian) bitstrings are really bytestrings and I've commented them as such. I've also added column numbers below some of the strings.
```\$s = eval {
do {
\$O = 0, \$C = 0, \$t = 'This is my 100th PM post';
#                             012345678901234567890123
sub {
\$O++, \$C = @_ ? \$C : eval
# { do { my \$k =
pack( 'b*',
vec( pack( 'b*', \$_{64} ), \$O - 1, 1 ) ? \$_{1} : \$_{8}
+ )
. \$C
. pack( 'c', vec( pack( 'b*', \$_{64} ), ( \$O - 1 ) % 3,
+8 ) )
. pack( 'b*',
vec( pack( 'b*', \$_{64} ), \$O - 1, 1 ) ? \$_{8} : \$_{1}
+ )
. vec( \$t, \$O - 1, 8 );
# print " \$k"; eval \$k; } }
}

}
};
This subroutine is essentially pure obfuscation. It does some fairly random calculations using the characters of \$t and a fudge factor is added at the end to produce the desired output.
```\$o = pack( 'b*', \$_{9} );
foreach \$_ ( 0 .. unpack( '%b*', \$o ) - 2 ) {
# 16 bit checksum = 25, - 2 = 23
Now we come to the heart of it. It's rather convenient that a 16-bit checksum of \$o comes out so close to the length.
```    \$c = \$_ - ( ( \$_ - \$_ % 4 ) / 4 + ( \$_ % 4 ? 1 : 0 ) );
# print \$c;
# 0 0 1 2 3 3 4 5 6 6 7 8 9 9 10 11 12 12 13 14 15 15 16 17
\$i =
vec( \$o, \$c, 4 ) + ( vec( \$o, \$c + 1, 4 ) << 4 ) >> 4 - \$_ % 4 -
+ 4 *
( \$_ % 4 ? 0 : 1 );
# >> 0 3 2 1 0 3 2 1 0 3 2 1 0 3 2 1 0 3 2 1 0 3 2 1
# print \$i;
# 170 21 34 4 128 16 62 47 69 8 21 2 0 0 20 98 12 1 8 17 82 10 21 2
# print \$i % 16; # == vec( pack( 'C', \$i ), 0, 4 )
# 10 5  2  4  0  0  14 15 5  8  5  2  0  0  4  2  12 1  8  1  2  10 5
+ 2
# 0101  0100  0000  0111  1010  1010  0000  0010  0011  0001  0100  10
+10

#    1010  0010  0000  1111  0001  0100  0000  0100  1000  1000  0101
+ 0100
# J  u  r  t        n  o  u  h  e  r     P  d  r  l  a  h  a  b  j  e
+ r
#       *        *        *                 *        *        *  *
Heavy comments here. These two statements extract the low nybbles of the JAPH phrase from \$o. The trick is that the nybbles are offset by only 3 bits so the 8's bit of each character is the 1's bit of the next character. Naturally, not all the 1's bits are correct, but surprisingly many are. Also, some of the higher-order bits in \$i are set, but they get stripped off later.
```    \$i += \$i % 2 ? -1 : 1 # \$i ^= 1
if ( \$_ + 1 ) % 12 and not(( \$_ + 1 ) % 3)
or \$_ + 1 == 22;
# print \$i;
# 170 21 35 4 128 17 62 47 68 8 21 2 0 0 21 98 12 0 8 17 83 11 21 2
# print \$i % 16;
# 10 5 3 4 0 1 14 15 4 8 5 2 0 0 5 2 12 0 8 1 3 11 5 2
# J  u s t   a n  o  t h e r   P e r l    h a c k  e r
Here we fix up the erroneous 1's bits.
```    \$T =
vec( pack( 'C', \$i ), 0, 4 ) + vec( pack( 'b*', \$_{65} ), \$_, 1
+) * 16 +
32;
# print \$T;
# 42 53 51 52 32 33 46 47 52 40 37 50 32 48 37 50 44 32 40 33 35 43 37
+ 50
# 0  1  1  1  0  0  0  0  1  0  0  1  0  1  0  1  0  0  0  0  0  0  0
+ 1
# J  u  s  t     a  n  o  t  h  e  r     P  e  r  l     h  a  c  k  e
+ r
# *  1  2  3  4  5  6  7  8  9  10 11 12 *  1  2  3  4  5  6  7  8  9
+ 10
Now we extract the low nybbles from \$i and the 16's bits from \$_{65}, and set the 32's bits unconditionally.
```    print pack( 'c', ( \$T += \$T == 32 ? 0 : 64 ) -= \$_ % 13 == 0 ? 32
+: 0 );
Now we set the 64's bit unless the character is a space and reset the 32's bit for the two capital letters and print the result.
```#    &\$s; # independent of rest of loop, unrolled
}
# print ' ',
&\$s for 0..23;
# 00   14294967295  2105  38   44294967263  573   68   74294967263  87
+7
# 94   104294967291 1153  120  134294967295 14116 1520 164294967263 17
+112
# 1813 194294967282 20125 2116 224294967295 23116
```print pack( 'c', &\$s(1) ^ unpack( 'c', pack( 'b*', \$_{72} ) ) );