File Coverage

blib/lib/Flow.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # DESCRIPTION: Flow - Make data flow processing easy
4             #
5             # AUTHOR: Aliaksandr P. Zahatski,
6             #===============================================================================
7              
8             =head1 NAME
9              
10             Flow - Make data flow processing easy
11              
12             =head1 SYNOPSIS
13              
14             use Flow;
15             my $flow = create_flow( Splice=>20, sub{ [ grep { $_ > 1 } @_ ] } )
16              
17             my $c1 = new Flow::Code:: {
18             flow => sub { my $self = shift; $self->{count_}++ for @_; return},
19             end => sub {
20             my $self = shift;
21             $self->put_flow( $self->{count_} );
22             [@_]
23             }
24             };
25             create_flow( $c1, new Flow::To::XML::(\$str) );
26             $c1->run(1..1000);
27              
28            
29             =head1 DESCRIPTION
30              
31             Flow - a set of modules for data flow processing.
32              
33             =cut
34              
35             package Flow;
36 8     8   33897 use Flow::Code;
  8         14  
  8         188  
37 8     8   2827 use Flow::Splice;
  8         19  
  8         236  
38 8     8   2613 use Flow::To::XML;
  2         2  
  2         35  
39 2     2   649 use Flow::To::JXML;
  2         6  
  2         64  
40 2     2   848 use Flow::From::JXML;
  0            
  0            
41             use Flow::From::XML;
42             use Flow::Join;
43             use Flow::Split;
44             use Flow::Grep;
45             use strict;
46             use warnings;
47              
48             #require Exporter;
49             use Exporter;
50             our @ISA = qw(Exporter);
51             our @EXPORT = qw(create_flow);
52             our $VERSION = '1.01';
53             use constant MODS_MAP => {
54             Splice => 'Flow::Splice',
55             Join => 'Flow::Join',
56             ToXML => 'Flow::To::XML',
57             Code => 'Flow::Code',
58             FromXML => 'Flow::From::XML',
59             Split => 'Flow::Split',
60             ToJXML => 'Flow::To::JXML',
61             FromJXML => 'Flow::From::JXML',
62             Grep => 'Flow::Grep'
63             };
64              
65             our %tmp_map = %{ (MODS_MAP) };
66              
67             sub define_event {
68             __make_methods($_) for @_;
69             }
70              
71             sub __make_methods {
72             my $method = shift;
73             no strict 'refs';
74             my $put_method = "put_${method}";
75             my $pivate_method = "_${method}";
76             *{ __PACKAGE__ . "::$method" } = sub {
77             my $self = shift;
78             return $self->$put_method(@_);
79             };
80             *{ __PACKAGE__ . "::$put_method" } = sub {
81             my $self = shift;
82             if ( my $h = $self->__handler ) {
83             return $h->$pivate_method(@_);
84             }
85              
86             #clear return results
87             return;
88             };
89              
90             *{ __PACKAGE__ . "::$pivate_method" } = sub {
91             my $self = shift;
92             my $res = $self->$method(@_);
93            
94             #ERROR STATE
95             return $res unless ref($res);
96             if ( ref($res) eq 'ARRAY' ) {
97             return $self->$put_method(@$res);
98             }
99             };
100             }
101              
102             define_event( "begin", "flow", "ctl_flow", "end" );
103              
104             sub import {
105             my ($class) = shift;
106             __PACKAGE__->export_to_level( 1, $class, 'create_flow' );
107             while ( my ( $alias, $module ) = splice @_, 0, 2 ) {
108             if ( defined($alias) && defined($module) ) {
109             $tmp_map{$alias} = $module;
110             }
111             }
112             }
113              
114             =head1 FUNCTIONS
115              
116             =head2 create_flow "MyFlow::Pack"=>{param1=>$val},$my_flow_object, "MyFlow::Pack1"=>12, "MyFlow::Pack3"=>{}
117              
118             Use last arg as handler for out.
119              
120             return flow object ref.
121              
122             my $h1 = new MyHandler1::;
123             my $flow = create_flow( 'MyHandler1', $h1 );
124             #also create pipe of flows
125             my $filter1 = create_flow( 'MyHandler1'=>{}, 'MyHandler2'=>{} );
126             my $h1 = new MyHandler3::;
127             my $flow = create_flow( $filter1, $h1);
128              
129             =cut
130              
131             sub create_flow {
132              
133             #firest make objects
134             my @objects = ();
135             while ( $#_ >= 0 ) {
136             my $method = shift @_;
137              
138             #if object ?
139             if ( ref($method) ) {
140             if ( ref($method) eq 'CODE' ) {
141              
142             #use Flow::Code by default
143             $method = new Flow::Code:: $method;
144             }
145             if ( UNIVERSAL::isa( $method, "Flow" ) ) {
146             push @objects, $method;
147             next;
148             }
149             die "bad method $method";
150             }
151             my $param = shift @_;
152             if ( defined $tmp_map{$method} ) {
153             $method = $tmp_map{$method};
154             }
155             push @objects, $method->new($param);
156             }
157             my @in = reverse map { split_flow($_) } @objects;
158             my $next_handler = shift @in;
159             foreach my $f (@in) {
160             die "$f not isa of Flow::" unless UNIVERSAL::isa( $f, "Flow" );
161             $f->set_handler($next_handler);
162             $next_handler = $f;
163             }
164             return $next_handler;
165             }
166              
167             =head2 split_flow $flow
168              
169             Return array of handlers
170              
171             =cut
172              
173             sub split_flow {
174             my $obj = shift;
175             if ( @_ > 1 ) {
176             return split_flow($_) for @_;
177             }
178             my @res = ($obj);
179             if ( my $h = $obj->get_handler ) {
180             push @res, split_flow($h);
181             }
182             @res;
183             }
184             =head1 METHODS
185              
186             =cut
187             sub new {
188             my $class = shift;
189             $class = ref($class) || $class;
190             my $opt = ( $#_ == 0 ) ? shift : {@_};
191             my $self = bless( $opt, $class );
192             return $self;
193             }
194              
195             sub set_handler {
196             my $self = shift;
197             my $handler = shift;
198             if ( UNIVERSAL::isa( $handler, 'Flow' ) ) {
199             $self->__handler($handler);
200             }
201             }
202              
203             sub get_handler {
204             my $self = shift;
205             return $self->__handler();
206             }
207              
208             sub __handler {
209             my $self = shift;
210             if (@_) {
211             $self->{Handler} = shift @_;
212             }
213             return $self->{Handler};
214             }
215              
216             sub parser {
217             my $self = shift;
218             my $run_flow = Flow::create_flow( __PACKAGE__->new(), $self );
219             return $run_flow;
220             }
221              
222             sub run {
223             my $self = shift;
224             my $p = $self->parser;
225             $p->begin();
226             $p->flow(@_);
227             $p->end();
228             }
229             1;
230             __END__