From: Rafael Kitover <rkitover@cpan.org>
Date: Fri, 21 Oct 2011 16:59:17 +0000 (-0400)
Subject: update comment table support for multi-db_schema
X-Git-Tag: 0.07011~24
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class-Schema-Loader.git;a=commitdiff_plain;h=b21abfcafc1430332b93a75843905c895a64bb78

update comment table support for multi-db_schema

Update the POD related to the table_comments and column_comments tables
to note that these tables must be in the same database and schema as the
tables they are describing.

Add a clone method to ::DBObject and use it to find the comment tables,
changing just the table name to table_comments_table or
column_comments_table.
---

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 7c249f8..75165bf 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -295,10 +295,11 @@ metadata for the text if available and supported.
 Comment metadata can be stored in two ways.
 
 The first is that you can create two tables named C<table_comments> and
-C<column_comments> respectively.  They both need to have columns named
-C<table_name> and C<comment_text>.  The second one needs to have a column
-named C<column_name>.  Then data stored in these tables will be used as a
-source of metadata about tables and comments.
+C<column_comments> respectively. These tables must exist in the same database
+and schema as the tables they describe. They both need to have columns named
+C<table_name> and C<comment_text>. The second one needs to have a column named
+C<column_name>. 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</table_comments_table> and L</column_comments_table>.)
@@ -350,11 +351,17 @@ The default is C<60>
 The table to look for comments about tables in.  By default C<table_comments>.
 See L</generate_pod> for details.
 
+This must not be a fully qualified name, the table will be looked for in the
+same database and schema as the table whose comment is being retrieved.
+
 =head2 column_comments_table
 
 The table to look for comments about columns in.  By default C<column_comments>.
 See L</generate_pod> for details.
 
+This must not be a fully qualified name, the table will be looked for in the
+same database and schema as the table/column whose comment is being retrieved.
+
 =head2 relationship_attrs
 
 Hashref of attributes to pass to each generated relationship, listed
diff --git a/lib/DBIx/Class/Schema/Loader/DBI.pm b/lib/DBIx/Class/Schema/Loader/DBI.pm
index c0042cf..e584e6d 100644
--- a/lib/DBIx/Class/Schema/Loader/DBI.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBI.pm
@@ -324,11 +324,12 @@ sub _table_uniq_info {
 sub _table_comment {
     my ($self, $table) = @_;
 
-    my $comments_table = $self->table_comments_table;
+    my $comments_table = $table->clone;
+    $comments_table->name($self->table_comments_table);
 
     my ($comment) = try { $self->dbh->selectrow_array(<<"EOF") };
 SELECT comment_text
-FROM $comments_table
+FROM @{[ $comments_table->sql_name ]}
 WHERE table_name = @{[ $self->dbh->quote($table->name) ]}
 EOF
 
@@ -336,13 +337,14 @@ EOF
 }
 
 sub _column_comment {
-    my ($self, $table, $column_counter, $column_name) = @_;
+    my ($self, $table, $column_number, $column_name) = @_;
 
-    my $comments_table = $self->column_comments_table;
+    my $comments_table = $table->clone;
+    $comments_table->name($self->column_comments_table);
 
     my ($comment) = try { $self->dbh->selectrow_array(<<"EOF") };
 SELECT comment_text
-FROM $comments_table
+FROM @{[ $comments_table->sql_name ]}
 WHERE table_name = @{[ $self->dbh->quote($table->name) ]}
 AND column_name = @{[ $self->dbh->quote($column_name) ]}
 EOF
diff --git a/lib/DBIx/Class/Schema/Loader/DBObject.pm b/lib/DBIx/Class/Schema/Loader/DBObject.pm
index e0ec405..7a7b53c 100644
--- a/lib/DBIx/Class/Schema/Loader/DBObject.pm
+++ b/lib/DBIx/Class/Schema/Loader/DBObject.pm
@@ -56,6 +56,18 @@ sub new {
     return bless $self, $class;
 }
 
+=head2 clone
+
+Make a shallow copy of the object.
+
+=cut
+
+sub clone {
+    my $self = shift;
+
+    return bless { %$self }, ref $self;
+}
+
 =head2 schema
 
 The schema (or owner) of the object. Returns nothing if L</ignore_schema> is