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 (file)
--- 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 (file)
--- 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 (file)
--- a/script/dbicdump
+++ b/script/dbicdump
@@ -7,7 +7,8 @@ dbicdump - Dump a schema using DBIx::Class::Schema::Loader
 =head1 SYNOPSIS
 
   dbicdump <configuration_file>
-  dbicdump [-o <loader_option>=<value> ] <schema_class> <connect_info>
+  dbicdump [-I <lib-path>] [-o <loader_option>=<value> ] \
+                <schema_class> <connect_info>
 
 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
     <connect_info>
@@ -57,6 +60,8 @@ an example of a general config file is as follows:
 
 Using a config file requires L<Config::Any> installed.
 
+The optional C<lib> key is equivalent to the C<-I> option.
+
 =head1 DESCRIPTION
 
 Dbicdump generates a L<DBIx::Class> schema using
@@ -82,6 +87,8 @@ Dagfinn Ilmari Manns?ker C<< <ilmari@ilmari.org> >>
 
 Caelum: Rafael Kitover <rkitover@cpan.org>
 
+alnewkirk: Al Newkirk <awncorp@cpan.org>
+
 =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 (file)
--- 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
+
 <connect_info>
     dsn $make_dbictest_db::dsn
 </connect_info>
 
 <loader_options>
-    dump_directory $dump_path
-    components     InflateColumn::DateTime
-    quiet          1
+    dump_directory    $dump_path
+    components        InflateColumn::DateTime
+    schema_base_class TestSchemaBaseClass
+    quiet             1
 </loader_options>
 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 (file)
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';
+}