r31580 - in /branches/upstream/libdata-flow-perl: ./ current/ current/Changes current/Flow.pm current/MANIFEST current/Makefile.PL current/t/ current/t/Data-Flow.t
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Sat Mar 7 02:00:54 UTC 2009
Author: ryan52-guest
Date: Sat Mar 7 02:00:49 2009
New Revision: 31580
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=31580
Log:
[svn-inject] Installing original source of libdata-flow-perl
Added:
branches/upstream/libdata-flow-perl/
branches/upstream/libdata-flow-perl/current/
branches/upstream/libdata-flow-perl/current/Changes
branches/upstream/libdata-flow-perl/current/Flow.pm
branches/upstream/libdata-flow-perl/current/MANIFEST
branches/upstream/libdata-flow-perl/current/Makefile.PL
branches/upstream/libdata-flow-perl/current/t/
branches/upstream/libdata-flow-perl/current/t/Data-Flow.t
Added: branches/upstream/libdata-flow-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-flow-perl/current/Changes?rev=31580&op=file
==============================================================================
--- branches/upstream/libdata-flow-perl/current/Changes (added)
+++ branches/upstream/libdata-flow-perl/current/Changes Sat Mar 7 02:00:49 2009
@@ -1,0 +1,16 @@
+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.
Added: branches/upstream/libdata-flow-perl/current/Flow.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-flow-perl/current/Flow.pm?rev=31580&op=file
==============================================================================
--- branches/upstream/libdata-flow-perl/current/Flow.pm (added)
+++ branches/upstream/libdata-flow-perl/current/Flow.pm Sat Mar 7 02:00:49 2009
@@ -1,0 +1,307 @@
+package Data::Flow;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+
+require Exporter;
+require AutoLoader;
+
+ at 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.
+ at EXPORT = qw(
+);
+$VERSION = '0.09';
+
+
+# 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<field>. The method set()
+takes a pair C<field =E<gt> value>, the methods get() and already_set() take one
+argument: the C<field>, and the method aget() takes multiple fields.
+
+Every object is created without any fields filled, but it knows how to
+I<construct> 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<fields>. The
+values of this hash are hash references themselves, which describe how
+to acquire the I<field> which is the corresponding key of the initial
+hash.
+
+The internal hashes may have the following keys:
+
+=over 8
+
+=item C<default>
+
+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<prerequisites>
+
+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<required> fields.
+
+If C<defaults> did not satisfy the request for a field, but
+C<$recipe-E<gt>{field}{prerequisites}> exists, the I<required>
+fields are build before any further processing is done. Example:
+
+ prerequisites => [ qw(prefix arch) ]
+
+=item C<process>
+
+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<oo_process>
+
+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<output>
+
+the corresponing value has the same meaning as for C<process>, but the
+return value of the subroutine is used as the value of the
+I<field>. Example:
+
+ output => sub { localtime(time) }
+
+=item C<oo_output>
+
+the corresponing value has the same meaning as for C<process>, but the
+return value of the method is used as the value of the
+I<field>. Example:
+
+ output => sub { my $self = shift; $self->get('r') . localtime(time) }
+
+
+=item C<filter>
+
+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<fields> 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<field>. Example:
+
+ filter => [ sub { shift + shift },
+ 'first_half', 'second_half' ]
+
+Note that the mentioned field will be automatically marked as
+prerequisites.
+
+=item C<self_filter>
+
+is similar to C<filter>, 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<class_filter>
+
+is similar to C<filter>, 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<method_filter>
+
+is similar to C<class_filter>, 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 at ilyaz.org, with multiple additions from
+Terrence Monroe Brannon and Radoslav Nedyalkov.
+
+=head1 SEE ALSO
+
+perl(1), make(1).
+
+=cut
Added: branches/upstream/libdata-flow-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-flow-perl/current/MANIFEST?rev=31580&op=file
==============================================================================
--- branches/upstream/libdata-flow-perl/current/MANIFEST (added)
+++ branches/upstream/libdata-flow-perl/current/MANIFEST Sat Mar 7 02:00:49 2009
@@ -1,0 +1,5 @@
+Changes
+MANIFEST
+Makefile.PL
+Flow.pm
+t/Data-Flow.t
Added: branches/upstream/libdata-flow-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-flow-perl/current/Makefile.PL?rev=31580&op=file
==============================================================================
--- branches/upstream/libdata-flow-perl/current/Makefile.PL (added)
+++ branches/upstream/libdata-flow-perl/current/Makefile.PL Sat Mar 7 02:00:49 2009
@@ -1,0 +1,8 @@
+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
+);
Added: branches/upstream/libdata-flow-perl/current/t/Data-Flow.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-flow-perl/current/t/Data-Flow.t?rev=31580&op=file
==============================================================================
--- branches/upstream/libdata-flow-perl/current/t/Data-Flow.t (added)
+++ branches/upstream/libdata-flow-perl/current/t/Data-Flow.t Sat Mar 7 02:00:49 2009
@@ -1,0 +1,99 @@
+# 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.)
+
+BEGIN {print "1..12\n";}
+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 <F>;
+}
+
+$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');
+
+print $request->get('text') eq `cat MANIFEST`
+ ? "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 `cat MANIFEST`
+ ? "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 []}
More information about the Pkg-perl-cvs-commits
mailing list