Data-Flow-1.02/ 777 0 0 0 11011671702 7340 5ustar Data-Flow-1.02/Changes 666 0 0 1502 11011671612 10711 0ustar Revision history for Perl extension Request. 0.01 Sat Feb 24 13:12:05 1996 - original version; created by h2xs 1.16 0.03 Renamed to DataFlow 0.04 Renamed to Data::Flow 0.05 Made new() use two arg version of bless to allow subclassing. 0.06 'process' was misdocumented. Correct, and add 'oo_process' which matches the old docs for 'process'. 0.07 Add aget() and oo_output method 0.08 oo_output and SYNOPSYS example made correct. 0.09 New inference type 'self_filter'. New method already_set(). Move test to ./t. Undocumented method unset(). Allow 'prerequisites' to be supplied alone if it sets the value. 1.00 Test suite was relying on presense of cat. Make test suite strict. 1.01 v1.00 was erroneously based on obsolete v0.06. 1.02 Test suite was STILL relying on presense of cat. Data-Flow-1.02/Flow.pm 666 0 0 22276 11011671670 10722 0ustar package Data::Flow; use strict; use vars qw($VERSION @ISA @EXPORT); 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 ($recipes, $data) = @$self; my ($recipe, $request); for $request (@_) { # Bail out if present next if exists $data->{$request}; $recipe = $recipes->{$request}; # Get prerequisites $self->request(@{$recipe->{prerequisites}}) 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__ =head1 NAME Data::Flow - Perl extension for simple-minded recipe-controlled build of data. =head1 SYNOPSIS use Data::Flow; $recipes = { path => { default => './MANIFEST'}, contents => { prerequisites => ['path', 'x'] , process => sub { my $data = shift; $data->{ shift() } = `cat $data->{'path'}` x $data->{'x'}; } }, }; $request = new Data::Flow $recipes; $request->set( x => 1); print $request->get('contents'); tie %request, Data::Flow, $recipes; $request{x} = 1; print $request{contents}; =head1 DESCRIPTION The module Data::Flow provides its services via objects. The objects may be obtained by the usual $request = new Data::Flow $recipes; paradigm. The argument $recipes is a hash reference, which provides the rules for request processing. The objects support three methods, set(), get(), aget(), and already_set(). The first one is used to provide input data for processing, the second one to obtain the output. The third one to obtain a reference to an array with results of repeated get(), and the last one to query whether a field is already known. The unit of requested information is a I. The method set() takes a pair C value>, the methods get() and already_set() take one argument: the C, and the method aget() takes multiple fields. Every object is created without any fields filled, but it knows how to I fields basing on other fields or some global into. This knowledge is provided in the argument $recipe of the new() function. This is a reference to a hash, keyed by I. The values of this hash are hash references themselves, which describe how to acquire the I which is the corresponding key of the initial hash. The internal hashes may have the following keys: =over 8 =item C describes the default value for the key, if none is provided by set(). The value becomes the value of the field of the object. No additional processing is performed. Example: default => $Config{installdir} =item C gives the fields which are needed for the construction of the given field. The corresponding value is an array references. The array contains the I fields. If C did not satisfy the request for a field, but C<$recipe-E{field}{prerequisites}> exists, the I fields are build before any further processing is done. Example: prerequisites => [ qw(prefix arch) ] =item C contains the rule to build the field. The value is a reference to a subroutine taking 2 arguments: the reference to a hash with all the fields which have been set, and the name of the required field. It is up to the subroutine to actually fill the corresponding field of the hash, an error condition is raised if it did not. Example: process => sub { my $data = shift; $data->{time} = localtime(time) } } =item C contains the rule to build the field. The value is a reference to a subroutine taking 2 arguments: the object $request, and the name of the required field. It is up to the subroutine to actually fill the corresponding field of $request, an error condition is raised if it did not. Example: oo_process => sub { my $data = shift; $data->set( time => localtime(time) ) } =item C the corresponing value has the same meaning as for C, but the return value of the subroutine is used as the value of the I. Example: output => sub { localtime(time) } =item C the corresponing value has the same meaning as for C, but the return value of the method is used as the value of the I. Example: output => sub { my $self = shift; $self->get('r') . localtime(time) } =item C contains the rule to build the field basing on other fields. The value is a reference to an array. The first element of the array is a reference to a subroutine, the rest contains names of the fields. When the subroutine is called, the arguments are the values of I of the object $request which appear in the array (in the same order). The return value of the subroutine is used as the value of the I. Example: filter => [ sub { shift + shift }, 'first_half', 'second_half' ] Note that the mentioned field will be automatically marked as prerequisites. =item C is similar to C, but an extra argument, the object itself, is put in front of the list of arguments. Example: self_filter => [ sub { my ($self, $first_half = (shift, shift); $first_half *= -$self->get('total')*100 if $first_half < 0; # negative means percentage $first_half + shift }, 'first_half', 'second_half' ] =item C is similar to C, but the first argument is the name of the method to call, second one is the name of the package to use for the method invocation. The rest contains names of field to provide as method arguments. Example: class_filter => [ 'new', 'FileHandle', 'filename' ] =item C is similar to C, but the second argument is the name of the field which is used to call the method upon. Example: method_filter => [ 'show', 'widget_name', 'current_display' ] =back =head2 Tied interface The access to the same functionality is available via tied hash interface. =head1 AUTHOR Ilya Zakharevich, cpan@ilyaz.org, with multiple additions from Terrence Monroe Brannon and Radoslav Nedyalkov. =head1 SEE ALSO perl(1), make(1). =cut Data-Flow-1.02/Makefile.PL 444 0 0 442 6376650516 11346 0ustar use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Data::Flow', 'dist' => { COMPRESS => gzip, SUFFIX => '.gz'}, 'VERSION_FROM' => 'Flow.pm', # finds $VERSION ); Data-Flow-1.02/MANIFEST 444 0 0 63 10032674016 10505 0ustar Changes MANIFEST Makefile.PL Flow.pm t/Data-Flow.t Data-Flow-1.02/META.yml 666 0 0 445 11011671702 10654 0ustar # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Data-Flow version: 1.02 version_from: Flow.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30 Data-Flow-1.02/t/ 777 0 0 0 11011671702 7603 5ustar Data-Flow-1.02/t/Data-Flow.t 444 0 0 6264 11011671516 11633 0ustar # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) use strict; BEGIN {print "1..12\n";} my $loaded; END {print "not ok 1\n" unless $loaded;} use Data::Flow; $loaded = 1; print "ok 1\n"; ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): sub fcontents { local $/; local *F; my $f = shift; open F, "< $f" or die "Can't open '$f' for read: $!"; scalar ; } my ($recipe,%request); $recipe = { path1 => { default => './MANI'}, obj => { class_filter => ['new', 'A']}, text => { prerequisites => ['contents1'] , output => sub { shift->{contents1} } }, text2 => { prerequisites => ['contents2'] , output => sub { shift->{contents2} } }, text3 => { prerequisites => ['contents3'] , output => sub { shift->{contents3} } }, text4 => { prerequisites => ['text3'] , oo_process => sub { my ($self, $what) = (shift, shift); $self->set($what => $self->get('text3') x 2 ) } }, contents1 => { filter => [ sub { shift }, 'contents' ] }, contents2 => { class_filter => [ 'x', 'A', 'contents1' ] }, contents3 => { method_filter => [ 'x', 'obj', 'contents1' ] }, path3 => { self_filter => [ sub {my $s = shift; $s->get('path2') . shift}, 'path1' ] }, contents => { prerequisites => ['path1', 'path2'] , process => sub { my $data = shift; $data->{ shift() } = fcontents "$data->{path1}$data->{path2}"; }, }, }; #$data = {}; my $request = new Data::Flow $recipe; tie %request, 'Data::Flow', $recipe; #request($recipe, $data, 'text'); my $set1 = $request->already_set('path2'); $request->set('path2', 'FEST'); my $set2 = $request->already_set('path2'); my $mytext = `cat MANIFEST`; # Read differently than tested code (if we can) $mytext = `$^X -pwle0 MANIFEST` unless $mytext; $mytext = do {local $/; local *IN; open IN, 'MANIFEST' and } unless $mytext; print $request->get('text') eq $mytext ? "ok 2\n" : "not ok 2\n"; print $request->get('text2') eq $request->get('text') ? "ok 3\n" : "not ok 3\n"; print $request->get('text3') eq $request->get('text') ? "ok 4\n" : "not ok 4\n"; $request{path2} = 'FEST'; print $request{text} eq $mytext ? "ok 5\n" : "not ok 5\n"; print $request->get('text2') eq $request{text2} ? "ok 6\n" : "not ok 6\n"; print $request->get('text3') eq $request{text3} ? "ok 7\n" : "not ok 7\n"; print $set2 ? "ok 8\n" : "not ok 8\n"; print ! $set1 ? "ok 9\n" : "not ok 9\n"; print $request->get('path3') eq 'FEST./MANI' ? "ok 10\n" : "not ok 10\n"; print $request->get('text4') eq ($request{text3} x 2) ? "ok 11\n" : "not ok 11\n"; my $a = $request->aget('text4', 'text3'); print "@$a" eq ($request{text3} x 2 . " " . $request{text3}) ? "ok 12\n" : "not ok 12\n"; package A; sub x {shift; shift} sub new {bless []}