From: Rafael Kitover Date: Tue, 23 Feb 2010 22:56:20 +0000 (-0500) Subject: column_info POD generation improvements X-Git-Tag: 0.06000~82 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f170d55b2829518155a9b8817639affab3559b03;p=dbsrgits%2FDBIx-Class-Schema-Loader.git column_info POD generation improvements --- diff --git a/Changes b/Changes index 4ad963d..bd57604 100644 --- 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 --- 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 --- 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 --- 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\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\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 --- 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)|,