I am new at this .How does the pattern work
  1 while s!(.)(.{4})\1!?$2*!s;  # Match in right pos
regards,
rajdeep

It's cute... Since the "secret" is concatenated with what the user entered, this will match if you get the same number separated by 4 characters (that's 3 digits and the \n in some combination).

It replaces that with a ? for the first position, and a * for the 2nd, with $2 (the 4 characters in between) in the middle. Then, the substitution is repeated as long as it succeeds, so if you have all 4 characters right, you get 4 *'s.

The 2nd substitution puts in +'s for any numbers that appear in both lines after the first substitutionwas done, which will get only numbers in the wrong place since all the ones in the right spots are already replaced with '*'.

The last print will print out any * or + in the string, telling you how many you have right or nearly right.

Very nice script... I like the cool uses of s/// and the print of the matches.
--
Mike

Of course, the fact that this is even possible gives rise to the occasional assertion that Perl is a "write only" language. It's great to be able to get such brevity, should brevity be something you desire in a particular situation, but it's pretty mean to force such brevity onto an unwitting maintainer. :-)

Here's a version run through Perltidy - not too hard to understand if you know Perl regular expressions. The $c is the secret, $_ is the guess, and the code depends on matching the guess concatenated with the secret. Interesting code, and not a bad example of Perl really - it's just that the traditional scrunched-up formatting makes it look like line noise. I also made some minor changes for understandability/legibility. Of course, I realise this is entirely against the idea of obfuscated code :)

#!/usr/bin/perl -l
$c .= 1 + int rand 6 for 1 .. 4;      # Build up the secret

while (<>) {
    /^\d{4}$|!/ || next;              # Check user entered 4 digits

    $_ .= $c;

    1 while s!(.)(.{4})\1!?$2*!s;       # Match in right position

    1 while s!(\d)(.*\n.*)\1!+$2!;      # Match somewhere

    print /[*+]/g;                      # Print matches

    /\*{4}|!/ && exit;
}
[download]