File Coverage

blib/lib/Verby/Step/Closure.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             package Verby::Step::Closure;
4 2     2   226865 use Moose;
  0            
  0            
5              
6             with qw/Verby::Step::Simple/;
7              
8             extends qw(Moose::Object Exporter);
9              
10             our @EXPORT = "step";
11             our @EXPORT_OK = ( @EXPORT, qw(chain_steps) );
12              
13             our $VERSION = "0.05";
14              
15             use overload '""' => 'stringify';
16              
17             use Class::Inspector;
18             use Carp qw/croak/;
19              
20             use POE;
21              
22             #my $id;
23             #has id => (
24             # isa => "Int",
25             # is => "ro",
26             # init_arg => undef,
27             # default => sub { ++$id },
28             #);
29              
30             has pre => (
31             isa => "CodeRef",
32             is => "rw",
33             );
34              
35             has post => (
36             isa => "CodeRef",
37             is => "rw",
38             );
39              
40             has provides_cxt => (
41             isa => "Bool",
42             is => "rw",
43             );
44              
45             sub is_satisfied {
46             my $self = shift;
47             $self->_wrapped("verify", @_);
48             }
49              
50             sub do {
51             my $self = shift;
52             $self->_wrapped("do", @_);
53             }
54              
55             sub _wrapped {
56             my ( $self, $action_method, @args ) = @_;
57             my ( $c, $poe ) = @args;
58              
59             if (my $pre_hook = $self->pre){
60             $self->$pre_hook(@args);
61             }
62            
63             if (my $post_hook = $self->post){
64             my $heap = $poe_kernel->get_active_session->get_heap;
65              
66             push @{ $heap->{post_hooks} }, sub { $self->$post_hook(@args) };
67             }
68              
69             $self->action->$action_method(@args);
70             }
71              
72             sub step ($;%) {
73             my ( $action, @args ) = @_;
74              
75             if ( @args == 1 ) {
76             unshift @args, "pre";
77             } elsif ( ref $args[0] and ref $args[0] ) {
78             my ( $pre, $post ) = splice @args, 0, 2;
79             unshift @args, pre => $pre, post => $post;
80             }
81              
82             my %args = @args;
83              
84             unless (blessed $action){
85             unless (Class::Inspector->loaded($action)) {
86             (my $file = "${action}.pm") =~ s{::}{/}g;
87             require $file;
88             }
89              
90             $action = $action->new;
91             }
92              
93             if ( exists $args{depends} and ref $args{depends} and ref $args{depends} ne 'ARRAY' ) {
94             warn "$args{depends} is not an array";
95             $args{depends} = [ $args{depends} ];
96             }
97              
98             my $step = Verby::Step::Closure->new(
99             %args,
100             action => $action
101             );
102              
103             $step;
104             }
105              
106             sub chain_steps {
107             my ( $head, @tail ) = @_;
108              
109             return unless $head;
110              
111             return $head unless @tail;
112              
113             my @rest = chain_steps(@tail);
114              
115             $rest[0]->add_deps($head);
116            
117             if ( wantarray ) {
118             return ( $head, @rest );
119             } else {
120             return $rest[-1];
121             }
122             }
123              
124             sub stringify {
125             my $self = shift;
126             ref $self->action || $self->action;
127             }
128              
129             __PACKAGE__
130              
131             __END__
132              
133             =pod
134              
135             =head1 NAME
136              
137             Verby::Step::Closure - Quick and dirty (in the fun sense, like playing with
138             mud) step generator.
139              
140             =head1 SYNOPSIS
141              
142             use Verby::Step::Closure qw/step/;
143              
144             my $s = step "Action::Class" => sub {
145             # called before action
146             }, sub {
147             # called after action
148             };
149              
150             =head1 DESCRIPTION
151              
152             This module eases the creation of step objects, by using closures and
153             accessors. It's purpose is to be able to rapidly create simple steps based on
154             an action class and some clalbacks.
155              
156             Since L<Verby::Action> and L<Verby::Step> are separated, this may lead to
157             unnecessary typing, class creation, or other silly crap.
158             L<Verby::Step::Closure>'s purpose is to make this boundry unnoticable, so that
159             when you don't need it it doesn't get in your way.
160              
161             =head1 EXPORTED FUNCTIONS
162              
163             =over 4
164              
165             =item B<step $action_class ?$pre ?$post>
166              
167             This function (optionally exportable) is used as a quick and dirty constructor.
168              
169             It will require $action_class with L<UNIVERSAL::require>, and then create a new
170             L<Verby::Step::Closure> with the C<action> field set to an instance.
171              
172             =back
173              
174             =head1 METHODS
175              
176             =over 4
177              
178             =item B<new $action_class ?$pre ?$post>
179              
180             Creates a new anonymous step.
181              
182             =item B<depends *@steps>
183              
184             Just a plain old accessor.
185              
186             =item B<add_deps *@steps>
187              
188             Append more steps to the dep list.
189              
190             =item B<is_satisfied>
191              
192             Calls the pre hook, C<verify> and then the post hook.
193              
194             =item B<do>
195              
196             Calls the pre hook, C<do>, and lastly the post hook.
197              
198             =item B<stringify>
199              
200             Stringifies to the action's class.
201              
202             =item B<get>
203              
204             =item B<set>
205              
206             Replacements for L<Class::Accessor>'s methods that convert between lists and
207             array references.
208              
209             =item B<can $method>
210              
211             A special case of L<UNIVERSAL/can> that will return false for methods the
212             action can't fulfill.
213              
214             =back
215              
216             =head1 EXAMPLE
217              
218             The test files, as well as the demo scripts make extensive use of
219             L<Verby::Step::Closure>. Look at F<scripts/module_builder.pl> for some
220             documented usage.
221              
222             =head1 BUGS
223              
224             None that we are aware of. Of course, if you find a bug, let us know, and we will be sure to fix it.
225              
226             =head1 CODE COVERAGE
227              
228             We use B<Devel::Cover> to test the code coverage of the tests, please refer to COVERAGE section of the L<Verby> module for more information.
229              
230             =head1 SEE ALSO
231              
232             =head1 AUTHOR
233              
234             Yuval Kogman, E<lt>nothingmuch@woobling.orgE<gt>
235              
236             =head1 COPYRIGHT AND LICENSE
237              
238             Copyright 2005-2008 by Infinity Interactive, Inc.
239              
240             L<http://www.iinteractive.com>
241              
242             This library is free software; you can redistribute it and/or modify
243             it under the same terms as Perl itself.
244              
245             =cut