Skip to content
Browse files

support any config file

  • Loading branch information...
1 parent 33befa0 commit 2ef86d02fbf0028e0fe03634ff1b565ffc9f02cc @xaicron committed Jan 11, 2012
Showing with 208 additions and 9 deletions.
  1. +1 −2 Makefile.PL
  2. +1 −0 bin/envfile
  3. +63 −7 lib/App/envfile.pm
  4. +143 −0 t/04_try_any_config_file.t
View
3 Makefile.PL
@@ -2,8 +2,7 @@ use inc::Module::Install;
name 'App-envfile';
all_from 'lib/App/envfile.pm';
-#requires '';
-
+recommends 'Data::Encoder', 0.05;
test_requires 'Test::More', 0.98;
install_script 'bin/envfile';
View
1 bin/envfile
@@ -10,6 +10,7 @@ exit;
sub main {
my ($envfile, @commands) = @_;
usage() unless defined $envfile;
+ die "$envfile: $!\n" unless -r $envfile;
my $envf = App::envfile->new;
my $env = $envf->parse_envfile($envfile);
View
70 lib/App/envfile.pm
@@ -3,8 +3,19 @@ package App::envfile;
use strict;
use warnings;
use 5.008_001;
+use Carp ();
+
our $VERSION = '0.04';
+our $EXTENTIONS_MAP = {
+ pl => 'Perl',
+ perl => 'Perl',
+ js => 'JSON',
+ json => 'JSON',
+ yml => 'YAML',
+ yaml => 'YAML',
+};
+
sub new {
my $class = shift;
bless {}, $class;
@@ -21,8 +32,12 @@ sub run_with_env {
sub parse_envfile {
my ($self, $file) = @_;
- open my $fh, '<', $file or die "$file: $!\n";
+ Carp::croak "Usage: $self->parse_envfile(\$file)" unless defined $file;
+
my $env = {};
+ return $env if $env = $self->_try_any_config_file($file);
+
+ open my $fh, '<', $file or Carp::croak "$file: $!";
while (defined (my $line = readline $fh)) {
chomp $line;
next if index($line, '#') == 0;
@@ -35,6 +50,37 @@ sub parse_envfile {
return $env;
}
+sub _try_any_config_file {
+ my ($self, $file) = @_;
+
+ my ($ext) = $file =~ /\.(\w+)/;
+ if (my $type = $EXTENTIONS_MAP->{lc($ext || '')}) {
+ my $env;
+ if ($type eq 'Perl') {
+ $env = do "$file";
+ die $@ if $@;
+ }
+ else {
+ require Data::Encoder;
+ $env = Data::Encoder->load($type)->decode($self->_slurp($file));
+ }
+ die "$file: Should be return HASHREF\n" unless ref $env eq 'HASH';
+ return $env;
+ }
+
+ return;
+}
+
+sub _slurp {
+ my ($self, $file) = @_;
+ my $data = do {
+ local $\;
+ open my $fh, '<', $file or die "$file: $!\n";
+ <$fh>;
+ };
+ return $data;
+}
+
sub _parse_line {
my ($self, $line) = @_;
my ($key, $value) = map { my $str = $_; $str =~ s/^\s+|\s+$//g; $str } split '=', $line, 2;
@@ -72,21 +118,19 @@ envfile inspired djb's envdir program.
=head1 METHODS
-=over
-
-=item C<< new() >>
+=head2 new()
Create App::envfile instance.
my $envf = App::envfile->new();
-=item C<< run_with_env(\%env, \@commands) >>
+=head2 run_with_env(\%env, \@commands)
Runs another program with environment modified according to C<< \%env >>.
$envf->run_with_env(\%env, \@commands);
-=item C<< parse_envfile($envfile) >>
+=head2 parse_envfile($envfile)
Parse the C<< envfile >>. Returned value is HASHREF.
@@ -99,7 +143,19 @@ Supported file format are:
KEY2=VALUE
...
-=back
+Or more supported C<< Perl >>, C<< JSON >> and C<< YAML >> format.
+The file format is determined by the extension type. extensions map are:
+
+ pl => Perl
+ perl => Perl
+ js => JSON
+ json => JSON
+ yml => YAML
+ yaml => YAML
+
+If this list does not match then considers that file is envfile.
+
+Also, if you use C<< YAML >> and C<< JSON >>, L<< Data::Encoder >> and L<< YAML >> or L<< JSON >> module is required.
=head1 AUTHOR
View
143 t/04_try_any_config_file.t
@@ -0,0 +1,143 @@
+use strict;
+use warnings;
+use Test::More;
+use t::Util;
+use File::Temp qw(tempdir);
+
+use App::envfile;
+
+sub test_requires {
+ my $module = shift;
+ plan skip_all => "Test requires module '$module' but it's not found"
+ unless eval "require $module; 1";
+}
+
+my $tmdir = tempdir CLEANUP => 1;
+sub write_file {
+ my ($filename, $data) = @_;
+ my $envfile = "$tmdir/$filename";
+ open my $fh, '>', "$envfile" or die $!;
+ print $fh $data;
+ close $fh;
+ return $envfile;
+}
+
+my $envf = App::envfile->new;
+
+runtest 'no extension file' => sub {
+ my $envfile = write_file('foo', '');
+ my $env = $envf->_try_any_config_file($envfile);
+ ok !$env;
+};
+
+runtest 'not supported extension' => sub {
+ my $envfile = write_file('foo.env', '');
+ my $env = $envf->_try_any_config_file($envfile);
+ ok !$env;
+};
+
+runtest 'success (pl)' => sub {
+ my $envfile = write_file('foo.pl', '{ foo => "bar" }');
+ my $env = $envf->_try_any_config_file($envfile);
+ is_deeply $env, { foo => 'bar' };
+};
+
+runtest 'success (perl)' => sub {
+ my $envfile = write_file('foo.perl', '{ foo => "bar" }');
+ my $env = $envf->_try_any_config_file($envfile);
+ is_deeply $env, { foo => 'bar' };
+};
+
+runtest 'do not returned hashref (pl)' => sub {
+ my $envfile = write_file('foo.pl', '[]');
+ eval { $envf->_try_any_config_file($envfile) };
+ like $@, qr/Should be return HASHREF/;
+};
+
+runtest 'file not found (pl)' => sub {
+ eval { $envf->_try_any_config_file('foooooooooooooooo.pl') };
+ ok $@;
+};
+
+runtest 'syntax error (pl)' => sub {
+ my $envfile = write_file('foo.pl', '{ foo => "bar"} }');
+ eval { $envf->_try_any_config_file($envfile) };
+ ok $@;
+};
+
+subtest json => sub {
+ test_requires('Data::Encoder');
+ test_requires('JSON');
+
+ runtest 'success (js)' => sub {
+ my $envfile = write_file('foo.js', '{"foo":"bar"}');
+ my $env = $envf->_try_any_config_file($envfile);
+ is_deeply $env, { foo => 'bar' };
+ };
+
+ runtest 'success (json)' => sub {
+ my $envfile = write_file('foo.json', '{"foo":"bar"}');
+ my $env = $envf->_try_any_config_file($envfile);
+ is_deeply $env, { foo => 'bar' };
+ };
+
+ runtest 'do not returned hashref (js)' => sub {
+ my $envfile = write_file('foo.js', '[]');
+ eval { $envf->_try_any_config_file($envfile) };
+ like $@, qr/Should be return HASHREF/;
+ };
+
+ runtest 'file not found (js)' => sub {
+ eval { $envf->_try_any_config_file('foooooooooooooooo.js') };
+ ok $@;
+ };
+
+ runtest 'syntax error (js)' => sub {
+ my $envfile = write_file('foo.js', '{"foo":"bar"} }');
+ eval { $envf->_try_any_config_file($envfile) };
+ ok $@;
+ };
+};
+
+subtest yaml => sub {
+ test_requires('Data::Encoder');
+ test_requires('YAML');
+
+ runtest 'success (yml)' => sub {
+ my $envfile = write_file('foo.yml', <<YAML);
+foo: bar
+YAML
+ my $env = $envf->_try_any_config_file($envfile);
+ is_deeply $env, { foo => 'bar' };
+ };
+
+ runtest 'success (yaml)' => sub {
+ my $envfile = write_file('foo.yaml', <<YAML);
+foo: bar
+YAML
+ my $env = $envf->_try_any_config_file($envfile);
+ is_deeply $env, { foo => 'bar' };
+ };
+
+ runtest 'do not returned hashref (yml)' => sub {
+ my $envfile = write_file('foo.yml', <<YAML);
+- foo
+- bar
+YAML
+ eval { $envf->_try_any_config_file($envfile) };
+ like $@, qr/Should be return HASHREF/;
+ };
+
+ runtest 'file not found (yml)' => sub {
+ eval { $envf->_try_any_config_file('foooooooooooooooo.yml') };
+ ok $@;
+ };
+
+ runtest 'syntax error (yml)' => sub {
+ my $envfile = write_file('foo.yml', '{"foo":"bar"} }');
+ eval { $envf->_try_any_config_file($envfile) };
+ ok $@;
+ };
+};
+
+done_testing;

0 comments on commit 2ef86d0

Please sign in to comment.
Something went wrong with that request. Please try again.