| Subject: | Cyclic prerequisites cause deep recursion |
In version 1.02 there is no safequard against prerequisites that form a
cyclic dependency. Consider the following example:
use Data::Flow;
my $recipes =
{
power => {
prerequisites => ['base', 'exp'] ,
output => sub { print "p\n"; $_[0]{base} ** $_[0]{exp} },
},
base => {
prerequisites => ['power', 'exp'] ,
output => sub {exp( log($_[0]{power}) / $_[0]{exp} )},
},
exp => {
prerequisites => ['base', 'power'] ,
output => sub { log($_[0]{power}) / log($_[0]{base}) },
},
};
my $calc = new Data::Flow $recipes;
$calc->set( power => 32);
$calc->set( exp => 5);
print $calc->get('base'), "\n"; # calculates base; prints "2"
$calc->unset('exp');
print $calc->get('base'), "\n"; # still returns "2" (from cache)
$calc->unset('base');
print $calc->get('base'), "\n"; # Deep recursion on subroutine
# "Data::Flow::request"
If this happen in a more complex setup I'm left with a hanging program
and an error message that dosn't tell me where to look for the bug.
Attached is a modified version (minus the pod) where I tried to catch
this problem. I hope I understood the module well enough not to
introduce new bugs ...:-). Now the last line results in a croak:
Cyclic prerequisites: 'base -> exp -> base' at ... line ...
On thing I'm not too happy about: in order to confine changes to the
request() sub, I allowed the second parameter to be either a scalar or
an array-ref. Maybe it should be an array-ref always, and calls like
request($foo) changed to request([$foo]).
Feel free to use all, parts, just ideas or nothing at all fromm the
attached file.
| Subject: | Flow.pm |
package Data::Flow;
use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT);
use Carp qw(croak);
require Exporter;
require AutoLoader;
@ISA = qw(Exporter AutoLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
);
$VERSION = '1.02'; # The only change 0.09 --> 1.02 is this line ;-)
# Preloaded methods go here.
sub new {
die "Usage: new Data::Flow \$recipes" unless @_ == 2;
my $class = shift;
my $recipes = shift;
$recipes = bless [$recipes, {}], $class;
# $recipes->set(@_);
$recipes;
}
sub set {
my $self = shift;
die "Odd number of data given to Data::Flow::set" if @_ % 2;
my %data = @_;
@{$self->[1]}{keys %data} = values %data;
}
sub unset {
my ($self, $f) = shift;
for $f (@_) {
delete $self->[1]{$f}
}
}
sub get {
my $self = shift;
my $request = shift;
$self->request($request);
$self->[1]->{$request};
}
sub aget {
my $self = shift;
[map { $self->request($_); $self->[1]->{$_} } @_]
}
sub already_set {
my $self = shift;
my $request = shift;
exists $self->[1]->{$request};
}
sub request {
my $self = shift;
my $requests = shift;
my $seen = shift || {};
my ($recipes, $data) = @$self;
my ($recipe, $request);
for $request (ref $requests ? @$requests : $requests) {
# Bail out if present
next if exists $data->{$request};
# Can't fulfill request if prerequisites are cyclic
if (exists $seen->{$request})
{
my $cycle = join ' -> ', sort{ $seen->{$a} <=> $seen->{$b} } keys %$seen;
croak "Cyclic prerequisites: '$cycle -> $request'";
}
$recipe = $recipes->{$request};
# Get prerequisites
$self->request($recipe->{prerequisites}, {%$seen, $request => scalar keys %$seen})
if exists $recipe->{prerequisites};
# Check for default value
if (exists $recipe->{default}) {
$data->{$request} = $recipe->{default};
next;
} elsif (exists $recipe->{process}) { # Let it do the work itself.
&{$recipe->{process}}($data, $request);
die "The recipe for processing the request `$request' did not acquire it"
unless exists $data->{$request};
} elsif (exists $recipe->{oo_process}) { # Let it do the work itself.
&{$recipe->{oo_process}}($self, $request);
die "The recipe for OO-processing the request `$request' did not acquire it"
unless exists $data->{$request};
} elsif (exists $recipe->{output}) { # Keep return value.
$data->{$request} = &{$recipe->{output}}($data, $request);
} elsif (exists $recipe->{oo_output}) { # Keep return value.
$data->{$request} = &{$recipe->{oo_output}}($self, $request);
} elsif (exists $recipe->{filter}) { # Input comes from $data
my @arr = @{ $recipe->{filter} };
my $sub = shift @arr;
foreach (@arr) { $self->request($_) }
@arr = map $data->{$_}, @arr;
$data->{$request} = &$sub( @arr );
} elsif (exists $recipe->{self_filter}) { # Input comes from $data
my @arr = @{ $recipe->{self_filter} };
my $sub = shift @arr;
foreach (@arr) { $self->request($_) }
@arr = map $data->{$_}, @arr;
$data->{$request} = &$sub( $self, @arr );
} elsif (exists $recipe->{method_filter}) { # Input comes from $data
my @arr = @{ $recipe->{method_filter} };
my $method = shift @arr;
foreach (@arr) { $self->request($_) }
@arr = map $data->{$_}, @arr;
my $obj = shift @arr;
$data->{$request} = $obj->$method( @arr );
} elsif (exists $recipe->{class_filter}) { # Input comes from $data
my @arr = @{ $recipe->{class_filter} };
my $method = shift @arr;
my $class = shift @arr;
foreach (@arr) { $self->request($_) }
@arr = map $data->{$_}, @arr;
$data->{$request} = $class->$method( @arr );
} else {
die "Do not know how to satisfy the request `$request'"
unless exists $data->{$request}; # 'prerequisites' could set it
}
}
}
*TIEHASH = \&new;
*STORE = \&set;
*FETCH = \&get;
# Autoload methods go after =cut, and are processed by the autosplit program.
1;
__END__