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

Re: Magic 8 Ball

by deibyz (Hermit)
on Jun 28, 2005 at 10:24 UTC ( #470562=note: print w/replies, xml ) Need Help??

in reply to Magic 8 Ball

I couldn't resist to write an spoiler to this obfu:

#!/usr/bin/perl use strict; $_=q`seek(D ATA,30,0);local$/;$_=< DATA>;/8{6}(.*)8{6}/s;($a=$1) =~s/\s+(8+\s+)*//g;$a=~s/X/\040/g ;my@eight=split/888/,$a;@eight=split/ 8/,$eight[rand(20)];s/(\s+88\s*(8?88)?\ s+)/$b=int((length($1)-length($eight[0] ))\/2);sprintf("%-".length($1)."s","\040" x$b.shift(@eight) )/eg;print;"88888 888888X8Outlook8 88888 Good8888Outlook8 NotXSo8Good8888 88 88 MyXReply8IsXNo8 888Don't8Count8 88888 OnXIt8888YouXMa y8RelyXOnXIt888 88 88 8Ask8Again8Late r8888Most8Likely 88888 8888Cannot8Predi ct8Now8888X8Yes88 88Yes8Definately8 888Better8NotXXTell8YouXNow8888ItXIs8Cert ain8888Very8Doubtful8888ItXIs8Decidedly 8So8888Concentrate8and8Ask8Again8888Sig ns8Point8ToXYes8888MyXSources8SayXNo8 888Without8a8Doubt888Reply8Hazy,8 Try8Again8888AsXIXSee8It,XY es888888"`;s/\s//g;eval ;__DATA__

This is the original code. We see that everything goes into $_ (without spaces) and gets evaled. So the code that get executed is:

seek(DATA,30,0);local$/;$_=<DATA>;/8{6}(.*)8{6}/s;($a=$1)=~s/\s+(8+\s+ +)*//g;$a=~s/X/\040/g;my@eight=split/888/,$a;@eight=split/8/,$eight[ra +nd(20)];s/(\s+88\s*(8?88)?\s+)/$b=int((length($1)-length($eight[0]))\ +/2);sprintf("%-".length($1)."s","\040"x$b.shift(@eight))/eg;print;"88 +888888888X8Outlook888888Good8888Outlook8NotXSo8Good88888888MyXReply8I +sXNo8888Don't8Count888888OnXIt8888YouXMay8RelyXOnXIt88888888Ask8Again +8Later8888Most8Likely888888888Cannot8Predict8Now8888X8Yes8888Yes8Defi +nately8888Better8NotXXTell8YouXNow8888ItXIs8Certain8888Very8Doubtful8 +888ItXIs8Decidedly8So8888Concentrate8and8Ask8Again8888Signs8Point8ToX +Yes8888MyXSources8SayXNo8888Without8a8Doubt888Reply8Hazy,8Try8Again88 +88AsXIXSee8It,XYes888888"

So ugly... Lets tidy it (and add some comments):

seek( DATA, 30, 0 ); # Get DATA handle to first line of code (after "u +se strict") local $/; # slurp $_ = <DATA>; # file source /8{6}(.*)8{6}/s; # Between groups of 6 8's (from code end) ( $a = $1 ) =~ s/\s+(8+\s+)*//g; # Remove center "hole" (from copy) $a =~ s/X/\040/g; # X are spaces my @eight = split /888/, $a; # 3 eights marks separation between sente +nces @eight = split /8/, $eight[ rand(20) ]; # take one of this random answ +ers and split on 8's (lines?) # Put answer on ceter hole (that's what I don't know exactly how works s/ (\s+88\s*(8?88)?\s+) # Center hole. / $b=int((length($1)-length($eight[0]))\/2); # $b is half of the + space left sprintf("%-".length($1)."s","\040"x$b.shift(@eight)) # $b spaces and word shifted from @eight, padded to total spac +e. This "centers" the text in the hole /xeg; #s/(\s+88\s*(8?88)?\s+)/$b=int((length($1)-length($eight[0]))\/2);spri +ntf("%-".length($1)."s","\040"x$b.shift(@eight))/eg; print; # and print "88888888888X8Outlook888888Good8888Outlook8NotXSo8Good88888888MyXReply +8IsXNo8888Don't8Count888888OnXIt8888YouXMay8RelyXOnXIt88888888Ask8Aga +in8Later8888Most8Likely888888888Cannot8Predict8Now8888X8Yes8888Yes8De +finately8888Better8NotXXTell8YouXNow8888ItXIs8Certain8888Very8Doubtfu +l8888ItXIs8Decidedly8So8888Concentrate8and8Ask8Again8888Signs8Point8T +oXYes8888MyXSources8SayXNo8888Without8a8Doubt888Reply8Hazy,8Try8Again +8888AsXIXSee8It,XYes888888"

And that's "all". Great obfu!! Maybe some ay I'll be able to do them, and not only to spoil...

Update: Updated with regexp explanation

Replies are listed 'Best First'.
Re^2: Magic 8 Ball
by suaveant (Parson) on Jun 28, 2005 at 19:45 UTC
    ( $a = $1 ) =~ s/\s+(8+\s+)*//g; # Remove center "hole" (from copy)

    This line also removes whitespace from outside the ball.

                    - Ant
                    - Some of my best work - (1 2 3)

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2023-02-06 21:39 GMT
Find Nodes?
    Voting Booth?
    I prefer not to run the latest version of Perl because:

    Results (36 votes). Check out past polls.