Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re: rusty lock

by Anonymous Monk
on May 26, 2006 at 18:22 UTC ( #551923=note: print w/replies, xml ) Need Help??


in reply to rusty lock

Some analysis:
spoiler> The first thing that it does is put the code into a string and eval it.
$_=q{ ... },
s,$/,,g, eval
Taking the code inside and cleaning up the formatting a little gives us a lot of mapping:
$|--; print join $", map { $_[$_{$_}] = sub { join $,, map { $_ = (ord) - ( $_[0] ? ($_[0]+4+$=)*$= : $= ); $_ += (2+$=)*2 while $_ < (1<<$.)-2-3*$=; chr } split $,, pop } -> ($_{$_}, $_) } map { $_{$_} = $a++; $.++; $_ } map { y; ;;d; $= /= 1.5; $.++; $_ } sub { split $/, join q,,, <DATA>; unshift @_, map { $. = y---c - $|--; $_ } shift; { undef @;; map @{[ push @{ $;[ ord((/.{$.}(.)/)[$|]) ] }, $_ ]},@_; @_ = map @$_, @;; $.-- && redo } @_[$|--..$^F+$|] } -> ()
Using map changes the order of execution - operations occur from the inside out.

$|--;

This sets $| to 1 (using the special behaviour of $|).

The next section of code that executes is the innermost anonymous sub:
    split "\n", join '', <DATA>;

Here we pick up the words that are at the end of the file, using split to fill @_. This is equivalent to @_ = <DATA>; chomp @_; or even just @_ = qw(uhinbyl zobxiiv xqsauh zozmib xtbemz ujwq xzaf ufde); to completely avoid the use of DATA.

    unshift @_, map { $. = (length) - $|--; $_ } shift;

The code block in map returns $_, and unshifts back onto @_ the same value it shifted off. So here map is only operating on one value, and only running for its side effects. In this case, $. gets set to 6, the length of "uhinbyl" - 1, and $| gets flipped back to 0.

{ undef @bins; map @{[ push @{ $bins[ ord( (/.{$.}(.)/)[$|] ) ] }, $_ ]}, @_; @_ = map @$_, @bins; $.-- && redo }

Let's break this down piece by piece:
$.-- && redo turns this block into a loop. Since $. was set to 6 earlier, the loop index goes from 6 down to 0. What's actually being done in the loop? Well, the regex /.{$.}(.)/ matches n characters, then the next character is returned because of the capturing parens. $| is now 0, so (/.{$.}(.)/)[0] is just a fancy way of saying substr($_, $., 1). It does behave slightly differently in the case where $. is beyond the end of the string - substr spits out a warning, but in this construct the regex fails to match and element 0 of an empty list is just more nothing. Converted to a scalar for ord, it becomes undef, and ord(undef) returns 0.

So, what ord returns is the code for the character at a given position. map here is in void context, so we are throwing away the return value from push. So it's equivalent to push @{ ... }, $_ for @_;. The push uses the output from ord as the index to an array (@; in the original code, which I have renamed to @bins here.) That array position becomes an arrayref, which will hold everything that maps to that ordinal.

So the first pass through, when $. is 6:

$bins[ ord('l') ] = [ 'uhinbyl' ]; $bins[ ord('v') ] = [ 'zobxiiv' ]; $bins[ 0 ] = [ 'xqsauh', 'zozmib', 'xtbemz', 'ujwq', 'xzaf', 'ufde' ];

Then, another map is run: @_ = map @$_, @bins;. The first time I looked at this, I did not realize what value $_ had in this expression. But it's within the context of map here; what @_ ends up with is the concatenation of each list in @bins. It should be apparent at this point why I chose to rename @; to @bins - this block of code is what is more commonly known as a radix sort.

The rest of the code is less interesting:
@_[$|--..$^F+$|]
$|-- returns 0 (the old value of $|) and flips it back to 1. $^F is 2, which added to $| - which just got flipped to 1 - yields 3. So this is actually @_[0..3], or a slice of the first 4 elements of @_. Yes, the other elements in DATA are thrown away - they are only there to misdirect. We end up with qw(ufde uhinbyl ujwq xqsauh).

The next two maps return $_, so they are again just doing side-effects:

map { y/ //d; # delete spaces. None of the words have any, +so no-op. $= /= 1.5; # $=, initially 60, can only contain integer v +alues. # Since map runs this 4 times for the 4 elemen +ts of @_ # $= becomes 60 -> 40 -> 26 -> 17 -> 11 $.++; # The test ($.-- && redo) ended at 0, which me +ans that # $. ended up with the value -1. Here it beco +mes 3 $_ }

Then:
map { $_{$_} = $a++; # %_ hash becomes # ( ufde=>0, uhinbyl=>1, ujwq=>2, xqsauh=>3 ) $.++; # 4 more increments leaves $. set to 7 $_ }

And finally
map { $_[$_{$_}] = # $_{$_} is the hash value that was # just set to the array index sub { ... } -> ($_{$_}, $_) # hash {$_}, $_ = (value, key) pair }

So the sub gets executed four times, putting the results into @_:
$_[0] = sub { ... } -> (0, 'ufde') $_[1] = sub { ... } -> (1, 'uhinbyl') $_[2] = sub { ... } -> (2, 'ujwq') $_[3] = sub { ... } -> (3, 'xqsauh')

The sub itself runs through another map:
split //, pop
pop returns the last element of @_, which here is the sub's parameters, so this just takes the string and chops it up into individual characters.
join '', map { $_ = (ord) - 11 * ( $_[0] ? ($_[0]+15) : 1 ); $_ += 26 while $_ < 93; chr }

converts the text ufde uhinbyl ujwq xqsauh to the text just another perl hacker.
For extra credit, figure out how to convert this japh to canonical form (can you manage to get 'J', 'P', and ',' out of it while still maintaining the input satisfying /[a-z]*/?)

Replies are listed 'Best First'.
Re^2: rusty lock
by jynx (Priest) on May 27, 2006 at 05:44 UTC

    note: the other 4 "filler" words can also be decrypted. Despite some padding characters, they read like normal words. They're not nearly as harsh as i think they should be, but i was trying to work within certain confines so i couldn't use the words i wanted to...

    jynx

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://551923]
help
Chatterbox?
[Discipulus]: thanks choroba.. todo list need a pager..

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (6)
As of 2017-11-24 12:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    In order to be able to say "I know Perl", you must have:













    Results (348 votes). Check out past polls.

    Notices?