line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
use warnings; |
3
|
29
|
|
|
29
|
|
877
|
use strict; |
|
29
|
|
|
|
|
51
|
|
|
29
|
|
|
|
|
910
|
|
4
|
29
|
|
|
29
|
|
141
|
use base qw( Class::Accessor ); |
|
29
|
|
|
|
|
61
|
|
|
29
|
|
|
|
|
731
|
|
5
|
29
|
|
|
29
|
|
142
|
use Log::Log4perl; |
|
29
|
|
|
|
|
50
|
|
|
29
|
|
|
|
|
15303
|
|
6
|
29
|
|
|
29
|
|
51886
|
$Workflow::Base::VERSION = '1.60'; |
|
29
|
|
|
|
|
77700
|
|
|
29
|
|
|
|
|
310
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
my ( $class, @params ) = @_; |
9
|
|
|
|
|
|
|
my $self = bless { PARAMS => {} }, $class; |
10
|
420
|
|
|
420
|
1
|
8042
|
|
11
|
420
|
|
|
|
|
1189
|
if ( ref $params[0] eq 'HASH' && ref $params[0]->{param} eq 'ARRAY' ) { |
12
|
|
|
|
|
|
|
foreach my $declared ( @{ $params[0]->{param} } ) { |
13
|
420
|
100
|
100
|
|
|
2067
|
$params[0]->{ $declared->{name} } = $declared->{value}; |
14
|
26
|
|
|
|
|
50
|
} |
|
26
|
|
|
|
|
89
|
|
15
|
41
|
|
|
|
|
122
|
delete $params[0]->{param}; |
16
|
|
|
|
|
|
|
} |
17
|
26
|
|
|
|
|
87
|
$self->init(@params); |
18
|
|
|
|
|
|
|
return $self; |
19
|
420
|
|
|
|
|
1868
|
} |
20
|
416
|
|
|
|
|
13069
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
return ( $_[0]->{log} ||= Log::Log4perl->get_logger(ref $_[0]) ); |
23
|
18
|
|
|
18
|
1
|
63
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my ( $self, $name, $value ) = @_; |
26
|
2968
|
|
66
|
2968
|
1
|
15820
|
unless ( defined $name ) { |
27
|
|
|
|
|
|
|
return { %{ $self->{PARAMS} } }; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
485
|
|
|
485
|
1
|
53444
|
# Allow multiple parameters to be set at once... |
31
|
485
|
100
|
|
|
|
853
|
|
32
|
62
|
|
|
|
|
149
|
if ( ref $name eq 'HASH' ) { |
|
62
|
|
|
|
|
236
|
|
33
|
|
|
|
|
|
|
foreach my $param_name ( keys %{$name} ) { |
34
|
|
|
|
|
|
|
$self->{PARAMS}{$param_name} = $name->{$param_name}; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
return { %{ $self->{PARAMS} } }; |
37
|
423
|
100
|
|
|
|
676
|
} |
38
|
1
|
|
|
|
|
16
|
|
|
1
|
|
|
|
|
4
|
|
39
|
2
|
|
|
|
|
6
|
unless ( defined $value ) { |
40
|
|
|
|
|
|
|
return $self->{PARAMS}{$name}; |
41
|
1
|
|
|
|
|
2
|
} |
|
1
|
|
|
|
|
4
|
|
42
|
|
|
|
|
|
|
return $self->{PARAMS}{$name} = $value; |
43
|
|
|
|
|
|
|
} |
44
|
422
|
100
|
|
|
|
597
|
|
45
|
249
|
|
|
|
|
1039
|
my ( $self, $name ) = @_; |
46
|
|
|
|
|
|
|
unless ( defined $name ) { |
47
|
173
|
|
|
|
|
505
|
return; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
# Allow multiple parameters to be deleted at once... |
51
|
2
|
|
|
2
|
1
|
6
|
|
52
|
2
|
50
|
|
|
|
5
|
if ( ref $name eq 'ARRAY' ) { |
53
|
0
|
|
|
|
|
0
|
my %list = (); |
54
|
|
|
|
|
|
|
foreach my $param_name ( @{$name} ) { |
55
|
|
|
|
|
|
|
next if ( not exists $self->{PARAMS}{$param_name} ); |
56
|
|
|
|
|
|
|
$list{$param_name} = $self->{PARAMS}{$param_name}; |
57
|
|
|
|
|
|
|
delete $self->{PARAMS}{$param_name}; |
58
|
2
|
100
|
|
|
|
11
|
} |
59
|
1
|
|
|
|
|
3
|
return {%list}; |
60
|
1
|
|
|
|
|
1
|
} |
|
1
|
|
|
|
|
3
|
|
61
|
1
|
50
|
|
|
|
3
|
|
62
|
1
|
|
|
|
|
3
|
if ( exists $self->{PARAMS}{$name} ) { |
63
|
1
|
|
|
|
|
2
|
my $value = $self->{PARAMS}{$name}; |
64
|
|
|
|
|
|
|
delete $self->{PARAMS}{$name}; |
65
|
1
|
|
|
|
|
5
|
return $value; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
return; |
68
|
1
|
50
|
|
|
|
4
|
} |
69
|
1
|
|
|
|
|
2
|
|
70
|
1
|
|
|
|
|
3
|
my ($self) = @_; |
71
|
1
|
|
|
|
|
5
|
$self->{PARAMS} = {}; |
72
|
|
|
|
|
|
|
} |
73
|
0
|
|
|
|
|
0
|
|
74
|
|
|
|
|
|
|
my ( $self, $ref_or_item ) = @_; |
75
|
|
|
|
|
|
|
return () unless ($ref_or_item); |
76
|
|
|
|
|
|
|
return ( ref $ref_or_item eq 'ARRAY' ) ? @{$ref_or_item} : ($ref_or_item); |
77
|
1
|
|
|
1
|
1
|
3
|
} |
78
|
1
|
|
|
|
|
6
|
|
79
|
|
|
|
|
|
|
1; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
|
82
|
303
|
|
|
303
|
1
|
1797
|
=pod |
83
|
303
|
100
|
|
|
|
696
|
|
84
|
137
|
100
|
|
|
|
350
|
=head1 NAME |
|
122
|
|
|
|
|
355
|
|
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
Workflow::Base - Base class with constructor |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
=head1 VERSION |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
This documentation describes version 1.60 of this package |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head1 SYNOPSIS |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
package My::App::Foo; |
95
|
|
|
|
|
|
|
use base qw( Workflow::Base ); |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head1 DESCRIPTION |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Provide a constructor and some other useful methods for subclasses. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head1 METHODS |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=head2 Class Methods |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head3 new( @params ) |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
Just create a new object (blessed hashref) and pass along C<@params> |
108
|
|
|
|
|
|
|
to the C<init()> method, which subclasses can override to initialize |
109
|
|
|
|
|
|
|
themselves. |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Returns: new object |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=head2 Object Methods |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=head3 init( @params ) |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
Subclasses may implement to do initialization. The C<@params> are |
118
|
|
|
|
|
|
|
whatever is passed into C<new()>. Nothing need be returned. |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=head3 log() |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
Returns the logger for the instance, based on the instance class. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head3 param( [ $name, $value ] ) |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Associate arbitrary parameters with this object. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
If neither C<$name> nor C<$value> given, return a hashref of all |
129
|
|
|
|
|
|
|
parameters set in object: |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
my $params = $object->param(); |
132
|
|
|
|
|
|
|
while ( my ( $name, $value ) = each %{ $params } ) { |
133
|
|
|
|
|
|
|
print "$name = $params->{ $name }\n"; |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
If C<$name> given and it is a hash reference, assign all the values of |
137
|
|
|
|
|
|
|
the reference to the object parameters. This is the way to assign |
138
|
|
|
|
|
|
|
multiple parameters at once. Note that these will overwrite any |
139
|
|
|
|
|
|
|
existing parameter values. Return a hashref of all parameters set in |
140
|
|
|
|
|
|
|
object. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
$object->param({ foo => 'bar', |
143
|
|
|
|
|
|
|
baz => 'blarney' }); |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
If C<$name> given and it is not a hash reference, return the value |
146
|
|
|
|
|
|
|
associated with it, C<undef> if C<$name> was not previously set. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
my $value = $object->param( 'foo' ); |
149
|
|
|
|
|
|
|
print "Value of 'foo' is '$value'\n"; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
If C<$name> and C<$value> given, associate C<$name> with C<$value>, |
152
|
|
|
|
|
|
|
overwriting any existing value, and return the new value. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
$object->param( foo => 'blurney' ); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head3 delete_param( [ $name ] ) |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Delete parameters from this object. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
If C<$name> given and it is an array reference, then delete all |
161
|
|
|
|
|
|
|
parameters from this object. All deleted parameters will be returned |
162
|
|
|
|
|
|
|
as a hash reference together with their values. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
my $deleted = $object->delete_param(['foo','baz']); |
165
|
|
|
|
|
|
|
foreach my $key (keys %{$deleted}) |
166
|
|
|
|
|
|
|
{ |
167
|
|
|
|
|
|
|
print $key."::=".$deleted->{$key}."\n"; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
If C<$name> given and it is not an array reference, delete the |
171
|
|
|
|
|
|
|
parameter and return the value of the parameter. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
my $value = $object->delete_param( 'foo' ); |
174
|
|
|
|
|
|
|
print "Value of 'foo' was '$value'\n"; |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
If C<$name> is not defined or C<$name> does not exists the |
177
|
|
|
|
|
|
|
undef is returned. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head3 clear_params() |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Clears out all parameters associated with this object. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head3 normalize_array( \@array | $item ) |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
If given C<\@array> return it dereferenced; if given C<$item>, return |
186
|
|
|
|
|
|
|
it in a list. If given neither return an empty list. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
=head1 COPYRIGHT |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Copyright (c) 2003-2022 Chris Winters. All rights reserved. |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
193
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Please see the F<LICENSE> |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 AUTHORS |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
Please see L<Workflow> |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=cut |