Happy New Year!
truedfx
created: 2005-12-31 13:41:55
Okay, it's a little bit early for most of the world (myself included), but that doesn't matter too much, does it?
#!/usr/bin/perl
use strict;

$/=$_;!@ARGV?$_="@{[map{chr($_+43+($_&4)*(3.25+$_%2*7.5))}map{(7&-32+ord,-32
+ord>>3)}(=~/[ -_]/g)]}":s<>><\>>e;$"=~s;;\;;;map{[$_{$*}?($_{$_{$*}},
$_{$*}):($_{$*})=$_]}map{/./;($&,eval"q;++\$_[\$_]--;=~m'..[[](.*)[]]';qq($'
)")}qw/+++$& ,$&=ord+getc;$&$'if!defined$& ---$& <--\$_ >++\$_ [while($&){
]} .print(chr$&)/;$_=!(@_=(q[@_=()],map$_{$_},split//));eval"@_";

__DATA__
  UP DZ6U5&&DGJR@WV5$DPVG\DLRVP@D\VVCLR&&D\NBP6\&CD5VP@DWV:#D5VP&DDW>
>54DPVW5$4VG42S5&DRGBLR&&D\V#@EPR@WSKBBP^$8 V5DP^D 32:@LR&DW>$K2BPG:
Extra note: it does something when you pass it a filename. But I'm not telling what :)
Re: Happy New Year!
created: 2006-01-01 10:31:39

This is my humble interpretation at it.

#!/usr/bin/perl
use strict;

## verbosity
my $debug = 0;

# slurp mode, in case we receive a filename
undef $/;

## if there's a filename, read its contents into $_. Otherwise, decode the
## __DATA__. I didn't delve into this as there are no apparent surprises,
## but I must admit that I needed a -MO=Deparse to get to that 's<>><\>>e'
## thingy. I still don't understand how can it be equivalent to
## 's//;/e'.
!@ARGV ? $_ = "@{[
  map {
    chr ($_+43+($_&4)*(3.25+$_%2*7.5))
  } map {
    (7&-32+ord,-32+ord>>3)
  } ( =~ /[ -_]/g)
]}" : s//;/e;
print "bf program in \$_: $_\n" if $debug;

## with $temp, I deobfuscated $_{$*}, which is initially unset
my $temp;
my %bfhash;

## build the hash %bfhash (character => action, character => action, ...)
map {
  if ($temp) {
    ## if $temp has something, this is an even pass, so $_ contains an
    ## action. Store it into $bfhash{$temp} and cleverly unset $temp at the
    ## same time
    ($bfhash{$temp}, $temp) = $_;
  } else {
    ## if $temp hasn't anything, this is an odd pass. Store the bf
    ## command into it.
    $temp = $_;
  }

## return a list (character, action, character, action, ...)
## '$&' in the action gets replaced with '$_[$_]'. Deep magic here.
} map {
  ## $& becomes the first character in each word
  /./;

  ## this eval assigns '$_[$_]' to another instance of $& (the one inside
  ## eval scope).
  ## $' is $POSTMATCH in English, i.e. all characters following $&. Since $&
  ## is the first one, $' is everything starting with the second.
  ## Now, if $' contains the string '$&', it gets replaced with the value
  ## that $& has inside the eval, that is, it becomes '$_[$_]'.
  ($&, eval "q;\$_[\$_]; =~ m'.*'; qq($')")

## this is a list of words which map each character in the brainf*ck
## language into some Perl code. Notice that there are 8 words, and the
## first character of each is one brainf*ck command
} qw/+++$&
     ,$&=ord+getc;$&$'if!defined$&
     ---$&
     <--\$_
     >++\$_
     [while($&){
     ]}
     .print(chr$&)
/;

if ($debug) {
  use Data::Dumper;
  print Data::Dumper->Dump ([\%bfhash], [qw/bfhash/]), "\n";
}

## build the Perl program from $_ and %bfhash. Unset $_.
my @pp;
$_ = !( @pp = (q[@_=()], map $bfhash{$_}, split //) );

## we're going to interpolate @pp into double quotes and want to separate
## each piece of Perl code with ';'
$" =~ s//;/;
 
## finally run our Perl code
print "Perl code: @pp\n\n" if $debug;
eval "@pp";

__DATA__
  UP DZ6U5&&DGJR@WV5$DPVG\DLRVP@D\VVCLR&&D\NBP6\&CD5VP@DWV:#D5VP&DDW>
>54DPVW5$4VG42S5&DRGBLR&&D\V#@EPR@WSKBBP^$8 V5DP^D 32:@LR&DW>$K2BPG:

--
David Serrano

Re^2: Happy New Year!
created: 2006-01-01 11:03:38

Yup, very nice detailed explanation, and there aren't really any surprises in the actual BF interpretation.

## but I must admit that I needed a -MO=Deparse to get to that 's<>><\>>e'
## thingy. I still don't understand how can it be equivalent to
## 's//;/e'.

s<>><\>>e is a s///e where the first pair of delimiters is <>, and the second pair is >>. The replacement eval is <>, because the \ in <\> gets removed earlier as it's right before the same character as the delimiter. It's the same form as s()/<>/e.

I hope you liked it.

perlmonks.org content © perlmonks.org and Hue-Bond, truedfx

prlmnks.org © 2006 edmund von der burg (eccles & toad)

v 0.03