From: Rafael Kitover Date: Mon, 31 Oct 2011 13:50:43 +0000 (-0400) Subject: add -I option to dbicdump X-Git-Tag: 0.07011~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=112415f1a0c30d7fb77412b91da7890e54b43393;p=dbsrgits%2FDBIx-Class-Schema-Loader.git add -I option to dbicdump Add an -I option to dbicdump to add things to @INC during the dump, like perl's -I option (see perldoc perlrun.) For the config file dbicdump format, add the 'lib' key that is the equivalent of the -I option. Add error checking to ::Utils slurp_file and write_file subs in the open calls. Add alnewkirk to list of CONTRIBUTORS for dbicdump. --- diff --git a/Changes b/Changes index 11c18d6..5e20d3d 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,6 @@ Revision history for Perl extension DBIx::Class::Schema::Loader + - add -I option to dbicdump - do not delete default custom content comment and ending 1; from custom content in files that are being renamed (RT#70507) - use MooseX::MarkAsMethods instead of namespace::autoclean for the diff --git a/lib/DBIx/Class/Schema/Loader/Utils.pm b/lib/DBIx/Class/Schema/Loader/Utils.pm index 2c65bb1..77a8259 100644 --- a/lib/DBIx/Class/Schema/Loader/Utils.pm +++ b/lib/DBIx/Class/Schema/Loader/Utils.pm @@ -5,6 +5,7 @@ use strict; use warnings; use Test::More; use String::CamelCase 'wordsplit'; +use Carp::Clan qw/^DBIx::Class/; use namespace::clean; use Exporter 'import'; use Data::Dumper (); @@ -143,8 +144,13 @@ sub warnings_exist_silent(&$$) { } sub slurp_file($) { - open my $fh, '<:encoding(UTF-8)', shift; + my $file_name = shift; + + open my $fh, '<:encoding(UTF-8)', $file_name, + or croak "Can't open '$file_name' for reading: $!"; + my $data = do { local $/; <$fh> }; + close $fh; $data =~ s/$CRLF|$LF/\n/g; @@ -153,7 +159,11 @@ sub slurp_file($) { } sub write_file($$) { - open my $fh, '>:encoding(UTF-8)', shift; + my $file_name = shift; + + open my $fh, '>:encoding(UTF-8)', $file_name, + or croak "Can't open '$file_name' for writing: $!"; + print $fh shift; close $fh; } diff --git a/script/dbicdump b/script/dbicdump index b175855..020ebf2 100644 --- a/script/dbicdump +++ b/script/dbicdump @@ -7,7 +7,8 @@ dbicdump - Dump a schema using DBIx::Class::Schema::Loader =head1 SYNOPSIS dbicdump - dbicdump [-o = ] + dbicdump [-I ] [-o = ] \ + Examples: @@ -21,7 +22,7 @@ Examples: -o components='["InflateColumn::DateTime"]' \ MyApp::Schema dbi:SQLite:./foo.db '{ quote_char => "\"" }' - $ dbicdump -o dump_directory=./lib \ + $ dbicdump -Ilib -o dump_directory=./lib \ -o components='["InflateColumn::DateTime"]' \ -o preserve_case=1 \ MyApp::Schema dbi:mysql:database=foo user pass '{ quote_char => "`" }' @@ -41,6 +42,8 @@ Configuration files must have schema_class and connect_info sections, an example of a general config file is as follows: schema_class MyApp::Schema + + lib /extra/perl/libs # connection string @@ -57,6 +60,8 @@ an example of a general config file is as follows: Using a config file requires L installed. +The optional C key is equivalent to the C<-I> option. + =head1 DESCRIPTION Dbicdump generates a L schema using @@ -82,6 +87,8 @@ Dagfinn Ilmari Manns?ker C<< >> Caelum: Rafael Kitover +alnewkirk: Al Newkirk + =head1 LICENSE This program is free software; you can redistribute it and/or modify it @@ -94,12 +101,20 @@ use warnings; use Getopt::Long; use Pod::Usage; use DBIx::Class::Schema::Loader 'make_schema_at'; +use namespace::clean; use DBIx::Class::Schema::Loader::Base (); use DBIx::Class::Schema::Loader::Optional::Dependencies (); +require lib; my $loader_options; -GetOptions( 'loader-option|o=s%' => \&handle_option ); +Getopt::Long::Configure('gnu_getopt'); + +GetOptions( + 'I=s' => sub { shift; lib->import(shift) }, + 'loader-option|o=s%' => \&handle_option, +); + $loader_options->{dump_directory} ||= '.'; if (@ARGV == 1) { @@ -121,6 +136,18 @@ if (@ARGV == 1) { unless (keys %{$c->{connect_info}} && $c->{schema_class}) { pod2usage(1); } + + my @libs; + + if ($c->{lib}) { + if (ref $c->{lib}) { + @libs = @{ $c->{lib} }; + } + + @libs = ($c->{lib}); + } + + lib->import($_) for @libs; my ($dsn, $user, $pass, $options) = map { $c->{connect_info}->{$_} } qw/dsn user pass options/; diff --git a/t/60dbicdump_config.t b/t/60dbicdump_config.t index 12c5153..48168a6 100644 --- a/t/60dbicdump_config.t +++ b/t/60dbicdump_config.t @@ -5,8 +5,10 @@ use warnings; use Test::More; use File::Path qw/make_path rmtree/; -use DBIx::Class::Schema::Loader::Optional::Dependencies (); use DBIx::Class::Schema::Loader::Utils 'slurp_file'; +use Try::Tiny; +use namespace::clean; +use DBIx::Class::Schema::Loader::Optional::Dependencies (); use lib 't/lib'; use make_dbictest_db (); use dbixcsl_test_dir '$tdir'; @@ -31,14 +33,17 @@ open my $fh, '>', $config_file print $fh <<"EOF"; schema_class DBICTest::Schema +lib t/lib + dsn $make_dbictest_db::dsn - dump_directory $dump_path - components InflateColumn::DateTime - quiet 1 + dump_directory $dump_path + components InflateColumn::DateTime + schema_base_class TestSchemaBaseClass + quiet 1 EOF @@ -49,7 +54,7 @@ system $^X, 'script/dbicdump', $config_file; is $? >> 8, 0, 'dbicdump executed successfully'; -my $foo = slurp_file "$dump_path/DBICTest/Schema/Result/Foo.pm"; +my $foo = try { slurp_file "$dump_path/DBICTest/Schema/Result/Foo.pm" } || ''; like $foo, qr/InflateColumn::DateTime/, 'loader options read correctly from config_file'; diff --git a/t/65dbicdump_invocations.t b/t/65dbicdump_invocations.t new file mode 100644 index 0000000..cef666b --- /dev/null +++ b/t/65dbicdump_invocations.t @@ -0,0 +1,42 @@ +#!perl + +use strict; +use warnings; + +use Test::More; +use DBIx::Class::Schema::Loader::Utils 'slurp_file'; +use lib 't/lib'; +use make_dbictest_db (); +use dbixcsl_test_dir '$tdir'; + +plan tests => 3; + +# Test the -I option + +dbicdump( + '-I', 't/lib', '-o', 'schema_base_class=TestSchemaBaseClass', 'DBICTest::Schema', + $make_dbictest_db::dsn +); + +dbicdump( + '-It/lib', '-o', 'schema_base_class=TestSchemaBaseClass', 'DBICTest::Schema', + $make_dbictest_db::dsn +); + +dbicdump( + '-I/dummy', '-It/lib', '-o', 'schema_base_class=TestSchemaBaseClass', + 'DBICTest::Schema', + $make_dbictest_db::dsn +); + +done_testing; + +sub dbicdump { + system $^X, 'script/dbicdump', + '-o', "dump_directory=$tdir", + '-o', 'quiet=1', + @_; + + is $? >> 8, 0, + 'dbicdump executed successfully'; +}