From: Rafael Kitover <rkitover@cpan.org>
Date: Sun, 17 Jan 2010 14:43:09 +0000 (+0000)
Subject: added "generate_pod" option, defaults to on
X-Git-Tag: 0.05000~26
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=492dce8da93ceb9dd348cd8fd155ecb08bf95093;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

added "generate_pod" option, defaults to on
---

diff --git a/Changes b/Changes
index a9cbf02..d54329e 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - added 'generate_pod' option, defaults to on
+
 0.04999_14  2010-01-14 06:47:07
         - use_namespaces now default, with upgrade/downgrade support
         - filter out un-selectable tables/views
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index ba188d8..a486122 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -65,6 +65,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 _rewriting_result_namespace
                                 use_namespaces
                                 result_namespace
+                                generate_pod
 /);
 
 =head1 NAME
@@ -158,6 +159,13 @@ next major version upgrade:
 
     __PACKAGE__->naming('v5');
 
+=head2 generate_pod
+
+By default POD will be generated for columns and relationships, using database
+metadata for the text if available and supported (Postgres only so far.)
+
+Set this to C<0> to turn off all POD generation.
+
 =head2 relationship_attrs
 
 Hashref of attributes to pass to each generated relationship, listed
@@ -419,6 +427,7 @@ sub new {
     $self->_check_back_compat;
 
     $self->use_namespaces(1) unless defined $self->use_namespaces;
+    $self->generate_pod(1)   unless defined $self->generate_pod;
 
     $self;
 }
@@ -1379,6 +1388,8 @@ sub _make_pod {
     my $class  = shift;
     my $method = shift;
 
+    return unless $self->generate_pod;
+
     if ( $method eq 'table' ) {
         my ($table) = @_;
         $self->_pod( $class, "=head1 NAME" );
@@ -1437,7 +1448,6 @@ sub _pod_cut {
     $self->_raw_stmt( $class, "\n=cut\n" );
 }
 
-
 # Store a raw source line for a class (for dumping purposes)
 sub _raw_stmt {
     my ($self, $class, $stmt) = @_;
diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index c27973e..dd67831 100644
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -222,6 +222,21 @@ do_dump_test(
 
 do_dump_test(
     classname => 'DBICTest::DumpMore::1',
+    options => { use_namespaces => 1, generate_pod => 0 },
+    error => '',
+    warnings => [
+        qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
+        qr/Schema dump completed/,
+    ],
+    neg_regexes => {
+        'Result/Foo' => [
+            qr/^=/m,
+        ],
+    },
+);
+
+do_dump_test(
+    classname => 'DBICTest::DumpMore::1',
     options => { use_namespaces => 1 },
     error => '',
     warnings => [