Skip Menu |
 

This queue is for tickets about the Data-Flow CPAN distribution.

Report information
The Basics
Id: 43206
Status: new
Priority: 0/
Queue: Data-Flow

People
Owner: Nobody in particular
Requestors: info1 [...] wolframhumann.de
Cc:
AdminCc:

Bug Information
Severity: Normal
Broken in: 1.02
Fixed in: (no value)



Subject: Cyclic prerequisites cause deep recursion
Download (untitled) / with headers
text/plain 1.6k
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
Download Flow.pm
text/x-perl 4.1k
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__


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.