I've parsed by hand, and explained it's actions (more or less) line by line in code comments. If there are any errors, or parts that are unclear. Please /msg me.

Excellent obfu jryan! If anyone wants to preserve the magic, stop reading now :) 

#!/usr/bin/perl -w  # Bugs In My Code?
use strict;

# set the input record separator to 'z'
$/=chr((($= << 1)/((1<<1)*(int$])))."\62"); 

my @sg= map {
    $_++;                       # increment the last character 
    my @l;                      
    while($_){
        my $z=1<<1;             # 2

        my $i=substr($_,0,$z);  # $i is two characters of $_
        if ($i>(int($])**$z)){  # $] is the version number, int($]) ==
+ 5, so if ($i > 25) {
            $l[@l]="$|".$i;     # push(@l,"0".$i);
        }                       
        else {
            # otherwise take the number and the next digits and push i
+nto @l;
            $l[@l]=$i.substr $_,$z,1;
            $z++                # 3
        }
        $_=substr $_,$z,length$_; # remove those characters from $_
    }
    @l = map chr,@l;            # translate to character the elements 
+of @l (ascii values)
    $_ = join'',@l;             # compress back into a line.
} 
map {
    my @y=split'';              # 1 character per array
    map {
        $_ = '' if/[a-z]/       # remove all lower a-z
    } @y;
    join '',@y;                 # join back together into one line
    # This could be translated as $_ =~ s/[a-z]//g;
}
map (((join'',split)),<DATA>);  # remove all white space from _DATA_

#    this is what's burried in __DATA__
#
#    @sg = ( "Correct",
#            "the line",
#            "There seems to be a type of",
#            "in",
#            "Score",
#            "Congrats! you have won the challenge. Give yourself a pa
+t on the back",
#            "Game Over! Thank you for playing, please come again!"
#          );

%_=();
@_= (2401,2414,2414,2423,1264,1322,1413,1483,1904,1940,265,299);
$_=$|;

# turn the array into a hash of arrays with 2 elements each
while ($_<@_){
    $_{ chr $_/(1<<1) } = [ $_[$_], $_[$_+1] ];
    $_+=(1<<1)
}

#    gives you 
#
#    $VAR1 = {
#          '' => [           # ascii 0
#                   2401,
#                   2414
#                 ],
#          '' => [           # ascii 1
#                   2414,
#                   2423
#                 ],
#          '' => [           # ascii 2
#                   1264,
#                   1322
#                 ],
#          '' => [           # ascii 3
#                   1413,
#                   1483
#                 ],
#          '' => [           # ascii 4
#                   1904,
#                   1940
#                 ],
#          '' => [           # ascii 5
#                   265,
#                   299
#                 ]
#        };
#
# these are the offset to yank out of $m for the questions

my $bug=3;  # number of bugs to quiz you about

$_=qq!seek $" DATA, $" $[, $" int($]-($=/($=/int($]))))!;  
# $" = "", $[ == 0, $] == 5.6.0, $= == 60
# so we have, seek DATA, 0, int(5.6.0-(60 / (60/int("5.6.0"))));
# or          seek DATA, 0, 0;
                                                           

my @b = qw |; _ $ @ ) { % =|;   
# @b = (';','_','$','@',')','{','%','=');

my %u=();
my $t;
my $s=$|;

while (){
    undef $/;

    eval;            # here is what makes Dparse toss it's cookies
    # seek DATA 0, 0 # here is what is being excuted.  This resets DAT
+A for the next question

    my $m = <DATA>;
    $/="\n";

    while(){
        $t = int rand @_/(1<<1);  
        last if !exists ($u{$t})
    }
    # this picks a random value for $t that doesn't exist in $u
    # (so you don't get the same question twice?)
    
    my $d = substr($m,
                   # $_{ ascii $t}->[0]
                   $_{chr $t}->[$|],                        

                   # $_{ ascii $t}->[1] - $_{ascii $t}->[0] (differenc
+e of [1]-[0] in %_;
                   $_{chr $t}->[++$|] - $_{chr $t}->[--$|]  
                  );

    # remove two consecutive white space characters
    $d =~ s/\s{2,2}//gx;    
    # remove all the newlines
    $d =~ tr/\n//d;         

    my $b;
    while () {
        # pick a random character to remove from the  code fragment
        $b=$b[int rand @b];
        last if $d =~ /\Q$b\E/      
    }

    my $u = $d;                     
    # $u now contains the character that was removed from $d

    # one char per element in @z of the code fragment
    my @z = split //,$u;
    my @p;

    print "$|\n";
    # iterate across @z.  $| == 0
    foreach my $z ($|..$#z) {       
        # push into @p the indexes where $b (the character to be remov
+ed) are found
        $p[@p] = $z if $z[$z] eq $b 
    }

    substr ($u, $p[int(rand @p)], $= >> int $] ) = "";

    # substr as an lvalue *shudder* ($= >> int $] == 1) btw
    # now $u has had a randomly positioned instance of $b removed
    # $u now contains the 'quiz code'

    #print qq+$sg[1<<1]$"$b$"$sg[3]\n$u\n$sg[$[]$"$sg[$= >> int$]]:$"+
