X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FConfig-Any.git;a=blobdiff_plain;f=lib%2FConfig%2FAny%2FPerl.pm;h=daf27f6df48e4dfc9264ba3e11c3f8bce5ded4d9;hp=ae7bd7b01c78815af26453ce8b4613a7b8d57e0a;hb=49ae658349471834b403cb322f11f97258fcd0ca;hpb=e967a60fa6fb5adeb6ead013b0b60289b2a92e2e diff --git a/lib/Config/Any/Perl.pm b/lib/Config/Any/Perl.pm index ae7bd7b..daf27f6 100644 --- a/lib/Config/Any/Perl.pm +++ b/lib/Config/Any/Perl.pm @@ -1,75 +1,92 @@ -package Config::Any::Perl; - -use strict; -use warnings; - -=head1 NAME - -Config::Any::Perl - Load Perl config files - -=head1 DESCRIPTION - -Loads Perl files. Example: - - { - name => 'TestApp', - 'Controller::Foo' => { - foo => 'bar' - }, - 'Model::Baz' => { - qux => 'xyzzy' - } - } - -=head1 METHODS - -=head2 extensions( ) - -return an array of valid extensions (C, C). - -=cut - -sub extensions { - return qw( pl perl ); -} - -=head2 load( $file ) - -Attempts to load C<$file> as a Perl file. - -=cut - -sub load { - my $class = shift; - my $file = shift; - return eval { require $file }; -} - -=head1 AUTHOR - -=over 4 - -=item * Brian Cassidy Ebricas@cpan.orgE - -=back - -=head1 COPYRIGHT AND LICENSE - -Copyright 2006 by Brian Cassidy - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=head1 SEE ALSO - -=over 4 - -=item * L - -=item * L - -=back - -=cut - -1; +package Config::Any::Perl; + +use strict; +use warnings; + +use base 'Config::Any::Base'; + +my %cache; + +=head1 NAME + +Config::Any::Perl - Load Perl config files + +=head1 DESCRIPTION + +Loads Perl files. Example: + + { + name => 'TestApp', + 'Controller::Foo' => { + foo => 'bar' + }, + 'Model::Baz' => { + qux => 'xyzzy' + } + } + +=head1 METHODS + +=head2 extensions( ) + +return an array of valid extensions (C, C). + +=cut + +sub extensions { + return qw( pl perl ); +} + +=head2 load( $file ) + +Attempts to load C<$file> as a Perl file. + +=cut + +sub load { + my $class = shift; + my $file = shift; + my $content; + + my $mtime = (stat($file))[9]; + + if ( (not exists $cache{ $file }) || $cache{ $file }{ mtime } < $mtime ) { + my $exception; + { + local $@; + $content = do $file; + $exception = $@; + } + die $exception if $exception; + + $cache{ $file }{ mtime } = $mtime; + $cache{ $file }{ content } = $content; + } + + return $cache{ $file }{ content }; +} + +=head1 AUTHOR + +Brian Cassidy Ebricas@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006-2009 by Brian Cassidy + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=head1 SEE ALSO + +=over 4 + +=item * L + +=item * L + +=back + +=cut + +1;