File Coverage

blib/lib/POE/Component/SmokeBox.pm
Criterion Covered Total %
statement 108 127 85.0
branch 22 36 61.1
condition 11 20 55.0
subroutine 19 22 86.3
pod 9 9 100.0
total 169 214 78.9


line stmt bran cond sub pod time code
1             package POE::Component::SmokeBox;
2             $POE::Component::SmokeBox::VERSION = '0.54';
3             #ABSTRACT: POE enabled CPAN smoke testing with added value.
4              
5 11     11   8797 use strict;
  11         24  
  11         317  
6 11     11   127 use warnings;
  11         22  
  11         319  
7 11     11   917 use POE qw(Component::SmokeBox::Backend Component::SmokeBox::JobQueue);
  11         69377  
  11         79  
8 11     11   633 use POE::Component::SmokeBox::Smoker;
  11         26  
  11         225  
9 11     11   69 use POE::Component::SmokeBox::Job;
  11         24  
  11         203  
10 11     11   51 use POE::Component::SmokeBox::Result;
  11         22  
  11         15652  
11              
12             sub spawn {
13 9     9 1 1626 my $package = shift;
14 9         34 my %params = @_;
15 9         54 $params{lc $_} = delete $params{$_} for keys %params;
16 9         26 my $options = delete $params{'options'};
17 9 100       40 $params{'delay'} = 0 unless exists $params{'delay'};
18 9         24 my $self = bless \%params, $package;
19 9 100       146 $self->{session_id} = POE::Session->create(
20             object_states => [
21             $self => {
22             shutdown => '_shutdown',
23             add_smoker => '_add_smoker',
24             del_smoker => '_del_smoker',
25             submit => '_submit',
26             register_ui => '_reg_ui',
27             unregister_ui => '_unreg_ui',
28             },
29             $self => [qw(_start)],
30             ],
31             heap => $self,
32             ( ref($options) eq 'HASH' ? ( options => $options ) : () ),
33             )->ID();
34 9         1492 return $self;
35             }
36              
37             sub session_id {
38 45     45 1 1523 return $_[0]->{session_id};
39             }
40              
41             sub multiplicity {
42 2     2 1 841 return $_[0]->{multiplicity};
43             }
44              
45             sub delay {
46 3 50   3 1 406 if ( defined $_[1] ) {
47             # verify it's an int
48 0 0       0 if ( $_[1] !~ /^\d+$/ ) {
49 0         0 return;
50             } else {
51 0         0 $_[0]->{delay} = $_[1];
52 0         0 return $_[1];
53             }
54             } else {
55 3         15 return $_[0]->{delay};
56             }
57             }
58              
59             sub queues {
60 20     20 1 2680 return map { $_->{queue} } @{ $_[0]->{queues} };
  33         192  
  20         81  
61             }
62              
63             sub shutdown {
64 9     9 1 4540 my $self = shift;
65 9         95 $poe_kernel->call( $self->session_id() => 'shutdown' => @_ );
66             }
67              
68             sub _start {
69 9     9   3315 my ($kernel,$self) = @_[KERNEL,OBJECT];
70 9         50 $self->{session_id} = $_[SESSION]->ID();
71 9 50       61 if ( $self->{alias} ) {
72 0         0 $kernel->alias_set( $self->{alias} );
73             }
74             else {
75 9         92 $kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
76             }
77 9         419 $self->{queues} = [ ];
78 9         27 my $smokers = delete $self->{smokers};
79 9 50 66     264 return unless $smokers and ref $smokers eq 'ARRAY' and scalar @{ $smokers };
  6   100     40  
80 6         13 $self->add_smoker( $_ ) for @{ $smokers };
  6         25  
81 6         52 return;
82             }
83              
84             sub _shutdown {
85 9     9   866 my ($kernel,$self) = @_[KERNEL,OBJECT];
86 9 50       93 if ( $self->{alias} ) {
87 0         0 $kernel->alias_remove($_) for $kernel->alias_list();
88             }
89             else {
90 9         59 $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ );
91             }
92 9         523 $_->{queue}->shutdown() for @{ $self->{queues} };
  9         89  
