$_=do{q}HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJ 
HAAHHJJJHJPPHPHJAJPHAAPHAJJHHJHAHA}};\s+\s++s+ 
y?JAPH?0-3?;s;(.)(.)(.);(map{ord>0130?uc:(),uc 
}q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj}=~ 
/./g)[$1*16+$2*4+$3];eg;s;\w+;\L\u$&;g;{print} 

##</code><code>##

 
$_=do{q}HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJ 
HAAHHJJJHJPPHPHJAJPHAAPHAJJHHJHAHA}}; 
 
\s+\s++s+ 
y?JAPH?0-3?; 
 
s;(.)(.)(.);(map{ord>0130?uc:(),uc 
}q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj}=~ 
/./g)[$1*16+$2*4+$3];eg; 
 
s;\w+;\L\u$&;g; 
 
{print} 

##</code><code>##

 
   1  $_=do{q}HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH
HJHAHA}}; 
 
   2  \s+\s++s+y?JAPH?0-3?; 
 
   3  s;(.)(.)(.); 
        (map { ord > 0130 
               ? uc 
               : () , uc } 
         q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj}=~/./g)[$1*16+$2*4+$3]; 
      eg; 
 
   4  s;\w+;\L\u$&;g; 
 
   5  {print} 

##</code><code>##

 
 
$ perl 
$_=do{q}HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH 
HJHAHA}}; 
\s+\s++s+y?JAPH?0-3?; 
s;(.)(.)(.); 
        (map { ord > 0130 
               ? uc 
               : () , uc } 
         q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj}=~/./g)[$1*16+$2*4+$3]; 
      eg; 
Bareword found where operator expected at - line 9, near "eg" 
  (Might be a runaway multi-line ;; string starting on line 4) 
        (Missing semicolon on previous line?) 
 

##</code><code>##

 
   1  $_=do{q}HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH
 
HJHAHA}}; 
 
   2  \s+\s++s+y?JAPH?0-3?; 
 
   3  s;(.)(.)(.);(map{ord>0130?uc:(),uc}q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaau
ujj}=~/./g)[$1*16+$2*4+$3];eg; 
 
   4  s;\w+;\L\u$&;g; 
 
   5  {print} 

##</code><code>##

 
   1  $_=do{q}HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH
 
HJHAHA}}; 
 
   2  \s+\s++s+y?JAPH?0-3?; 
 
   3  s;(.)(.)(.);tadman($1,$2,$3);eg; 
 
   4  s;\w+;\L\u$&;g; 
 
   5  {print} 
 
   6. sub tadman 
      { 
        my ($f, $s, $t) = @_; 
        ( map { ord>0130?uc:(),uc } 
          q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj}=~/./g) 
        [$f*16+$s*4+$t] 
      } 

##</code><code>##

 
   $_=do{q}HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH 
HJHAHA}}; 

##</code><code>##

 
use strict; 
use warnings; 
my @friends = qw ( Aaron Donald Roger etc ); 
my @family = qw)Mom Dad Brother Sister etc); 
foreach ( @friends ) { print $_, " is a friend\n" } 
foreach ( @family ) { print $_, " is family\n" } 

##</code><code>##

 
$ perl -e '$_ = do{q(Hello World)}; print $_,"\n"' 
Hello World 

##</code><code>##

 
\s+\s++s+y?JAPH?0-3?; 

##</code><code>##

 
$ perl 
$_='HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH 
HJHAHA'; \s+\s++s+y?JAPH?0-3?; 
print; 
__END__ 
330321210010200311001103013102303132203113300030223230102311231003303131 

##</code><code>##

 
$ perl 
$_='HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH 
HJHAHA'; 
tr/JAPH/0123/; 
print; 
__END__ 
330321210010200311001103013102303132203113300030223230102311231003 
303131 

##</code><code>##

 
$ perl 
$_='HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH 
HJHAHA'; 
s/\n//g; 
print; 
__END__ 
HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJHHJHAHA 

##</code><code>##

 
$ perl 
$_='HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJH 
HJHAHA'; 
s/\s+//s; 
print; 
__END__ 
HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJHAAHHJJJHJPPHPHJAJPHAAPHAJJHHJHAHA 

##</code><code>##

 
s/\s+//s; 
vs 
\s+\s++s+ 

##</code><code>##

 
$ perl 
$_='hello 
world'; 
\s+\s++s+; 
print $_; 
__END__ 
syntax error at - line 3, near "+;" 
Execution of - aborted due to compilation errors. 

##</code><code>##

 
$ perl 
$_='hello 
world'; 
\s+\s++s+tr/JAPH/0123/; 
print $_; 
__END__ 
helloworld 

##</code><code>##

 
s/\s//s and tr/JAPH/0123/; 

