| 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 |