File Coverage

lib/Workflow/Config/XML.pm
Criterion Covered Total %
statement 51 55 92.7
branch 7 12 58.3
condition 3 5 60.0
subroutine 9 9 100.0
pod 1 1 100.0
total 71 82 86.5


line stmt bran cond sub pod time code
1              
2             use warnings;
3 14     14   6860 use strict;
  14         32  
  14         479  
4 14     14   69 use base qw( Workflow::Config );
  14         18  
  14         490  
5 14     14   78 use Log::Log4perl qw( get_logger );
  14         49  
  14         1485  
6 14     14   81 use Workflow::Exception qw( configuration_error );
  14         19  
  14         95  
7 14     14   934 use Carp qw(croak);
  14         27  
  14         754  
8 14     14   83 use English qw( -no_match_vars );
  14         32  
  14         635  
9 14     14   505  
  14         1347  
  14         83  
10             $Workflow::Config::XML::VERSION = '1.61';
11              
12             my ($log);
13              
14             my %XML_OPTIONS = (
15             action => {
16             ForceArray =>
17             [ 'action', 'field', 'source_list', 'param', 'validator', 'arg' ],
18             KeyAttr => [],
19             },
20             condition => {
21             ForceArray => [ 'condition', 'param' ],
22             KeyAttr => [],
23             },
24             persister => {
25             ForceArray => ['persister'],
26             KeyAttr => [],
27             },
28             validator => {
29             ForceArray => [ 'validator', 'param' ],
30             KeyAttr => [],
31             },
32             workflow => {
33             ForceArray => [
34             'extra_data', 'state',
35             'action', 'resulting_state',
36             'condition', 'observer'
37             ],
38             KeyAttr => [],
39             },
40             );
41              
42             my $XML_REQUIRED = 0;
43              
44             my ( $self, $type, @items ) = @_;
45             $log ||= get_logger();
46 95     95 1 6785  
47 95   66     263 $self->_check_config_type($type);
48             my @config_items = Workflow::Config::_expand_refs(@items);
49 95         5538 return () unless ( scalar @config_items );
50 95         234  
51 95 50       193 my @config = ();
52             foreach my $item (@config_items) {
53 95         129 my $file_name = ( ref $item ) ? '[scalar ref]' : $item;
54 95         139 $log->info("Will parse '$type' XML config file '$file_name'");
55 101 50       184 my $this_config;
56 101         418 eval { $this_config = $self->_translate_xml( $type, $item ); };
57 101         28982  
58 101         191 # If processing multiple config files, this makes it much easier
  101         283  
59             # to find a problem.
60             croak "Processing $file_name: $EVAL_ERROR" if $EVAL_ERROR;
61             $log->info("Parsed XML '$file_name' ok");
62 101 50       339  
63 101         586 # This sets the outer-most tag to use
64             # when returning the parsed XML.
65             my $outer_tag = $self->get_config_type_tag($type);
66             if ( ref $this_config->{$outer_tag} eq 'ARRAY' ) {
67 101         35864 $log->debug("Adding multiple configurations for '$type'");
68 101 50       370 push @config, @{ $this_config->{$outer_tag} };
69 0         0 } else {
70 0         0 $log->debug("Adding single configuration for '$type'");
  0         0  
71             push @config, $this_config;
72 101         423 }
73 101         28729 }
74             return @config;
75             }
76 95         398  
77             # $config can either be a filename or scalar ref with file contents
78              
79             my ( $self, $type, $config ) = @_;
80             unless ($XML_REQUIRED) {
81             eval { require XML::Simple };
82 101     101   279 if ($EVAL_ERROR) {
83 101 100       233 configuration_error "XML::Simple must be installed to parse ",
84 14         21 "configuration files/data in XML format";
  14         10191  
85 14 50       110724 } else {
86 0         0 XML::Simple->import(':strict');
87             $XML_REQUIRED++;
88             }
89 14         121 }
90 14         1270 my $options = $XML_OPTIONS{$type} || {};
91             my $data = XMLin( $config, %{$options} );
92             return $data;
93 101   50     364 }
94 101         130  
  101         412  
95 101         2228715 1;
96              
97              
98             =pod
99              
100             =head1 NAME
101              
102             Workflow::Config::XML - Parse workflow configurations from XML content
103              
104             =head1 VERSION
105              
106             This documentation describes version 1.61 of this package
107              
108             =head1 SYNOPSIS
109              
110             my $parser = Workflow::Config->new( 'xml' );
111             my $conf = $parser->parse( 'condition',
112             'my_conditions.xml', 'your_conditions.xml' );
113              
114             =head1 DESCRIPTION
115              
116             Implementation of configuration parser for XML files/data; requires
117             L<XML::Simple> to be installed. See L<Workflow::Config> for C<parse()>
118             description.
119              
120             =head2 METHODS
121              
122             =head3 parse ( $type, @items )
123              
124             This method parses the configuration provided it is in XML format.
125              
126             Takes two parameters: a $type indication and an array of of items
127              
128             Returns a list of config parameters as a array upon success.
129              
130             =head1 SEE ALSO
131              
132             =over
133              
134             =item * L<XML::Simple>
135              
136             =item * L<Workflow::Config>
137              
138             =back
139              
140             =head1 COPYRIGHT
141              
142             Copyright (c) 2004-2022 Chris Winters. All rights reserved.
143              
144             This library is free software; you can redistribute it and/or modify
145             it under the same terms as Perl itself.
146              
147             Please see the F<LICENSE>
148              
149             =head1 AUTHORS
150              
151             Please see L<Workflow>
152              
153             =cut