Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight

japH de'ShortBus'ed

by Mr. Muskrat (Canon)
on Dec 28, 2002 at 17:25 UTC ( #222756=note: print w/replies, xml ) Need Help??

in reply to japH

I know that you have all been waiting for one of us to break it down for you, so without further ado...

First I will start with the comments. Comments are never a requirement when doing an obfu or a JAPH. However, comments can be used to add humor, enlighten the reader as what is going on or perhaps mislead the reader into thinking that they know what is going on... I'll strip some of the comments that just get in the way, move some into a more logical location, etc... You'll see when we get to the code.

Subroutines while not necessary can add an extra dash of flare and panache to your otherwise boring obfu. Names of subroutines can also be used to your advantage. You will see what I mean in a few minutes.

#!/usr/bin/perl -0777
This is the shebang line. Note the -0777! It turns on slurp mode. See the January 2003 Q&A at Sys Admin Magazine for more details.
use strict;use warnings;
Duh... Always a plus when you do an obfu.
$_ = <DATA>;
Slurp up everything past __DATA__ storing it in $_.
Remove all the whitespace, leaving you with a big honking string of numbers in $_
For those of you who can't do this sort of thing in your head:

$_ = terfuge($_);
Execute sub terfuge passing $_ and store the result in $_

$_ = vert($_);
Execute sub vert passing $_ and store the result in $_

$_ = let($_);
Execute sub let passing $_ and store the result in $_

$_ = way($_);
Execute sub way passing $_ and store the result in $_

$_ = tle($_);
Execute sub tle passing in $_ and store the result in $_

Print the value of $_.

sub ject{ # of my affections
Note the humor in chosing the name of the subroutine and the comment that follows.
$_ ? 10 - $_ : $_;
This subroutine was originally called flip. It's quite simple really. If the value of $_ is true (>= 1) then return it subtracted from 10, if false (0) return the value untouched. i.e. 1 becomes 9, 5 stays 5, 7 becomes 3, etc...
} End of sub ject

sub let{ # rent out something you are renting
What a pretty pun...
join '', grep { y/a-z A-Z\0/n-za-m N-ZA-M\0/ } split //, $_[0]
Take the value passed and split the characters into a list, rot13 (passing spaces and nulls unaffected) the list and rejoin the list into a scalar and return it.
} End of sub let

sub way { # Eat fresh(TM)
Do I really need to explain the name and comment?
join' ', map { $_ = substr $_, 0, -2; join '', reverse split /\0/, $_ } split / /,$_[0]
Take the value passed and split on spaces thus creating a list. Process each element, removing the last two characters, spliting on nulls, reversing it, joining on ''. Now join the processed list on spaces. In case you haven't realized it yet, this is japhy's subroutine to de'Pig Latin' a string. See RE: RE: (3)Perl Golf (Pig Latin dialect + clever regexes). I originally called it unpig.
} End of sub way

sub vert { # To destroy completely; ruin
How cute!
scalar reverse split //, $_[0]
Return the passed string reversed (see perlfunc). Originally called rev.
} End of sub vert

sub tle { # elusive; crafty or sly; devious
I get it now!
$_[0] =~ y/a-zA-Z/A-Za-z/;
Reverse the case of the string passed. Originally called rc.
return $_[0]; # return to sender, address unknown...
Return the value in $_[0]. BTW, Elvis lives on in Perl!
} End of sub tle

sub terfuge { # A deceptive stratagem or device
Ain't that the truth!
$_ = join '', reverse map { ject($_) } split //, $_[0];
Take the passed value, split creating a list of characters. Execute sub ject passing it each element of the newly created list. Reverse the processed list, join to create a string and store it in $_.
join '', map { chr($_) } unpack('A3' x (length($_)/3), $_);
Take the value in $_ and unpack it into a list where each element has three digits. Get the appropriate character. Join into string of characters. (see Re: for loops.) This sub was originally entitled LongBus.
} End of sub terfuge (you wish!)

sub lime { # Inspiring awe; impressive.
japhy inspired me, what can I say?
join ' ', grep { s/\b(qu|[^\W0-9_aeiou]+)?(\w+)/$1?"$2\0$1ay":"$2\0ay"/egi } split / /, $_[0]
This is japhy's Pig Latin subroutine from RE: RE: (3)Perl Golf (Pig Latin dialect + clever regexes). I only changed it as necessary to make it work in context. It was used to create my obfuscated string. I originally entitled this sub pig.
} End of sub lime

sub str{ # .oO(Perlish)
sub str... substr... Get it? It's oh, so Perlish!
join '', map {ject($_)} reverse split //, join '', map { sprintf("%03d", ord($_)) } split //, $_[0]
Take the value passed and split it into a list of characters. Get the ordinal value of the characters and append 0's if less than 3 digits in length. Join back into a string. Split into characters once again, reversing into a list before "flipping the digits" and joining back into a scalar. This sub was originally entitled ShortBus.
} End of sub str


Long story short?
LongBus it, reverse it, rot13 it, translate from Pig Latin, and reverse the case of the entire string.

Join us next time when we discuss How not to write a tutorial on writing obfuscated Perl and JAPHs...
Oh wait, that was this time!

Mr. Muskrat waves goodbye as the scene fades to black.

Updated: Fixed a typo and moved the subroutines to the end to improve clarity.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://222756]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (6)
As of 2019-10-23 23:50 GMT
Find Nodes?
    Voting Booth?