column_info POD generation improvements

diff --git a/Changes b/Changes
index 4ad963d..bd57604 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,6 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - generate POD for refs correctly from column_info
         - fix tables list for SQL Anywhere
 
 0.05003  2010-02-20 05:19:51

diff --git a/Makefile.PL b/Makefile.PL
index d097dd9..5524a97 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -29,6 +29,7 @@ requires 'Class::Unload'               => 0;
 requires 'File::Slurp'                 => '9999.13';
 requires 'List::MoreUtils'             => 0;
 requires 'namespace::autoclean'        => 0;
+requires 'Data::Dumper::Concise'       => '1.200';
 
 install_script 'script/dbicdump';
 

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index e715268..95906a6 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -3,6 +3,7 @@ package DBIx::Class::Schema::Loader::Base;
 use strict;
 use warnings;
 use base qw/Class::Accessor::Grouped Class::C3::Componentised/;
+use namespace::autoclean;
 use Class::C3;
 use Carp::Clan qw/^DBIx::Class/;
 use DBIx::Class::Schema::Loader::RelBuilder;
@@ -15,6 +16,8 @@ use Lingua::EN::Inflect::Number qw//;
 use File::Temp qw//;
 use Class::Unload;
 use Class::Inspector ();
+use Data::Dumper::Concise;
+use Scalar::Util 'looks_like_number';
 require DBIx::Class;
 
 our $VERSION = '0.05003';
@@ -1550,8 +1553,15 @@ sub _make_pod {
                             my $s = $attrs->{$_};
                             $s = !defined $s         ? 'undef'          :
                                   length($s) == 0     ? '(empty string)' :
-                                  ref($s) eq 'SCALAR' ? $$s              :
-                                                        $s
+                                  ref($s) eq 'SCALAR' ? $$s :
+                                  ref($s)             ? do {
+                                                        my $dd = Dumper;
+                                                        $dd->Indent(0);
+                                                        $dd->Values([$s]);
+                                                        $dd->Dump;
+                                                      } :
+                                  looks_like_number($s) ? $s :
+                                                        qq{'$s'}
                                   ;
 
                             "  $_: $s"

diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index 9f31abd..1242d78 100644 (file)
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -4,6 +4,7 @@ use lib qw(t/lib);
 use File::Path;
 use IPC::Open3;
 use make_dbictest_db;
+use Data::Dumper::Concise;
 require DBIx::Class::Schema::Loader;
 
 my $DUMP_PATH = './t/_dump';
@@ -38,6 +39,7 @@ sub dump_dbicdump {
     my @cmd = ($^X, qw(./script/dbicdump));
 
     while (my ($opt, $val) = each(%{ $tdata{options} })) {
+        $val = Dumper($val) if ref $val;
         push @cmd, '-o', "$opt=$val";
     }
 
@@ -187,7 +189,12 @@ rmtree($DUMP_PATH, 1, 1);
 
 do_dump_test(
     classname => 'DBICTest::DumpMore::1',
-    options => { },
+    options => {
+        custom_column_info => sub {
+            my ($table, $col, $info) = @_;
+            return +{ extra => { is_footext => 1 } } if $col eq 'footext';
+        }
+    },
     error => '',
     warnings => [
         qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
@@ -202,8 +209,8 @@ do_dump_test(
 qr/package DBICTest::DumpMore::1::Foo;/,
 qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
 qr/=head1 ACCESSORS\n\n/,
-qr/=head2 fooid\n\n  data_type: INTEGER\n  default_value: undef\n  is_nullable: 1\n  size: undef\n\n/,
-qr/=head2 footext\n\n  data_type: TEXT\n  default_value: undef\n  is_nullable: 1\n  size: undef\n\n/,
+qr/=head2 fooid\n\n  data_type: 'INTEGER'\n  default_value: undef\n  is_nullable: 1\n  size: undef\n\n/,
+qr/=head2 footext\n\n  data_type: 'TEXT'\n  default_value: 'footext'\n  extra: {is_footext => 1}\n  is_nullable: 1\n  size: undef\n\n/,
 qr/->set_primary_key/,
 qr/=head1 RELATIONS\n\n/,
 qr/=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
@@ -213,8 +220,8 @@ qr/1;\n$/,
 qr/package DBICTest::DumpMore::1::Bar;/,
 qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
 qr/=head1 ACCESSORS\n\n/,
-qr/=head2 barid\n\n  data_type: INTEGER\n  default_value: undef\n  is_nullable: 1\n  size: undef\n\n/,
-qr/=head2 fooref\n\n  data_type: INTEGER\n  default_value: undef\n  is_foreign_key: 1\n  is_nullable: 1\n  size: undef\n\n/,
+qr/=head2 barid\n\n  data_type: 'INTEGER'\n  default_value: undef\n  is_nullable: 1\n  size: undef\n\n/,
+qr/=head2 fooref\n\n  data_type: 'INTEGER'\n  default_value: undef\n  is_foreign_key: 1\n  is_nullable: 1\n  size: undef\n\n/,
 qr/->set_primary_key/,
 qr/=head1 RELATIONS\n\n/,
 qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,

diff --git a/t/lib/make_dbictest_db.pm b/t/lib/make_dbictest_db.pm
index 6613288..99ad862 100644 (file)
--- a/t/lib/make_dbictest_db.pm
+++ b/t/lib/make_dbictest_db.pm
@@ -16,16 +16,17 @@ my $dbh = DBI->connect($dsn);
 $dbh->do($_) for (
     q|CREATE TABLE foo (
         fooid INTEGER PRIMARY KEY,
-        footext TEXT
+        footext TEXT DEFAULT 'footext',
+        foodt TIMESTAMP DEFAULT CURRENT_TIMESTAMP
       )|,
     q|CREATE TABLE bar (
         barid INTEGER PRIMARY KEY,
         fooref INTEGER REFERENCES foo(fooid)
       )|,
-    q|INSERT INTO foo VALUES (1,'Foo text for number 1')|,
-    q|INSERT INTO foo VALUES (2,'Foo record associated with the Bar with barid 3')|,
-    q|INSERT INTO foo VALUES (3,'Foo text for number 3')|,
-    q|INSERT INTO foo VALUES (4,'Foo text for number 4')|,
+    q|INSERT INTO foo (fooid, footext) VALUES (1,'Foo text for number 1')|,
+    q|INSERT INTO foo (fooid, footext) VALUES (2,'Foo record associated with the Bar with barid 3')|,
+    q|INSERT INTO foo (fooid, footext) VALUES (3,'Foo text for number 3')|,
+    q|INSERT INTO foo (fooid, footext) VALUES (4,'Foo text for number 4')|,
     q|INSERT INTO bar VALUES (1,4)|,
     q|INSERT INTO bar VALUES (2,3)|,
     q|INSERT INTO bar VALUES (3,2)|,