From: Rafael Kitover <rkitover@cpan.org>
Date: Sun, 24 Jul 2011 05:23:03 +0000 (-0400)
Subject: add quiet option
X-Git-Tag: 0.07011~65
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=900195eb6fc5ac5c15673b5eef751d513c6cd972

add quiet option

Also adds some improvements to the t/lib/dbixcsl_dumper_tests.pm test
library:

- list warnings if warning count doesn't match

- fixes undefined warning if there are more expected warnings than
  received warnings
---

diff --git a/Changes b/Changes
index 8c5cbad..f8d667e 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - add quiet option
         - $schema->loader is now a public method
         - add schema_components option
         - sort relationships so they always come out in the same order
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 16cde2b..6b27f3e 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -75,6 +75,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 tables
                                 class_to_table
                                 uniq_to_primary
+                                quiet
 /);
 
 
@@ -240,6 +241,12 @@ next major version upgrade:
 
     __PACKAGE__->naming('v7');
 
+=head2 quiet
+
+If true, will not print the usual C<Dumping manual schema ... Schema dump
+completed.> messages. Does not affect warnings (except for warnings related to
+L</really_erase_my_files>.)
+
 =head2 generate_pod
 
 By default POD will be generated for columns and relationships, using database
@@ -1283,11 +1290,10 @@ sub _load_tables {
 
     if(!$self->skip_relationships) {
         # The relationship loader needs a working schema
-        $self->{quiet} = 1;
+        local $self->{quiet} = 1;
         local $self->{dump_directory} = $self->{temp_directory};
         $self->_reload_classes(\@tables);
         $self->_load_relationships(\@tables);
-        $self->{quiet} = 0;
 
         # Remove that temp dir from INC so it doesn't get reloaded
         @INC = grep $_ ne $self->dump_directory, @INC;
@@ -1440,7 +1446,7 @@ sub _dump_to_dir {
 
     my $target_dir = $self->dump_directory;
     warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
-        unless $self->{dynamic} or $self->{quiet};
+        unless $self->dynamic or $self->quiet;
 
     my $schema_text =
           qq|package $schema_class;\n\n|
@@ -1539,7 +1545,7 @@ sub _dump_to_dir {
         }
     }
 
-    warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
+    warn "Schema dump completed.\n" unless $self->dynamic or $self->quiet;
 
 }
 
@@ -1559,7 +1565,7 @@ sub _write_classfile {
 
     if (-f $filename && $self->really_erase_my_files) {
         warn "Deleting existing file '$filename' due to "
-            . "'really_erase_my_files' setting\n" unless $self->{quiet};
+            . "'really_erase_my_files' setting\n" unless $self->quiet;
         unlink($filename);
     }
 
diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index 1189104..a2d0247 100644
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -13,10 +13,6 @@ $t->cleanup;
 # test loading external content
 $t->dump_test(
   classname => 'DBICTest::Schema::_no_skip_load_external',
-  warnings => [
-    qr/Dumping manual schema for DBICTest::Schema::_no_skip_load_external to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     Foo => [
       qr/package DBICTest::Schema::_no_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/
@@ -28,12 +24,8 @@ $t->dump_test(
 $t->dump_test(
   classname => 'DBICTest::Schema::_skip_load_external',
   options => {
-    skip_load_external => 1
+    skip_load_external => 1,
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::Schema::_skip_load_external to directory /,
-    qr/Schema dump completed/,
-  ],
   neg_regexes => {
     Foo => [
       qr/package DBICTest::Schema::_skip_load_external::Foo;\nour \$skip_me = "bad mojo";\n1;/
@@ -52,10 +44,6 @@ $t->cleanup;
   $t->dump_test(
     classname => 'DBICTest::Schema::_config_file',
     options => { config_file => "$config_file" },
-    warnings => [
-      qr/Dumping manual schema for DBICTest::Schema::_config_file to directory /,
-      qr/Schema dump completed/,
-    ],
     neg_regexes => {
       Foo => [
         qr/has_many/,
@@ -80,10 +68,6 @@ $t->dump_test(
     classname => 'DBICTest::Schema::_preserve_column_accessors',
     test_db_class => 'make_dbictest_db_with_unique',
     options => { naming => { column_accessors => 'preserve' } },
-    warnings => [
-        qr/Dumping manual schema for DBICTest::Schema::_preserve_column_accessors to directory /,
-        qr/Schema dump completed/,
-    ],
     neg_regexes => {
         RouteChange => [
             qr/\baccessor\b/,
@@ -102,10 +86,6 @@ $t->cleanup;
 $t->dump_test(
     classname => 'DBICTest::Schema::_sorted_rels',
     test_db_class => 'make_dbictest_db_with_unique',
-    warnings => [
-        qr/Dumping manual schema for DBICTest::Schema::_sorted_rels to directory /,
-        qr/Schema dump completed/,
-    ],
     regexes => {
         Baz => [
             qr/->might_have\(\n  "quux".*->belongs_to\(\n  "station_visited"/s,
@@ -119,10 +99,6 @@ $t->cleanup;
 $t->dump_test(
     classname => 'DBICTest::Schema::_plural_monikers',
     options => { naming => { monikers => 'plural' } },
-    warnings => [
-        qr/Dumping manual schema for DBICTest::Schema::_plural_monikers to directory /,
-        qr/Schema dump completed/,
-    ],
     regexes => {
         Foos => [
             qr/\n=head1 NAME\n\nDBICTest::Schema::_plural_monikers::Foos\n\n=cut\n\n/,
@@ -140,10 +116,6 @@ $t->dump_test(
     classname => 'DBICTest::Schema::_singular_monikers',
     test_db_class => 'make_dbictest_db_plural_tables',
     options => { naming => { monikers => 'singular' } },
-    warnings => [
-        qr/Dumping manual schema for DBICTest::Schema::_singular_monikers to directory /,
-        qr/Schema dump completed/,
-    ],
     regexes => {
         Foo => [
             qr/\n=head1 NAME\n\nDBICTest::Schema::_singular_monikers::Foo\n\n=cut\n\n/,
@@ -161,10 +133,6 @@ $t->dump_test(
     classname => 'DBICTest::Schema::_preserve_monikers',
     test_db_class => 'make_dbictest_db_plural_tables',
     options => { naming => { monikers => 'preserve' } },
-    warnings => [
-        qr/Dumping manual schema for DBICTest::Schema::_preserve_monikers to directory /,
-        qr/Schema dump completed/,
-    ],
     regexes => {
         Foos => [
             qr/\n=head1 NAME\n\nDBICTest::Schema::_preserve_monikers::Foos\n\n=cut\n\n/,
@@ -191,10 +159,6 @@ $t->dump_test(
     left_base_classes => 'TestLeftBase',
     components => [ 'TestComponent', '+TestComponentFQN' ],
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/package DBICTest::DumpMore::1;/,
@@ -242,10 +206,6 @@ $t->append_to_class('DBICTest::DumpMore::1::Foo',q{# XXX This is my custom conte
 
 $t->dump_test(
   classname => 'DBICTest::DumpMore::1',
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/package DBICTest::DumpMore::1;/,
@@ -270,13 +230,6 @@ $t->dump_test(
   options => {
     really_erase_my_files => 1 
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Deleting existing file /,
-    qr/Deleting existing file /,
-    qr/Deleting existing file /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/package DBICTest::DumpMore::1;/,
@@ -310,10 +263,6 @@ $t->dump_test(
     use_namespaces => 1,
     generate_pod => 0
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   neg_regexes => {
     'Result/Foo' => [
       qr/^=/m,
@@ -329,10 +278,6 @@ $t->dump_test(
     qualify_objects => 1,
     use_namespaces => 1
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     'Result/Foo' => [
       qr/^\Q__PACKAGE__->table("foo_schema.foo");\E/m,
@@ -347,10 +292,6 @@ $t->dump_test(
   options => {
     use_namespaces => 1
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/package DBICTest::DumpMore::1;/,
@@ -378,10 +319,6 @@ $t->dump_test(
     resultset_namespace => 'RSet',
     default_resultset_class => 'RSetBase',
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/package DBICTest::DumpMore::1;/,
@@ -414,10 +351,6 @@ $t->dump_test(
     result_base_class => 'My::ResultBaseClass',
     schema_base_class => 'My::SchemaBaseClass',
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/package DBICTest::DumpMore::1;/,
@@ -442,7 +375,6 @@ $t->dump_test(
   },
 );
 
-
 $t->dump_test(
   classname => 'DBICTest::DumpMore::1',
   options => {
@@ -460,10 +392,6 @@ $t->dump_test(
     '',
     { quote_char => '"' },
   ],
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
 );
 
 done_testing;
diff --git a/t/26dump_use_moose.t b/t/26dump_use_moose.t
index 7eac67a..fe98553 100644
--- a/t/26dump_use_moose.t
+++ b/t/26dump_use_moose.t
@@ -24,10 +24,6 @@ $t->dump_test(
     schema_base_class => 'My::SchemaBaseClass',
     result_roles => ['TestRole', 'TestRole2'],
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/\nuse Moose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/,
@@ -58,10 +54,6 @@ $t->dump_test(
     result_base_class => 'My::ResultBaseClass',
     schema_base_class => 'My::SchemaBaseClass',
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/\nuse base 'My::SchemaBaseClass';\n/,
@@ -85,10 +77,6 @@ $t->dump_test(
     result_base_class => 'My::ResultBaseClass',
     schema_base_class => 'My::SchemaBaseClass',
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/\nuse Moose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/,
@@ -115,10 +103,6 @@ $t->dump_test(
     result_base_class => 'My::ResultBaseClass',
     schema_base_class => 'My::SchemaBaseClass',
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-    qr/Schema dump completed/,
-  ],
   regexes => {
     schema => [
       qr/\nuse base 'My::SchemaBaseClass';\n/,
@@ -145,10 +129,6 @@ for my $supply_use_moose (1, 0) {
       result_base_class => 'My::ResultBaseClass',
       schema_base_class => 'My::SchemaBaseClass',
     },
-    warnings => [
-      qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-      qr/Schema dump completed/,
-    ],
     regexes => {
       schema => [
         qr/\nuse Moose;\nuse namespace::autoclean;\nextends 'My::SchemaBaseClass';\n\n/,
@@ -181,9 +161,6 @@ $t->dump_test (
     result_base_class => 'My::ResultBaseClass',
     schema_base_class => 'My::SchemaBaseClass',
   },
-  warnings => [
-    qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
-  ],
   error => qr/\QIt is not possible to "downgrade" a schema that was loaded with use_moose => 1\E/,
 );
 
diff --git a/t/lib/dbixcsl_dumper_tests.pm b/t/lib/dbixcsl_dumper_tests.pm
index 1387810..1ee720a 100644
--- a/t/lib/dbixcsl_dumper_tests.pm
+++ b/t/lib/dbixcsl_dumper_tests.pm
@@ -44,7 +44,10 @@ sub _dump_directly {
 
     no strict 'refs';
     @{$schema_class . '::ISA'} = ('DBIx::Class::Schema::Loader');
-    $schema_class->loader_options(%{$tdata{options}});
+    $schema_class->loader_options(
+      quiet => 1,
+      %{$tdata{options}},
+    );
 
     my @warns;
     eval {
@@ -67,6 +70,8 @@ sub _dump_dbicdump {
     # use $^X so we execute ./script/dbicdump with the same perl binary that the tests were executed with
     my @cmd = ($^X, qw(script/dbicdump));
 
+    $tdata{options}{quiet} = 1 unless exists $tdata{options}{quiet};
+
     while (my ($opt, $val) = each(%{ $tdata{options} })) {
         $val = dumper_squashed $val if ref $val;
         push @cmd, '-o', "$opt=$val";
@@ -135,7 +140,6 @@ sub _check_error {
     is $got, $expected, 'error matches';
 }
 
-
 sub _test_dumps {
     my ($tdata, @warns) = @_;
 
@@ -143,10 +147,12 @@ sub _test_dumps {
 
     my $schema_class = $tdata{classname};
     my $check_warns = $tdata{warnings};
-    is(@warns, @$check_warns, "$schema_class warning count");
+
+    is(@warns, @$check_warns, "$schema_class warning count")
+      or diag @warns;
 
     for(my $i = 0; $i <= $#$check_warns; $i++) {
-        like($warns[$i], $check_warns->[$i], "$schema_class warning $i");
+        like(($warns[$i] || ''), $check_warns->[$i], "$schema_class warning $i");
     }
 
     my $file_regexes = $tdata{regexes};