File Coverage

lib/Workflow/Config/XML.pm
Criterion Covered Total %
statement 53 57 92.9
branch 7 12 58.3
condition 3 5 60.0
subroutine 9 9 100.0
pod 1 1 100.0
total 73 84 86.9


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