93 9         195 return;
94             }
95              
96             sub add_smoker {
97 31     31 1 168 my $self = shift;
98 31         118 $poe_kernel->call( $self->{session_id}, 'add_smoker', @_ );
99             }
100              
101             sub del_smoker {
102 11     11 1 82354 my $self = shift;
103 11         111 $poe_kernel->call( $self->{session_id}, 'del_smoker', @_ );
104             }
105              
106             sub _add_smoker {
107 31     31   1878 my ($kernel,$self,$state,$sender,$smoker) = @_[KERNEL,OBJECT,STATE,SENDER,ARG0];
108 31 50 33     246 unless ( $smoker and $smoker->isa('POE::Component::SmokeBox::Smoker') ) {
109 0         0 warn "ARG0 must be a 'POE::Component::SmokeBox::Smoker' object\n";
110 0         0 return;
111             }
112             # If no jobqueues start a job queue.
113             # If multiplicity start a job queue for each smoker object.
114 31 100 100     103 if ( $self->{multiplicity} or scalar @{ $self->{queues} } == 0 ) {
  21         69  
115 17         49 my $queue = { };
116             $queue->{queue} = POE::Component::SmokeBox::JobQueue->spawn(
117             'delay' => $self->{delay},
118 17         81 );
119 17         41 push @{ $queue->{smokers} }, $smoker;
  17         45  
120 17         30 push @{ $self->{queues} }, $queue;
  17         37  
121 17         58 return;
122             }
123             # Otherwise we just add the smoker to our existing queue
124 14         25 push @{ $self->{queues}->[0]->{smokers} }, $smoker;
  14         32  
125 14         36 return;
126             }
127              
128             sub _del_smoker {
129 11     11   1276 my ($kernel,$self,$state,$sender,$smoker) = @_[KERNEL,OBJECT,STATE,SENDER,ARG0];
130 11 50 33     244 unless ( $smoker and $smoker->isa('POE::Component::SmokeBox::Smoker') ) {
131 0         0 warn "ARG0 must be a 'POE::Component::SmokeBox::Smoker' object\n";
132 0         0 return;
133             }
134 11         59 my $x = 0;
135 11         47 foreach my $queue ( @{ $self->{queues} } ) {
  11         95  
136 17         66 my $i = 0;
137 17         44 for ( @{ $queue->{smokers} } ) {
  17         69  
138 29 100       135 splice(@{ $queue->{smokers} }, $i, 1) if $_ == $smoker;
  8         53  
139 29         72 ++$i;
140             }
141 17 100       50 unless ( scalar @{ $queue->{smokers} } ) {
  17         111  
142 3         17 splice(@{ $self->{queues} }, $x, 1);
  3         10  
143 3         35 $queue->{queue}->shutdown();
144             }
145 17         137 ++$x;
146             }
147 11         61 return;
148             }
149              
150             sub submit {
151 0     0 1 0 my $self = shift;
152 0         0 $poe_kernel->call( $self->{session_id}, 'submit', @_ );
153             }
154              
155             sub _submit {
156 36     36   5598 my ($kernel,$self,$state,$sender) = @_[KERNEL,OBJECT,STATE,SENDER];
157 36 50       105 return if $self->{_shutdown};
158 36         884 my $args;
159 36 50       964 if ( ref( $_[ARG0] ) eq 'HASH' ) {
160 0         0 $args = { %{ $_[ARG0] } };
  0         0  
161             }
162             else {
163 36         133 $args = { @_[ARG0..$#_] };
164             }
165              
166 36         83 $args->{lc $_} = delete $args->{$_} for grep { $_ !~ /^_/ } keys %{ $args };
  72         294  
  36         114  
167              
168 36 50       882 unless ( $args->{event} ) {
169 0         0 warn "No 'event' specified for $state\n";
170 0         0 return;
171             }
172              
173 36 50 33     1114 unless ( $args->{job} and $args->{job}->isa('POE::Component::SmokeBox::Job') ) {
174 0         0 warn "No 'job' specified for $state or it was not a valid 'POE::Component::SmokeBox::Job' object\n";
175 0         0 return;
176             }
177              
178 36 50 33     143 if ( $args->{session} and my $ref = $kernel->alias_resolve( $args->{session} ) ) {
179 0         0 $args->{session} = $ref->ID();
180             }
181             else {
182 36         147 $args->{session} = $sender->ID();
183             }
184              
185 36 50       152 warn "No smokers have been defined yet!!!!!\n" unless scalar @{ $self->{queues} };
  36         98  
186              
187 36         61 foreach my $q ( @{ $self->{queues} } ) {
  36         82  
188 44         210 $args->{smokers} = [ @{ $q->{smokers} } ];
  44         107  
189 44         130 $q->{queue}->submit( $args );
190             }
191              
192 36         779 return;
193             }
194              
195       0     sub _reg_ui {
196             }
197              
198       0     sub _unreg_ui {
199             }
200              
201             "We've Got a Fuzzbox and We're Gonna Use It";
202              
203             __END__