5782389844

pending completion

Build # 5782389844

Build Type

Pull #223

github

Committed by

web-flow

Commit Message

Merge 5badf808f into cb8e0552b

Pull Request Pull Request #223: Add YAML format support for workflow configuration

Run Details

25 of 25 new or added lines in 2 files covered. (100.0%)

1372 of 1483 relevant lines covered (92.52%)

47.58 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

96.3

/lib/Workflow/Base.pm

package Workflow::Base;

use warnings;
use strict;
use v5.14.0;
use parent qw( Class::Accessor );
use Log::Any;

$Workflow::Base::VERSION = '1.57';

sub new {
    my ( $class, @params ) = @_;
    my $self = bless { PARAMS => {} }, $class;

    if ( ref $params[0] eq 'HASH' && ref $params[0]->{param} eq 'ARRAY' ) {
        foreach my $declared ( @{ $params[0]->{param} } ) {
            $params[0]->{ $declared->{name} } = $declared->{value};
        }
        delete $params[0]->{param};
    }
    $self->init(@params);
    return $self;
}

sub init {return};

sub log {
    return ( $_[0]->{log} ||=  Log::Any->get_logger( category => ref $_[0] ) );
}

sub param {
    my ( $self, $name, $value ) = @_;
    unless ( defined $name ) {
        return { %{ $self->{PARAMS} } };
    }

    # Allow multiple parameters to be set at once...

    if ( ref $name eq 'HASH' ) {
        foreach my $param_name ( keys %{$name} ) {
            if (defined $name->{$param_name}) {
                $self->{PARAMS}{$param_name} = $name->{$param_name};
            }
            else {
                delete $self->{PARAMS}->{$param_name};
            }
        }
        return { %{ $self->{PARAMS} } };
    }

    unless ( defined $value ) {
        if ( exists $self->{PARAMS}{$name} ) {
            return $self->{PARAMS}{$name};
        }
        return;
    }
    return $self->{PARAMS}{$name} = $value;
}

sub delete_param {
    my ( $self, $name ) = @_;
    unless ( defined $name ) {
        return;
    }

    # Allow multiple parameters to be deleted at once...

    if ( ref $name eq 'ARRAY' ) {
        my %list = ();
        foreach my $param_name ( @{$name} ) {
            next if ( not exists $self->{PARAMS}{$param_name} );
            $list{$param_name} = $self->{PARAMS}{$param_name};
            delete $self->{PARAMS}{$param_name};
        }
        return {%list};
    }

    if ( exists $self->{PARAMS}{$name} ) {
        my $value = $self->{PARAMS}{$name};
        delete $self->{PARAMS}{$name};
        return $value;
    }
    return;
}

sub clear_params {
    my ($self) = @_;
    $self->{PARAMS} = {};
}

sub normalize_array {
    my ( $self, $ref_or_item ) = @_;
    return () unless ($ref_or_item);
    return ( ref $ref_or_item eq 'ARRAY' ) ? @{$ref_or_item} : ($ref_or_item);
}

1;

__END__

=pod

=head1 NAME

Workflow::Base - Base class with constructor

=head1 VERSION

This documentation describes version 1.57 of this package

=head1 SYNOPSIS

 package My::App::Foo;
 use parent qw( Workflow::Base );

=head1 DESCRIPTION

Provide a constructor and some other useful methods for subclasses.

=head1 METHODS

=head2 Class Methods

=head3 new( @params )

Just create a new object (blessed hashref) and pass along C<@params>
to the C<init()> method, which subclasses can override to initialize
themselves.

Returns: new object

=head2 Object Methods

=head3 init( @params )

Subclasses may implement to do initialization. The C<@params> are
whatever is passed into C<new()>. Nothing need be returned.

=head3 log()

Returns the logger for the instance, based on the instance class.

=head3 param( [ $name, $value ] )

Associate arbitrary parameters with this object.

If neither C<$name> nor C<$value> given, return a hashref of all
parameters set in object:

 my $params = $object->param();
 while ( my ( $name, $value ) = each %{ $params } ) {
     print "$name = $params->{ $name }\n";
 }

If C<$name> given and it is a hash reference, assign all the values of
the reference to the object parameters. This is the way to assign
multiple parameters at once. Note that these will overwrite any
existing parameter values. Return a hashref of all parameters set in
object.

 $object->param({ foo => 'bar',
                  baz => 'blarney' });

If C<$name> given and it is not a hash reference, return the value
associated with it, C<undef> if C<$name> was not previously set.

 my $value = $object->param( 'foo' );
 print "Value of 'foo' is '$value'\n";

If C<$name> and C<$value> given, associate C<$name> with C<$value>,
overwriting any existing value, and return the new value.

 $object->param( foo => 'blurney' );

=head3 delete_param( [ $name ] )

Delete parameters from this object.

If C<$name> given and it is an array reference, then delete all
parameters from this object. All deleted parameters will be returned
as a hash reference together with their values.

 my $deleted = $object->delete_param(['foo','baz']);
 foreach my $key (keys %{$deleted})
 {
   print $key."::=".$deleted->{$key}."\n";
 }

If C<$name> given and it is not an array reference, delete the
parameter and return the value of the parameter.

 my $value = $object->delete_param( 'foo' );
 print "Value of 'foo' was '$value'\n";

If C<$name> is not defined or C<$name> does not exists the
undef is returned.

=head3 clear_params()

Clears out all parameters associated with this object.

=head3 normalize_array( \@array | $item )

If given C<\@array> return it dereferenced; if given C<$item>, return
it in a list. If given neither return an empty list.

=head1 COPYRIGHT

Copyright (c) 2003-2021 Chris Winters. All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

Please see the F<LICENSE>

=head1 AUTHORS

Please see L<Workflow>

=cut

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

jonasbn / perl-workflow / 5782389844

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous