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