File Coverage

blib/lib/Flow/Code.pm
Criterion Covered Total %
statement 12 25 48.0
branch 0 8 0.0
condition 0 5 0.0
subroutine 4 6 66.6
pod 1 1 100.0
total 17 45 37.7


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # DESCRIPTION:
4             #
5             # AUTHOR: Aliaksandr P. Zahatski,
6             #===============================================================================
7             #$Id$
8             =head1 NAME
9              
10             Flow::Code - process flow by user defined code
11              
12             =head1 SYNOPSIS
13              
14             my $f1 = Flow::create_flow(
15             Splice => 200,
16             Join => {
17             Data => Flow::create_flow(
18             sub {
19             return [ grep { $_ > 10 } @_ ];
20             },
21             Splice => 10
22              
23             ),
24             Min => Flow::create_flow(
25             sub {
26             return [ grep { $_ == 1 } @_ ];
27             },
28             Splice => 40,
29             )
30             },
31             ToXML => \$s,
32             );
33             $f1->run( 1, 3, 11 );
34              
35             =cut
36              
37             package Flow::Code;
38 8     8   44 use strict;
  8         15  
  8         288  
39 8     8   43 use warnings;
  8         15  
  8         239  
40 8     8   43 use base 'Flow';
  8         13  
  8         1062  
41              
42             =head2 new
43              
44             new Flow::Code:: { flow=>sub{ shift; [] }[, begin=>sub{ shift ..}, end .., cnt_flow=>... };
45             new Flow::Code:: sub{ \@_ } #default handle flow
46             =cut
47              
48             foreach my $method ( "begin", "flow", "ctl_flow", "end" ) {
49             my $s_method = "SUPER::" . $method;
50 8     8   45 no strict 'refs';
  8         26  
  8         2830  
51             *{ __PACKAGE__ . "::$method" } = sub {
52 0     0     my $self = shift;
53 0 0         if ( my $code = $self->{ "_" . $method } ) {
    0          
54 0           return &$code(@_);
55             }
56             elsif ( my $code_s = $self->{$method} ) {
57 0           return &$code_s( $self, @_ );
58             }
59             else {
60 0           return $self->$s_method(@_);
61             }
62             };
63             }
64              
65             sub new {
66 0     0 1   my $class = shift;
67 0 0 0       if ( $#_ == 0 and ref( $_[0] ) eq 'CODE' ) {
68 0           unshift @_, '_flow';
69             }
70 0           my $self = $class->SUPER::new(@_);
71              
72             #clean up hnot valided handlers
73 0           foreach my $method (qw/ begin flow ctl_flow end /) {
74 0   0       my $code = $self->{$method} || next;
75 0 0         delete $self->{$method} unless ref($code) eq 'CODE';
76             }
77 0           return $self;
78             }
79              
80             1;
81              
82             __END__