support extra connect_info options like quote_char for dbicdump

diff --git a/Changes b/Changes
index 1e210ce..1fbe412 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - support extra connect_info options like quote_char for dbicdump
         - fix breakage on perl 5.8.x related to unloading temporary classes
 
 0.07004  2011-01-24 03:43:05

diff --git a/script/dbicdump b/script/dbicdump
index d1573b2..628aa3e 100644 (file)
--- a/script/dbicdump
+++ b/script/dbicdump
@@ -8,6 +8,17 @@ dbicdump - Dump a schema using DBIx::Class::Schema::Loader
 
   dbicdump [-o <loader_option>=<value> ] <schema_class> <connect_info>
 
+Examples:
+
+  $ dbicdump -o dump_directory=./lib \
+    -o components='["InflateColumn::DateTime"]' \
+    MyApp::Schema dbi:SQLite:./foo.db '{ quote_char => "\"" }'
+
+  $ dbicdump -o dump_directory=./lib \
+    -o components='["InflateColumn::DateTime"]' \
+    -o preserve_case=1 \
+    MyApp::Schema dbi:mysql:database=foo user pass '{ quote_char => "`" }'
+
 =head1 DESCRIPTION
 
 Dbicdump generates a L<DBIx::Class> schema using
@@ -29,6 +40,10 @@ L<DBIx::Class::Schema::Loader>, L<DBIx::Class>.
 
 Dagfinn Ilmari Mannsåker C<< <ilmari@ilmari.org> >>
 
+=head1 CONTRIBUTORS
+
+Caelum: Rafael Kitover <rkitover@cpan.org>
+
 =head1 LICENSE
 
 This program is free software; you can redistribute it and/or modify it
@@ -53,6 +68,29 @@ $loader_options->{dump_directory} ||= '.';
 my ($schema_class, @loader_connect_info) = @ARGV
     or pod2usage(1);
 
+my $dsn = shift @loader_connect_info;
+
+my ($user, $pass) = $dsn =~ /sqlite/i ? ('', '')
+    : splice @loader_connect_info, 0, 2;
+
+my @extra_connect_info_opts = map parse_value($_), @loader_connect_info;
+
+make_schema_at(
+    $schema_class,
+    $loader_options,
+    [ $dsn, $user, $pass, @extra_connect_info_opts ],
+);
+
+exit 0;
+
+sub parse_value {
+    my $value = shift;
+
+    $value = eval $value if $value =~ /^\s*(?:sub\s*\{|q\w?\s*[^\w\s]|[[{])/;
+
+    return $value;
+}
+
 sub handle_option {
     my ($self, $key, $value) = @_;
 
@@ -60,13 +98,11 @@ sub handle_option {
     die "Unknown option: $key\n"
         unless DBIx::Class::Schema::Loader::Base->can($key);
 
-    $value = eval $value if $value =~ /^\s*(?:sub\s*\{|q\w?\s*[^\w\s]|[[{])/;
+    $value = parse_value $value;
 
     $loader_options->{$key} = $value;
 }
 
-make_schema_at(
-    $schema_class,
-    $loader_options,
-    \@loader_connect_info,
-);
+1;
+
+__END__

diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index 5c3c495..36806cc 100644 (file)
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -333,4 +333,18 @@ $t->dump_test(
   error => qr/My::MissingResultBaseClass.*is not installed/,
 );
 
+# test quote_char in connect_info for dbicdump
+$t->dump_test(
+  classname => 'DBICTest::DumpMore::1',
+  extra_connect_info => [
+    '',
+    '',
+    { quote_char => '"' },
+  ],
+  warnings => [
+    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+    qr/Schema dump completed/,
+  ],
+);
+
 done_testing;

diff --git a/t/lib/dbixcsl_dumper_tests.pm b/t/lib/dbixcsl_dumper_tests.pm
index 3b17a2b..1387810 100644 (file)
--- a/t/lib/dbixcsl_dumper_tests.pm
+++ b/t/lib/dbixcsl_dumper_tests.pm
@@ -49,7 +49,7 @@ sub _dump_directly {
     my @warns;
     eval {
         local $SIG{__WARN__} = sub { push(@warns, @_) };
-        $schema_class->connect(_get_dsn(\%tdata));
+        $schema_class->connect(_get_connect_info(\%tdata));
     };
     my $err = $@;
 
@@ -72,7 +72,13 @@ sub _dump_dbicdump {
         push @cmd, '-o', "$opt=$val";
     }
 
-    push @cmd, $tdata{classname}, _get_dsn(\%tdata);
+    my @connect_info = _get_connect_info(\%tdata);
+
+    for my $info (@connect_info) {
+        $info = dumper_squashed $info if ref $info;
+    }
+
+    push @cmd, $tdata{classname}, @connect_info;
 
     # make sure our current @INC gets used by dbicdump
     use Config;
@@ -95,7 +101,7 @@ sub _dump_dbicdump {
     return @warnings;
 }
 
-sub _get_dsn {
+sub _get_connect_info {
     my $opts = shift;
 
     my $test_db_class = $opts->{test_db_class} || 'make_dbictest_db';
@@ -108,7 +114,7 @@ sub _get_dsn {
         ${$test_db_class . '::dsn'};
     };
 
-    return $dsn;
+    return ($dsn, @{ $opts->{extra_connect_info} || [] });
 }
 
 sub _check_error {