+;
    # de-jryan-ed
    # print $sg[2] , $b, $sg[3], "\n";       # "There seems to be a ty
+po of" $b "in"
    # print $u, "\n";                        # the code fragment
    # print $sg[0], $sg[1], ":";             # "Correct" "the line" ":
+"
    
    # get your answer
    $u = <>;
    chomp $u;
    if ($u eq $d) {
        # you got it right $s (score) ++
        $s++;
        # the message saying so $sg[0] "Correct!"
        print "$sg[$|]!"; 
    }

    # print "$sg[4]: $s\n\n";  or print "Score: $s\n\n";
    print "$sg[1<<1**1<<1]: $s\n\n";

    $bug--; 
    last if !$bug;  # break out of the infinite loop

    # mark $t as used, so we don't get the same question twice
    $u{$t} = $t;    
}

# print the congrats message if you got them all right.
print qq!$sg[int($])]$":)! if $s == (3+$bug);   
# de-jryan-ed
# print $sg[5] if $s == 3;  # $bug == 0

print "$sg[6]\n"    # Game Over! Thank you for playing...

__DATA__
         6711dh 11141g 141019 9115z11 g610410 1321h 08105
        g h11    0100 z84104101 e1 14101321 15101101   1c 09
       1153      f 21161 11 32h981 01h32973 2g1161       h21
        112      11gh 132111101z10h51gh09z8y3 99cx1       1q1
       1p1       4d1qd0o0z 6711as1110 103114d971161       1 5
       3d3      328 9d111 117321049 7118101d321tyqu1      9111
      11032   t116 1041 d013299 104 97108108 101w11010    j3 1
      0146   32711 051181013 2jh1 21111 qt11711411 51011  f0810
      2329  7321    d12971  163211s 11103211 610d   41013  29 8
    979    910       6z 719x 710x 91013 sxc27911      8d10    ds11
 f14        3g3       32 841dyf04 ds97dd x1101d       t073      2fd1
2l          11fg       111 1732f fd102u1 adf1p       111         4as
             df3        er2112k10s df89qe7121      tyu1           05
             1iry          10103 443211tyu2         1081
              01jh           971ty 151uf0          1t32
              9911             1i10910t            1a32
             971t                y039u              7105
            11l                                       032
           d                                           jh

[download]
*WHEW!* :-)
Update: minor typos corrected, and first pass mistaken notes to myself removed.

Update 2:

Corrections via CB conversation with jryan 

  1.     # remove two consecutive white space characters
    $d =~ s/\s{2,2}//gx;

    [download]
    should really be 
        # remove ALL occurances of two consecutive white space characters

    [download]
    ie. 2, 4, 6, 8 .. This is because the code snippets are often broken by 40+ whitespace characters that need to be compressed out. 
  2.  while () {
        # pick a random character to remove from the  code fragment
        $b=$b[int rand @b];
        last if $d =~ /\Q$b\E/
    }

    [download]
    Random character *even if you get the same snippet*
  3. quote jryan (with permission)

    "0ne more thing you might wanna point out - one of the things i did intentionally is all of that parsing [of __DATA__]. i can throw all of the garbage in it that i want, but it will still come out correctly"

    ...the "join('',split)" at the tail of the 3 map block combined with the $_ = '' if /[a-z]/ in the middle map removes everything except 0-9 leaving __DATA__ open to be padded/polluted with anything else

/\/\averick
perl -l -e "eval pack('h*','072796e6470272f2c5f2c5166756279636b672');"

In reply to (maverick) Re: Bugs In My Code? (explained) by maverick
in thread Bugs In My Code? by jryan

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.