Commit | Line | Data |
---|---|---|
f0e3c221 | 1 | package Config::Any::General; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
82222ecc | 5 | use Carp; |
f0e3c221 | 6 | |
dcfb1d1d | 7 | use base 'Config::Any::Base'; |
8 | ||
f0e3c221 | 9 | =head1 NAME |
10 | ||
11 | Config::Any::General - Load Config::General files | |
12 | ||
13 | =head1 DESCRIPTION | |
14 | ||
15 | Loads Config::General files. Example: | |
16 | ||
17 | name = TestApp | |
18 | <Component Controller::Foo> | |
19 | foo bar | |
7adf5673 | 20 | bar [ arrayref-value ] |
f0e3c221 | 21 | </Component> |
22 | <Model Baz> | |
23 | qux xyzzy | |
24 | </Model> | |
25 | ||
26 | =head1 METHODS | |
27 | ||
28 | =head2 extensions( ) | |
29 | ||
30 | return an array of valid extensions (C<cnf>, C<conf>). | |
31 | ||
32 | =cut | |
33 | ||
34 | sub extensions { | |
35 | return qw( cnf conf ); | |
36 | } | |
37 | ||
38 | =head2 load( $file ) | |
39 | ||
40 | Attempts to load C<$file> via Config::General. | |
41 | ||
42 | =cut | |
43 | ||
44 | sub load { | |
45 | my $class = shift; | |
46 | my $file = shift; | |
e0c0c283 | 47 | my $args = shift || {}; |
f0e3c221 | 48 | |
49 | # work around bug (?) in Config::General | |
92a04e78 | 50 | # return if $class->_test_perl($file); |
f0e3c221 | 51 | |
92a04e78 | 52 | $args->{ -ConfigFile } = $file; |
e0c0c283 | 53 | |
e3c5f84b | 54 | require Config::General; |
2b645c42 | 55 | Config::General->VERSION('2.47'); |
82222ecc | 56 | |
7adf5673 | 57 | $args->{ -ForceArray } = 1 unless exists $args->{ -ForceArray }; |
58 | ||
e0c0c283 | 59 | my $configfile = Config::General->new( %$args ); |
f0e3c221 | 60 | my $config = { $configfile->getall }; |
92a04e78 | 61 | |
f0e3c221 | 62 | return $config; |
63 | } | |
64 | ||
65 | # this is a bit of a hack but necessary, because Config::General is *far* too lax | |
66 | # about what it will load -- specifically, it seems to be quite happy to load a Perl | |
67 | # config file (ie, a file which is valid Perl and creates a hashref) as if it were | |
68 | # an Apache-style configuration file, presumably due to laziness on the part of the | |
69 | # developer. | |
70 | ||
71 | sub _test_perl { | |
92a04e78 | 72 | my ( $class, $file ) = @_; |
f0e3c221 | 73 | my $is_perl_src; |
74 | eval { $is_perl_src = do "$file"; }; | |
92a04e78 | 75 | delete $INC{ $file }; # so we don't screw stuff later on |
f0e3c221 | 76 | return defined $is_perl_src; |
77 | } | |
78 | ||
dcfb1d1d | 79 | =head2 requires_all_of( ) |
72628dc7 | 80 | |
dcfb1d1d | 81 | Specifies that this module requires L<Config::General> in order to work. |
72628dc7 | 82 | |
83 | =cut | |
84 | ||
82222ecc | 85 | sub requires_all_of { [ 'Config::General' ] } |
72628dc7 | 86 | |
f0e3c221 | 87 | =head1 AUTHOR |
88 | ||
a918b0b8 | 89 | Brian Cassidy E<lt>bricas@cpan.orgE<gt> |
f0e3c221 | 90 | |
91 | =head1 CONTRIBUTORS | |
92 | ||
a918b0b8 | 93 | Joel Bernstein C<< <rataxis@cpan.org> >> |
f0e3c221 | 94 | |
95 | =head1 COPYRIGHT AND LICENSE | |
96 | ||
f07b7a17 | 97 | Copyright 2006-2010 by Brian Cassidy |
f0e3c221 | 98 | |
99 | Portions Copyright 2006 Portugal Telecom | |
100 | ||
101 | This library is free software; you can redistribute it and/or modify | |
102 | it under the same terms as Perl itself. | |
103 | ||
104 | =head1 SEE ALSO | |
105 | ||
106 | =over 4 | |
107 | ||
108 | =item * L<Catalyst> | |
109 | ||
110 | =item * L<Config::Any> | |
111 | ||
112 | =item * L<Config::General> | |
113 | ||
114 | =back | |
115 | ||
116 | =cut | |
117 | ||
118 | 1; | |
119 |