##</code><code>##

 
if ( s/\s//s ) {  # if we remove a space char, where "space" includes \n... 
  tr/JAPH/0123/;  # ...then do this tr/ansl/ation/ 
} 

##</code><code>##

 
   3  s;(.)(.)(.);tadman($1,$2,$3);eg; 
 
   4  s;\w+;\L\u$&;g; 

##</code><code>##

 
$ perl -e '$_ = "hello world"; s/(hello)/uc $1/g; print $_,"\n"' 
uc hello world 
 
$ perl -e '$_ = "hello world"; s/(hello)/uc $1/ge; print' 
HELLO world 

##</code><code>##

 
while ( /(.)(.)(.)/g ) { 
  tadman ( $1, $2, $3 ); 
} 

##</code><code>##

 
   4  s;\w+;\L\u$&;g; 

##</code><code>##

 
$ perl -e '$_ = "hello world"; s;\w+;\L\u$&;gx; print $_,"\n"' 
Hello World 
$ perl -e '$_ = "HELLO WORLD"; s;\w+;\L\u$&;gx; print $_,"\n"' 
Hello World 

##</code><code>##

 
$ perl -e '$_ = "hello world"; $_ = ucfirst($_); print $_,"\n"' 
Hello world  
$ perl -e '$_ = "HELLO WORLD"; s;\w+;\L\u$&;gx; print $_,"\n"' 
HELLO WORLD 

##</code><code>##

 
{print} 

##</code><code>##

 
    sub tadman 
    { 
 1    my ($first, $second, $third) = @_; 
 2    ( map { ord>0130?uc:(),uc } 
        q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj}=~/./g) 
      [$first*16+$second*4+$third] 
    } 

##</code><code>##

 
#!/usr/bin/perl 
use strict; 
use warnings; 
 
my $line = 'Bond, James Bond|007|Secret agent|Walther PPK|etc|etc|etc'; 
my @fields = split /\|/, $line; 
my $occupation = $fields[2]; 
print "$occupation man\n"; 
exit; 

##</code><code>##

 
#!/usr/bin/perl 
use strict; 
use warnings; 
 
my $line = 'Bond, James|007|Secret agent|Walther PPK|etc|etc|etc'; 
my $occupation = ( split /\|/, $line )[2]; 
print "$occupation man\n"; 
exit; 

##</code><code>##

 
 2    ( map { ord>0130?uc:(),uc } 
        q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj}=~/./g) 
      [$first*16+$second*4+$third] 

##</code><code>##

 
    (        # open paren to force list context 
      map    # will be followed by BLOCK and LIST 
             # Here's the BLOCK: 
          { ord > 0130 ? uc : (), uc } 
 
             # so this must somehow be acting as a LIST 
          q{KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj} =~ /./g 
 
             # Finally, close paren and index into the list 
    )[$first*16+$second*4+$third] 

##</code><code>##

 sub tadman 
{ 
  my ($first, $second, $third) = @_; 
  my $index = $first * 16 + $second * 4 + $third; 
  my @key = split /|/, 'KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj'; 
  ( map { ord > 0130 ? uc : (), uc } @key )[ $index ]; 
} 

##</code><code>##

 
# 
# { ord > 0130 ? uc : (), uc } 
# 
if ( ord $_ > 0130 ) {  # if [ord] of $_ is > than 130... 
  $_ ;                  #   just return $_ 
} else {                # otherwise 
  (), $_ ;              #   return undef *and* $_ 
}  

##</code><code>##

 
#!/usr/bin/perl 
 
use strict; 
use warnings; 
 
# starting data 
$_ = 'HHJHPAPAJJAJPJJHAAJJAAJHJAHAJPHJHAHPPJ 
HAAHHJJJHJPPHPHJAJPHAAPHAJJHHJHAHA'; 
 
# strip newline within $_ 
s,\s,,s; 
 
# turn letters in $_ into numbers 
tr/JAPH/0123/; 
 
# turn every 3 numbers into a single character 
s;(.)(.)(.);tadman($1,$2,$3);eg; 
 
# do some case mapping 
s;\w+;\L\u$&;g; 
 
# show the deciphered message 
{print} 
 
 
sub tadman 
{ 
  # $1, $2, and $3 from the substitution 
  my ($A, $B, $C) = @_; 
 
  # be upfront about math 
  my $index = $A * 16 + $B * 4 + $C; 
 
  # here's the data from whence comes the non-trademarked message 
  my @key = split /|/, 'KnKttiIMRsROhOppllrr y ssLfL cWEdEaauujj'; 
 
  # here's the uncompressed data, that we can now index into 
  my @expanded_key = map { ord > 0130 ? $_ : (), $_ } @key; 
 
  # pull out the $index-th letter from @expanded_key 
  my $value = $expanded_key[$index]; 
  return $value; 
}