From: Ben Tilly Date: Fri, 22 Jul 2011 23:03:34 +0000 (-0700) Subject: generic comments mechanism, MySQL specific support X-Git-Tag: 0.07011~60 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5c06aa08ab17d9d0e8437a990b5717238deeb8fd;p=dbsrgits%2FDBIx-Class-Schema-Loader.git generic comments mechanism, MySQL specific support Adds support for the table_comments and column_comments tables, which override the db-specific metadata comment support in ::Loader::DBI. Documents these tables in ::Loader::Base . Also adds support for MySQL table and column comments from information_schema. --- diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm index 5634bc6..a576c71 100644 --- a/lib/DBIx/Class/Schema/Loader/Base.pm +++ b/lib/DBIx/Class/Schema/Loader/Base.pm @@ -72,6 +72,8 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/ loader_class qualify_objects tables + table_comments_table + column_comments_table class_to_table uniq_to_primary quiet @@ -262,8 +264,23 @@ L.) By default POD will be generated for columns and relationships, using database metadata for the text if available and supported. -Reading database metadata (e.g. C) is only -supported for Postgres right now. +Metadata can be stored in two ways. + +The first is that you can create two tables named C and +C respectively. They both need to have columns named +C and C. The second one needs to have a column +named C. Then data stored in these tables will be used as a +source of metadata about tables and comments. + +(If you wish you can change the name of these tables with the parameters +L and L.) + +As a fallback you can use built-in commenting mechanisms. Currently this +is only supported for PostgreSQL and MySQL. To create comments in +PostgreSQL you add statements of the form C. +To create comments in MySQL you add C to the end of the +column or table definition. Note that MySQL restricts the length of comments, +and also does not handle complex Unicode characters properly. Set this to C<0> to turn off all POD generation. @@ -299,6 +316,16 @@ which it will be forced into a separate description section. The default is C<60> +=head2 table_comments_table + +The table to look for comments about tables in. By default C. +See L for details. + +=head2 column_comments_table + +The table to look for comments about columns in. By default C. +See L for details. + =head2 relationship_attrs Hashref of attributes to pass to each generated relationship, listed @@ -783,6 +810,8 @@ sub new { $self->{schema_class} ||= ( ref $self->{schema} || $self->{schema} ); $self->{schema} ||= $self->{schema_class}; + $self->{table_comments_table} ||= 'table_comments'; + $self->{column_comments_table} ||= 'column_comments'; croak "dump_overwrite is deprecated. Please read the" . " DBIx::Class::Schema::Loader::Base documentation" diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm index 964e923..a727fe4 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI.pm @@ -266,6 +266,77 @@ sub _table_uniq_info { return \@retval; } +sub _table_found { + my ( $self, $table ) = @_; + return grep {lc($_) eq lc($table)} $self->_tables_list({}); +} + +sub _table_found_cached { + my ( $self, $table ) = @_; + if (not exists ($self->{found_table}->{$table})) { + $self->{found_table}->{$table} = $self->_table_found($table); + } + return $self->{found_table}->{$table}; +} + +sub _table_columns_found { + my ( $self, $table, @columns ) = @_; + my %known_column = map {(lc($_)=>$_)} @{$self->_table_columns($table)}; + for my $column (@columns) { + if (not exists $known_column{lc($column)}) { + return(); + } + } + # In scalar context, whether or not all columns were found. + # In list context, all of the found columns. + return map $known_column{lc($_)}, @columns; +} + +sub _table_columns_found_cached { + my ( $self, $table, @columns ) = @_; + my $key = join chr(28), $table, @columns; + if (not exists $self->{found_table_columns}->{$key}) { + $self->{found_table_columns}->{$key} + = [$self->_table_columns_found($table, @columns)]; + } + return @{ $self->{found_table_columns}{$key} }; +} + +sub _table_comment { + my ( $self, $table ) = @_; + my $table_comments = $self->table_comments_table; + if ($self->_table_found_cached($table_comments) and + $self->_table_columns_found_cached( + $table_comments, 'table_name', 'comment_text') + ) { + my ($comment) = $self->schema->storage->dbh->selectrow_array( + qq{SELECT comment_text + FROM $table_comments + WHERE table_name = ? + }, undef, $table); + return $comment; + } + return undef; +} + +sub _column_comment { + my ( $self, $table, $column_counter, $column_name ) = @_; + my $column_comments = $self->column_comments_table; + if ($self->_table_found_cached($column_comments) and + $self->_table_columns_found_cached( + $column_comments, 'table_name', 'column_name', 'comment_text') + ) { + my ($comment) = $self->schema->storage->dbh->selectrow_array( + qq{SELECT comment_text + FROM $column_comments + WHERE table_name = ? + AND column_name = ? + }, undef, $table, $column_name); + return $comment; + } + return undef; +} + # Find relationships sub _table_fk_info { my ($self, $table) = @_; diff --git a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm index 913e1d1..6901280 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm @@ -129,28 +129,36 @@ sub _table_uniq_info { sub _table_comment { my ( $self, $table ) = @_; - my ($table_comment) = $self->schema->storage->dbh->selectrow_array( - q{SELECT obj_description(oid) - FROM pg_class - WHERE relname=? AND relnamespace=( - SELECT oid FROM pg_namespace WHERE nspname=?) - }, undef, $table, $self->db_schema - ); + my ($table_comment) = $self->next::method($table); + if (not $table_comment) { + ($table_comment) = $self->schema->storage->dbh->selectrow_array( + q{SELECT obj_description(oid) + FROM pg_class + WHERE relname=? AND relnamespace=( + SELECT oid FROM pg_namespace WHERE nspname=?) + }, undef, $table, $self->db_schema + ); + } return $table_comment } sub _column_comment { - my ( $self, $table, $column_number ) = @_; - my ($table_oid) = $self->schema->storage->dbh->selectrow_array( - q{SELECT oid - FROM pg_class - WHERE relname=? AND relnamespace=( - SELECT oid FROM pg_namespace WHERE nspname=?) - }, undef, $table, $self->db_schema - ); - return $self->schema->storage->dbh->selectrow_array('SELECT col_description(?,?)', undef, $table_oid, - $column_number ); + my ( $self, $table, $column_number, $column_name ) = @_; + my ($column_comment) = $self->next::method( + $table, $column_number, $column_name); + if (not $column_comment) { + my ($table_oid) = $self->schema->storage->dbh->selectrow_array( + q{SELECT oid + FROM pg_class + WHERE relname=? AND relnamespace=( + SELECT oid FROM pg_namespace WHERE nspname=?) + }, undef, $table, $self->db_schema + ); + $column_comment = $self->schema->storage->dbh->selectrow_array( + 'SELECT col_description(?,?)', undef, $table_oid, $column_number ); + } + return $column_comment; } # Make sure data_type's that don't need it don't have a 'size' column_info, and diff --git a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm index cb83e7a..ee886ae 100644 --- a/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm +++ b/lib/DBIx/Class/Schema/Loader/DBI/mysql.pm @@ -241,6 +241,45 @@ sub _dbh_column_info { $self->next::method(@_); } +sub _table_comment { + my ( $self, $table ) = @_; + my $comment = $self->next::method($table); + if (not $comment) { + ($comment) = $self->schema->storage->dbh->selectrow_array( + qq{SELECT table_comment + FROM information_schema.tables + WHERE table_schema = schema() + AND table_name = ? + }, undef, $table); + # InnoDB likes to auto-append crap. + if (not $comment) { + # Do nothing. + } + elsif ($comment =~ /^InnoDB free:/) { + $comment = undef; + } + else { + $comment =~ s/; InnoDB.*//; + } + } + return $comment || "Gotcha $table?"; +} + +sub _column_comment { + my ( $self, $table, $column_number, $column_name ) = @_; + my $comment = $self->next::method($table, $column_number, $column_name); + if (not $comment) { + ($comment) = $self->schema->storage->dbh->selectrow_array( + qq{SELECT column_comment + FROM information_schema.columns + WHERE table_schema = schema() + AND table_name = ? + AND column_name = ? + }, undef, $table, $column_name); + } + return $comment; +} + =head1 SEE ALSO L, L, diff --git a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm index 4dee45e..7d533b4 100644 --- a/lib/DBIx/Class/Schema/Loader/RelBuilder.pm +++ b/lib/DBIx/Class/Schema/Loader/RelBuilder.pm @@ -139,8 +139,8 @@ sub new { # validate the relationship_attrs arg if( defined $self->relationship_attrs ) { - ref $self->relationship_attrs eq 'HASH' - or croak "relationship_attrs must be a hashref"; + ref $self->relationship_attrs eq 'HASH' + or croak "relationship_attrs must be a hashref"; } return $self; @@ -252,9 +252,9 @@ sub _relationship_attrs { ); if( my $specific = $r->{$reltype} ) { - while( my ($k,$v) = each %$specific ) { - $composite{$k} = $v; - } + while( my ($k,$v) = each %$specific ) { + $composite{$k} = $v; + } } return \%composite; } diff --git a/t/10_02mysql_common.t b/t/10_02mysql_common.t index 1d3e5dc..bf6eb4a 100644 --- a/t/10_02mysql_common.t +++ b/t/10_02mysql_common.t @@ -1,7 +1,10 @@ use strict; +use File::Slurp qw(slurp); use Test::More; use lib qw(t/lib); use dbixcsl_common_tests; +use utf8; +use Encode 'decode'; my $dsn = $ENV{DBICTEST_MYSQL_DSN} || ''; my $user = $ENV{DBICTEST_MYSQL_USER} || ''; @@ -143,9 +146,9 @@ my $tester = dbixcsl_common_tests->new( create => [ qq{ CREATE TABLE `mysql_loader-test1` ( - id INT AUTO_INCREMENT PRIMARY KEY, + id INT AUTO_INCREMENT PRIMARY KEY COMMENT 'The\15\12Column', value varchar(100) - ) $innodb + ) $innodb COMMENT 'The\15\12Table' }, q{ CREATE VIEW mysql_loader_test2 AS SELECT * FROM `mysql_loader-test1` @@ -170,7 +173,7 @@ my $tester = dbixcsl_common_tests->new( ], pre_drop_ddl => [ 'DROP VIEW mysql_loader_test2', ], drop => [ 'mysql_loader-test1', 'mysql_loader_test3' ], - count => 3, + count => 5, run => sub { my ($schema, $monikers, $classes) = @_; @@ -186,12 +189,24 @@ my $tester = dbixcsl_common_tests->new( is_deeply $rsrc->column_info('del_group')->{extra}{list}, ['19,90 (<500)/0 EUR','4,90 (<120)/0 EUR','7,90 (<200)/0 CHF','300 (<6000)/0 CZK','4,90 (<100)/0 EUR','39 (<900)/0 DKK','299 (<5000)/0 EEK','9,90 (<250)/0 EUR','3,90 (<100)/0 GBP','3000 (<70000)/0 HUF','4000 (<70000)/0 JPY','13,90 (<200)/0 LVL','99 (<2500)/0 NOK','39 (<1000)/0 PLN','1000 (<20000)/0 RUB','49 (<2500)/0 SEK','29 (<600)/0 USD','19,90 (<600)/0 EUR','0 EUR','0 CHF'], 'hairy enum introspected correctly'; + + my $class = $classes->{'mysql_loader-test1'}; + my $filename = $schema->_loader->get_dump_filename($class); + + my $code = decode('UTF-8', scalar slurp $filename); + + like $code, qr/^=head1 NAME\n\n^$class - The\nTable\n\n^=cut\n/m, + 'table comment'; + + like $code, qr/^=head2 id\n\n(.+:.+\n)+\nThe\nColumn\n\n/m, + 'column comment and attrs'; + }, }, ); if( !$dsn || !$user ) { - $tester->skip_tests('You need to set the DBICTEST_MYSQL_DSN, _USER, and _PASS environment variables'); + $tester->skip_tests('You need to set the DBICTEST_MYSQL_DSN, DBICTEST_MYSQL_USER, and DBICTEST_MYSQL_PASS environment variables'); } else { diag $skip_rels_msg if not $test_innodb; diff --git a/t/30_01comments.t b/t/30_01comments.t new file mode 100644 index 0000000..c159f1c --- /dev/null +++ b/t/30_01comments.t @@ -0,0 +1,37 @@ +use strict; +use Test::More; +use Test::Exception; +use Test::Warn; +use lib qw(t/lib); +use File::Slurp qw(slurp); +use File::Path; +use make_dbictest_db_comments; +use dbixcsl_test_dir qw/$tdir/; + +my $dump_path = "$tdir/dump"; + +{ + package DBICTest::Schema::1; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->loader_options( + dump_directory => $dump_path, + ); +} + +DBICTest::Schema::1->connect($make_dbictest_db_comments::dsn); + +plan tests => 4; + +my $foo = slurp("$dump_path/DBICTest/Schema/1/Result/Foo.pm"); +my $bar = slurp("$dump_path/DBICTest/Schema/1/Result/Bar.pm"); + +like($foo, qr/Result::Foo - a short comment/, 'Short table comment inline'); +like($bar, qr/Result::Bar\n\n=head1 DESCRIPTION\n\na (very ){80}long comment/, + 'Long table comment in DESCRIPTION'); + +like($foo, qr/=head2 fooid\n\n( .*\n)+\na short comment/, + 'Short column comment recorded'); +like($foo, qr/=head2 footext\n\n( .*\n)+\na (very ){80}long comment/, + 'Long column comment recorded'); + +END { rmtree($dump_path, 1, 1); } diff --git a/t/30_02bad_comment_table.t b/t/30_02bad_comment_table.t new file mode 100644 index 0000000..da90e5c --- /dev/null +++ b/t/30_02bad_comment_table.t @@ -0,0 +1,30 @@ +use strict; +use Test::More; +use Test::Exception; +use Test::Warn; +use lib qw(t/lib); +use File::Slurp qw(slurp); +use File::Path; +use make_dbictest_db_bad_comment_tables; +use dbixcsl_test_dir qw/$tdir/; + +my $dump_path = "$tdir/dump"; + +{ + package DBICTest::Schema::1; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->loader_options( + dump_directory => $dump_path, + ); +} + +DBICTest::Schema::1->connect($make_dbictest_db_bad_comment_tables::dsn); + +plan tests => 1; + +my $foo = slurp("$dump_path/DBICTest/Schema/1/Result/Foo.pm"); +my $bar = slurp("$dump_path/DBICTest/Schema/1/Result/Bar.pm"); + +like($foo, qr/Result::Foo\n/, 'No error from no comment table'); + +END { rmtree($dump_path, 1, 1); } diff --git a/t/30_03no_comment_table.t b/t/30_03no_comment_table.t new file mode 100644 index 0000000..8ef3473 --- /dev/null +++ b/t/30_03no_comment_table.t @@ -0,0 +1,30 @@ +use strict; +use Test::More; +use Test::Exception; +use Test::Warn; +use lib qw(t/lib); +use File::Slurp qw(slurp); +use File::Path; +use make_dbictest_db; +use dbixcsl_test_dir qw/$tdir/; + +my $dump_path = "$tdir/dump"; + +{ + package DBICTest::Schema::1; + use base qw/ DBIx::Class::Schema::Loader /; + __PACKAGE__->loader_options( + dump_directory => $dump_path, + ); +} + +DBICTest::Schema::1->connect($make_dbictest_db::dsn); + +plan tests => 1; + +my $foo = slurp("$dump_path/DBICTest/Schema/1/Result/Foo.pm"); +my $bar = slurp("$dump_path/DBICTest/Schema/1/Result/Bar.pm"); + +like($foo, qr/Result::Foo\n/, 'No error from no comments'); + +END { rmtree($dump_path, 1, 1); } diff --git a/t/lib/make_dbictest_db_bad_comment_tables.pm b/t/lib/make_dbictest_db_bad_comment_tables.pm new file mode 100644 index 0000000..7e5cfb3 --- /dev/null +++ b/t/lib/make_dbictest_db_bad_comment_tables.pm @@ -0,0 +1,46 @@ +package make_dbictest_db_bad_comment_tables; + +use strict; +use warnings; +use DBI; +use dbixcsl_test_dir qw/$tdir/; + +eval { require DBD::SQLite }; +my $class = $@ ? 'SQLite2' : 'SQLite'; + +my $fn = "$tdir/dbictest.db"; + +unlink($fn); +our $dsn = "dbi:$class:dbname=$fn"; +my $dbh = DBI->connect($dsn); +$dbh->do('PRAGMA SYNCHRONOUS = OFF'); + +$dbh->do($_) for ( + q|CREATE TABLE table_comments( + id INTEGER PRIMARY KEY + )|, + q|CREATE TABLE column_comments( + id INTEGER PRIMARY KEY + )|, + q|CREATE TABLE foo ( + fooid INTEGER PRIMARY KEY, + 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 (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)|, + q|INSERT INTO bar VALUES (4,1)|, +); + +END { unlink($fn); } + +1 diff --git a/t/lib/make_dbictest_db_comments.pm b/t/lib/make_dbictest_db_comments.pm new file mode 100644 index 0000000..375bcb8 --- /dev/null +++ b/t/lib/make_dbictest_db_comments.pm @@ -0,0 +1,63 @@ +package make_dbictest_db_comments; + +use strict; +use warnings; +use DBI; +use dbixcsl_test_dir qw/$tdir/; + +eval { require DBD::SQLite }; +my $class = $@ ? 'SQLite2' : 'SQLite'; + +my $fn = "$tdir/dbictest.db"; + +unlink($fn); +our $dsn = "dbi:$class:dbname=$fn"; +my $dbh = DBI->connect($dsn); +$dbh->do('PRAGMA SYNCHRONOUS = OFF'); + +$dbh->do($_) for ( + q|CREATE TABLE table_comments ( + id INTEGER PRIMARY KEY, + table_name TEXT, + comment_text TEXT + )|, + q|CREATE TABLE column_comments ( + id INTEGER PRIMARY KEY, + table_name TEXT, + column_name TEXT, + comment_text TEXT + )|, + q|CREATE TABLE foo ( + fooid INTEGER PRIMARY KEY, + 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 table_comments (id, table_name, comment_text) + VALUES (1, 'foo', 'a short comment') + |, + q|INSERT INTO table_comments (id, table_name, comment_text) + VALUES (2, 'bar', 'a | . ('very ' x 80) . q|long comment') + |, + q|INSERT INTO column_comments (id, table_name, column_name, comment_text) + VALUES (1, 'foo', 'fooid', 'a short comment') + |, + q|INSERT INTO column_comments (id, table_name, column_name, comment_text) + VALUES (2, 'foo', 'footext', 'a | . ('very ' x 80) . q|long comment') + |, + 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)|, + q|INSERT INTO bar VALUES (4,1)|, +); + +END { unlink($fn); } + +1