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