[SPOILER] Perl 'Expert' Quiz-of-the-Week #24

Hi,

Hopefully I am not too early. According to MJD's
When-is-it-ok-to-send-spoilers-script I shouldn't be.

I came up with a quite simple solution actually. I just assign a boolean
value to each macro (true when all modules listed therein have at least
the given version, false otherwise), replaced the macro tags with the
boolean values and then simply call Safe::reval() on it. Reporting of
unsatisfied dependencies is still unsatisfactory though, I'll add that
in the next evolution of the script.

#!/usr/bin/perl -w

use strict;

my $requires = {
    'mail' => q[ {mailtools} || {mboxparser} ],
    '{mailtools}' => {
        'Mail::Internet' => 5,
    },
    '{mboxparser}' => {
        'Mail::MboxParser' => 1,
        'MIME::Parser' => 6,
    }
};

my $pre = Prereq::Expr->new($requires);
print $pre->evaluate, "\n";

package Prereq::Expr;
use Versions;
use Carp;
use Safe;
use strict;

sub new {
    my ($class, $spec) = @_;
    my (%macros, %prereq);
    while (my ($k, $v) = each %$spec) {
        if ($k =~ /^\{/) {
            $macros{$k} = $v;
        } else {
            $prereq{$k} = $v;
        }
    }
    bless {
        macros => \%macros,
        prereq => \%prereq,
    } => $class;
}

sub evaluate {
    my $self = shift;
    for (keys %{ $self->{macros} }) {
        my $ok = 1;
        
        # need to reset iterator, otherwise it is not re-entrant and 
        # 'evaluate' wont work on successive invocations on the same
        # object.
        keys %{ $self->{macros}->{$_} };
        
        while (my ($mod, $ver) = each %{ $self->{macros}->{$_} }) {
            $ok = 0, last if $ver > Versions->from_module($mod);
        }
        $self->{macros_evaled}->{$_} = $ok;
    }        
    
    my $safe = Safe->new;
    for (keys %{ $self->{prereq} }) {
        my $expr = $self->{prereq}->{$_};
        $expr =~ s/(\{.*?\})/$self->{macros_evaled}->{$1}/g;
        my $ok = $safe->reval($expr);
        croak $@ if $@;
        if (! $ok) {
            carp "Unsatisfied dependency in '$_'\n";
            return 0;
        }
    }
    return 1;
}

Cheers,
Tassilo
-- 
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval