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.58';
3             #ABSTRACT: POE enabled CPAN smoke testing with added value.
4              
5 11     11   9882 use strict;
  11         25  
  11         373  
6 11     11   142 use warnings;
  11         22  
  11         328  
7 11     11   1053 use POE qw(Component::SmokeBox::Backend Component::SmokeBox::JobQueue);
  11         61936  
  11         86  
8 11     11   731 use POE::Component::SmokeBox::Smoker;
  11         30  
  11         242  
9 11     11   59 use POE::Component::SmokeBox::Job;
  11         25  
  11         230  
10 11     11   61 use POE::Component::SmokeBox::Result;
  11         27  
  11         16549  
11              
12             sub spawn {
13 9     9 1 2400 my $package = shift;
14 9         32 my %params = @_;
15 9         58 $params{lc $_} = delete $params{$_} for keys %params;
16 9         22 my $options = delete $params{'options'};
17 9 100       208 $params{'delay'} = 0 unless exists $params{'delay'};
18 9         29 my $self = bless \%params, $package;
19 9 100       138 $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         1576 return $self;
35             }
36              
37             sub session_id {
38 45     45 1 2123 return $_[0]->{session_id};
39             }
40              
41             sub multiplicity {
42 2     2 1 941 return $_[0]->{multiplicity};
43             }
44              
45             sub delay {
46 3 50   3 1 851 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         24 return $_[0]->{delay};
56             }
57             }
58              
59             sub queues {
60 20     20 1 3056 return map { $_->{queue} } @{ $_[0]->{queues} };
  33         190  
  20         99  
61             }
62              
63             sub shutdown {
64 9     9 1 4745 my $self = shift;
65 9         88 $poe_kernel->call( $self->session_id() => 'shutdown' => @_ );
66             }
67              
68             sub _start {
69 9     9   3470 my ($kernel,$self) = @_[KERNEL,OBJECT];
70 9         44 $self->{session_id} = $_[SESSION]->ID();
71 9 50       78 if ( $self->{alias} ) {
72 0         0 $kernel->alias_set( $self->{alias} );
73             }
74             else {
75 9         63 $kernel->refcount_increment( $self->{session_id} => __PACKAGE__ );
76             }
77 9         447 $self->{queues} = [ ];
78 9         35 my $smokers = delete $self->{smokers};
79 9 50 66     102 return unless $smokers and ref $smokers eq 'ARRAY' and scalar @{ $smokers };
  6   100     28  
80 6         14 $self->add_smoker( $_ ) for @{ $smokers };
  6         22  
81 6         69 return;
82             }
83              
84             sub _shutdown {
85 9     9   803 my ($kernel,$self) = @_[KERNEL,OBJECT];
86 9 50       91 if ( $self->{alias} ) {
87 0         0 $kernel->alias_remove($_) for $kernel->alias_list();
88             }
89             else {
90 9         69 $kernel->refcount_decrement( $self->{session_id} => __PACKAGE__ );
91             }
92 9         512 $_->{queue}->shutdown() for @{ $self->{queues} };
  9         129  
93 9         212 return;
94             }
95              
96             sub add_smoker {
97 31     31 1 222 my $self = shift;
98 31         289 $poe_kernel->call( $self->{session_id}, 'add_smoker', @_ );
99             }
100              
101             sub del_smoker {
102 11     11 1 95069 my $self = shift;
103 11         114 $poe_kernel->call( $self->{session_id}, 'del_smoker', @_ );
104             }
105              
106             sub _add_smoker {
107 31     31   2007 my ($kernel,$self,$state,$sender,$smoker) = @_[KERNEL,OBJECT,STATE,SENDER,ARG0];
108 31 50 33     287 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     102 if ( $self->{multiplicity} or scalar @{ $self->{queues} } == 0 ) {
  21         109  
115 17         39 my $queue = { };
116             $queue->{queue} = POE::Component::SmokeBox::JobQueue->spawn(
117             'delay' => $self->{delay},
118 17         84 );
119 17         32 push @{ $queue->{smokers} }, $smoker;
  17         49  
120 17         67 push @{ $self->{queues} }, $queue;
  17         37  
121 17         63 return;
122             }
123             # Otherwise we just add the smoker to our existing queue
124 14         31 push @{ $self->{queues}->[0]->{smokers} }, $smoker;
  14         31  
125 14         35 return;
126             }
127              
128             sub _del_smoker {
129 11     11   1233 my ($kernel,$self,$state,$sender,$smoker) = @_[KERNEL,OBJECT,STATE,SENDER,ARG0];
130 11 50 33     240 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         54 my $x = 0;
135 11         49 foreach my $queue ( @{ $self->{queues} } ) {
  11         88  
136 17         49 my $i = 0;
137 17         38 for ( @{ $queue->{smokers} } ) {
  17         103  
138 29 100       113 splice(@{ $queue->{smokers} }, $i, 1) if $_ == $smoker;
  8         54  
139 29         78 ++$i;
140             }
141 17 100       44 unless ( scalar @{ $queue->{smokers} } ) {
  17         89  
142 3         7 splice(@{ $self->{queues} }, $x, 1);
  3         10  
143 3         41 $queue->{queue}->shutdown();
144             }
145 17         124 ++$x;
146             }
147 11         57 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   5754 my ($kernel,$self,$state,$sender) = @_[KERNEL,OBJECT,STATE,SENDER];
157 36 50       109 return if $self->{_shutdown};
158 36         69 my $args;
159 36 50       106 if ( ref( $_[ARG0] ) eq 'HASH' ) {
160 0         0 $args = { %{ $_[ARG0] } };
  0         0  
161             }
162             else {
163 36         135 $args = { @_[ARG0..$#_] };
164             }
165              
166 36         68 $args->{lc $_} = delete $args->{$_} for grep { $_ !~ /^_/ } keys %{ $args };
  72         314  
  36         117  
167              
168 36 50       101 unless ( $args->{event} ) {
169 0         0 warn "No 'event' specified for $state\n";
170 0         0 return;
171             }
172              
173 36 50 33     252 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     124 if ( $args->{session} and my $ref = $kernel->alias_resolve( $args->{session} ) ) {
179 0         0 $args->{session} = $ref->ID();
180             }
181             else {
182 36         107 $args->{session} = $sender->ID();
183             }
184              
185 36 50       150 warn "No smokers have been defined yet!!!!!\n" unless scalar @{ $self->{queues} };
  36         90  
186              
187 36         57 foreach my $q ( @{ $self->{queues} } ) {
  36         92  
188 44         228 $args->{smokers} = [ @{ $q->{smokers} } ];
  44         124  
189 44         133 $q->{queue}->submit( $args );
190             }
191              
192 36         788 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__