File Coverage

blib/lib/Config/Any/XML.pm
Criterion Covered Total %
statement 23 23 100.0
branch 4 4 100.0
condition n/a
subroutine 5 5 100.0
pod 2 2 100.0
total 34 34 100.0


line stmt bran cond sub pod time code
1             package Config::Any::XML;
2              
3 6     6   106 use strict;
  6         54  
  6         95  
4 6     6   117 use warnings;
  6         56  
  6         89  
5              
6             =head1 NAME
7            
8             Config::Any::XML - Load XML config files
9            
10             =head1 DESCRIPTION
11            
12             Loads XML files. Example:
13            
14             <config>
15             <name>TestApp</name>
16             <component name="Controller::Foo">
17             <foo>bar</foo>
18             </component>
19             <model name="Baz">
20             <qux>xyzzy</qux>
21             </model>
22             </config>
23            
24             =head1 METHODS
25            
26             =head2 extensions( )
27            
28             return an array of valid extensions (C<xml>).
29            
30             =cut
31              
32             sub extensions {
33 8     8 1 107     return qw( xml );
34             }
35              
36             =head2 load( $file )
37            
38             Attempts to load C<$file> as an XML file.
39            
40             =cut
41              
42             sub load {
43 6     6 1 138     my $class = shift;
44 6         58     my $file = shift;
45              
46 6         134     require XML::Simple;
47 6         129     XML::Simple->import;
48 6         2075     my $config = XMLin(
49             $file, 
50             ForceArray => [ qw( component model view controller ) ],
51             );
52              
53 6         131 return $class->_coerce($config);
54             }
55              
56             sub _coerce {
57             # coerce the XML-parsed config into the correct format
58 6     6   60 my $class = shift;
59 6         55 my $config = shift;
60 6         51 my $out;
61 6         432 for my $k (keys %$config) {
62 18         373 my $ref = $config->{$k};
63 18 100       198 my $name = ref $ref ? delete $ref->{name} : undef;
64 18 100       172 if (defined $name) {
65 12         150 $out->{$k}->{$name} = $ref;
66             } else {
67 6         99 $out->{$k} = $ref;
68             }
69             }
70 6         137 $out;
71             }
72              
73             =head1 AUTHOR
74            
75             =over 4
76            
77             =item * Brian Cassidy E<lt>bricas@cpan.orgE<gt>
78            
79             =item * Joel Bernstein E<lt>rataxis@cpan.orgE<gt>
80            
81             =back
82            
83             =head1 COPYRIGHT AND LICENSE
84            
85             Copyright 2006 by Brian Cassidy
86            
87             This library is free software; you can redistribute it and/or modify
88             it under the same terms as Perl itself.
89            
90             =head1 SEE ALSO
91            
92             =over 4
93            
94             =item * L<Catalyst>
95            
96             =item * L<Config::Any>
97            
98             =item * L<XML::Simple>
99            
100             =back
101            
102             =cut
103              
104             1;
105