File Coverage

lib/Workflow/Base.pm
Criterion Covered Total %
statement 56 58 96.5
branch 17 20 85.0
condition 5 6 83.3
subroutine 11 11 100.0
pod 7 7 100.0
total 96 102 94.1


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