open+0 and local $/; $ms = <0> and close 0;
$false = q[OlD|OIDlDOIOl!Di|] =~ /[1|0]/;
my $fa1se = eval 'BEGIN{ 1/0 }' if $false;

($false||rand)&&split /
/, $ms; $truth = $beauty = '' =~ //;
if ( $truth and $beauty ) { split' ',
$ms; $ls[ $false+=8 ] = shift @_ while @_;
map { $_ = 054 + length } @ls;
# This part is important!!!
23 while s/(.{0,8})(..)/crypt$1,$2/ge; }

my $O;
$ls[ $false++ ] = $_ for @_
;s{.}{ord($&)%0x0a}ego for grep $_, @ls;
( 598306+679527+682489!=+585085 );

$O = join qq,, , map { ( $_ )?
chr( 0b1001010+length )
: defined() ? qq- - : 'J'
} @ls; $_ = chr 0xdeadbeef % +255
for @ls; $O=$0 if ($truth);
$beauty && {redo};exit !print qq/$O,\n/;
[download]

The broad overview of its operation is:

1. It opens and reads itself in.
2. The japh is encoded in the line lengths.
3. A lot of the code is dead, just to get the line lengths right.

Now, some detail.

open+0 and local $/; $ms = <0> and close 0;
[download]

This reads the source file into $ms (myself). In open, it says "If EXPR is omitted, the scalar variable of the same name as the FILEHANDLE contains the filename.", and that's what this is doing. It opens $0, the file containing the program. I use local to undef $/ and turn on slurp mode. I don't actually care if the close happens, but it gets the line length right.

$false = q[OlD|OIDlDOIOl!Di|] =~ /[1|0]/;
[download]

This will set $false to 1. I fixed a bug recently where someone thought a pipe is used for alternation in a character class. It's not; it's a literal pipe. The pattern matches because of that; there's no 1 or 0 in the string.

($false||rand)&&split /
/, $ms;
[download]

This will split $ms on newlines and store the result in @_. It may look as if this runs because rand is nearly always true, but it's because $false is true.

$truth = $beauty = '' =~ //;
[download]

Here, $truth and $beauty are false. It may appear that the empty pattern will match the empty string, but an empty pattern actually uses the last pattern match performed. That was the one with the character class, and none of those characters are in the empty string. Therefore, false.

if ( $truth and $beauty ) { split' ',
$ms; $ls[ $false+=8 ] = shift @_ while @_;
map { $_ = 054 + length } @ls;
# This part is important!!!
23 while s/(.{0,8})(..)/crypt$1,$2/ge; }
[download]

This is all dead code. It's based on some of the live code later and the encoding trick I used in Brute force JAPH.

my $O;
$ls[ $false++ ] = $_ for @_
;
[download]

Later, $O will hold the output.

The for loop takes the lines in @_ and stores them in @ls (long strings). Since $false starts out as 1, element 0 is left undef.

s{.}{ord($&)%0x0a}ego for grep $_, @ls;
[download]

This takes the "true" lines in @ls and replaces every character with some digit. I don't really care what they wind up as since I'm just interested in the lengths. It's important that this leaves the undef element undefined, and the empty strings are left empty.

( 598306+679527+682489!=+585085 );
[download]

This doesn't do anything, but all the numbers are nodes of mine.

1. Brute force JAPH
2. Wall of Text
3. eval JAPH
4. kyle

$O = join qq,, , map { ( $_ )?
chr( 0b1001010+length )
: defined() ? qq- - : 'J'
} @ls;
[download]

For each item in @ls, we check if it's false, defined, or true. True values (lines with content) are measured with length, 74 is added, and chr turns the resulting ASCII code into characters. False and defined values (empty strings) are turned to spaces (qq- -). The initial undef element is translated to 'J'.

$_ = chr 0xdeadbeef % +255
for @ls; $O=$0 if ($truth);
$beauty && {redo};
[download]

This is all effectively dead code. The first for loop clobbers the contents of @ls (now that I'm done with it). The other two statements don't execute because $truth and $beauty are false.

A little Perl trivia: "{redo}" is a six character infinite loop.

exit !print qq/$O,\n/;
[download]

The print will output the JAPH, and we negate its true return value to exit with a zero exit status.