Category:    Best 'The Perl Journal'
Author:      Jean-Baptiste Nivoit <jbnivoit@ix.netcom.com>
Date:        07-30-1998
Script Name: tpj.pl


This program formats vertically the words 'The Perl Journal'
(well, at least that's what i tried to do!), and prints those
same words when executed.

That script uses a few tricks to obfuscate some code that is otherwise
not so complex. The script opens itself, reads the first line, and 
uses that line and a statically declared table of integer values to
make up the 'The Perl Journal' string. The table of integers contains
the successive values of the offset between letters of the '#! /usr/bin/perl '
and 'The Perl Journal' strings taken as integer values.

This script features some custom routines: 'pop', 'push', 'join', 'reverse'
are re-implemented (the perl subroutines by those names are not used!).

Cut the text between the two 'Cut Here' lines to have a re-formatted
version of the 'tpj.pl' script.

----- Cut Here -------------------------------------------------
#! /usr/bin/perl 
# on this first line, it is very important that there be an additionnal ' ' character!

@l = &_ (-49,-71,-69,+15,+37,+14,0,-61,66,31,-1,-70,-2,-9,17,0,+22,+32);
# my table of character values.

open _,$0;
# the script opens itself

{;};
# these do nothing, they're just some padding characters

$_.=<_>;
# the script reads it first line. Note that the '.' is superfluous, it was just to pad.

@s=&_(split//);
# the '_' subroutine reverses a list. We pass it the list of characters contained in the first line of the script.

{;}
# nothing again.

while ($s=&____(\@s)) # pop a character.
  {
    $P=*____; # useless, of course.
    {;{;}}    # same thing.
  l:          # a label. useless as well.
    $l=&____(\@l); # pop the value of same index in the table of values.
    {;{}}
    @__=(@__,chr(ord($s)-$l)); # push the character of that index in the final string.
  }

$_.="@__"; # this does a 'join'. Once again the '.' is superfluous.

s/\b \b//g;
# suppress the superfluous spaces.

{;{}}
# useless, again!!

s/  //g;
# suppress some more whitespace.

sub _ {($#_==0)?():(&_(@_[1..$#_]),$_[0]);}
# this sub is a recursive implementation of 'reverse'. It only uses array properties and the '?:' ternary operator.

sub __{;$_="           @_";s/ //g;$_;}

;;
{}
;;
{}
;;
# this is almost useless: the only purpose was to make the vertical branch of my letter 'L'.

sub ___{{;}@_;}
# this is an implementation of 'push'. It is not used in the script! (well it's inlined somewhere in the script...).

sub ____{$_=${$_[0.0]}[$#{$_[0]}];$#{ $_[0]}--;{___;}$_;}
# this is an implementation of 'pop' without any alphabetic character in it.

# the following routine i wrote to imitate the way some people 'talk'.
# you can feed it a string and you'll see what it does.
# however, it is a symmetry: applied twice it makes an invariant!
sub _0{
  $_=$_[0];
 _:
  {
  }
  ;
  split//;
  {
    ;
  }
  for ($__=$_[$i=0]; $__=$_, $i<$#_; $__=$_[$i+=2] )
    {
      {
	$__;
      }
      ;
      $i++ if($__=~/ /);
      
      $_=$_[$i];  
      if (/[a-z]/)    
	{
	  y/  a-z/  A-Z/;
	  {
	    ;
	  }
	  ;
          goto __ ;#
	  {
	  };
	}
      tr/A-Z/a-z/;
    __:
      {
	y/AE/\@3/;
	$_[$i]=$_;
      }
    _:
      {
	;
	{
	  ;
	}
      }
    }     
 _:
  {
    $_,@_;
    {
      ;
    };
    {}
    ;;
    ;;
    {}
  }
  $_ = "@_";
  s/\b \b//g , s/ {3}/ /g;
  $_;
}

$_=&_0(&_0($_));
# this does nothing! but this is most fortuitous, and works only because of the 
# special property of the '_0' function.

print;
# well, echo out the 'The Perl Journal' string.

----- Cut Here -------------------------------------------------

Here is another interesting fact about this script:

Cut the text between the 'Cut Here' lines, and try to execute it.
It is almost the same as my 'tpj.pl' script, with only one different
character, and that's enough to make Perl stumble on it! I may have
triggered a bug in the perl parsing.

In the last 'A' letter are the following lines:


{y            /AE/
##            .Z/
\@3/          ;$_

adding the '/' character on the 2nd of those lines makes perl say there's
an error, when really there is none! (it should ignore the whole line anyway 
since it begins with the '#' comment character...)

----- Cut Here -------------------------------------------------
#! /usr/bin/perl 
       @l
       =&  
       _(
       -
       49
       ,-
       71
       #,


,-            69
,+            15
,+            37
,+            14
,0            ,-
61,66,31,-1,-70,
-2            ,-
9,            17
,0            ,+
22            ,+


32);open _,$0;{;
};
$_
.=
<_>;@s=&_(split
//
);
{;
}while($s=&____#


(\@s)){$P=*____
;{           ;{
;}           }l: 
$l           =&
____(\@l);{;{}}
@__
=(
@__
,#


chr(ord($s)-$l))
;}
$_
.=
"@__";s/\b \b//g
;{
;{
}}
s/  //g;sub _{(


$#_==0)?():(&_(
@_           [1
..           $#_
])           ,
$_[0]) ;}sub __
{;           $_
="           @_
";           s/ 
//g          ;#


$_
;}
;;
{}
;;
{}
;;
sub ___{{;}@_;}


  sub ____{$_=${;
	    {;}
	    {;}
            $_
            [0
	    .0
]           }[
$#{$_[0]}];$#{


 $_[0]}--;{___
;             }
$             _
;             }
{             ;
;             {
}             }
sub _0{$_=$_[0]


;             _:
{             }
#             ;
;             #
;             ;
{             }
;split//;{;}for


($__=$_[$i=0];$
__            =$
_,            $i
 <            $#_
;$__=$_[$i+=2])
{{            $__
;}            ;$i
++            if(
$__           =~
/ /           );


$_            =
$ _[          $i
];  if        (
/[a-z]/)      {y
/  a-z/  A-Z/;{;
};          goto 
__            ;#
{             };


 }tr/A-Z/a-z/;__:
{y            /AE/
##            .Z/
\@3/          ;$_
[$i]=$_;}_:{;{;}}
}              _:
{              $_
,@             _;


{;
};
{}
;;
;;
{}
}$
_=
"@_";s/\b \b//g,s
/ {3}/ /g;$_;}$_=&_0
(&_0($_));print;#

----- Cut Here -------------------------------------------------


