add test (and fix) for loading external custom content from unsingularized results...

[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 721816c..39bb01d 100644 (file)
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -578,9 +578,10 @@ sub _load_external {
             or croak "Failed to open '$old_real_inc_path' for reading: $!";
         $self->_ext_stmt($class, <<"EOF");
 
-# These lines were loaded from '$old_real_inc_path', based on the Result class
-# name that would have been created by an 0.04006 version of the Loader. For a
-# static schema, this happens only once during upgrade.
+# These lines were loaded from '$old_real_inc_path',
+# based on the Result class name that would have been created by an 0.04006
+# version of the Loader. For a static schema, this happens only once during
+# upgrade.
 EOF
         if ($self->dynamic) {
             warn <<"EOF";
@@ -607,6 +608,7 @@ EOF
 
         while(<$fh>) {
             chomp;
+            s/$old_class/$class/g;
             $self->_ext_stmt($class, $_);
         }
         $self->_ext_stmt($class,
@@ -1225,9 +1227,29 @@ sub _tables_list { croak "ABSTRACT METHOD" }
 
 # Execute a constructive DBIC class method, with debug/dump_to_dir hooks.
 sub _dbic_stmt {
-    my $self = shift;
-    my $class = shift;
+    my $self   = shift;
+    my $class  = shift;
     my $method = shift;
+
+    # generate the pod for this statement, storing it with $self->_pod
+    $self->_make_pod( $class, $method, @_ );
+
+    my $args = dump(@_);
+    $args = '(' . $args . ')' if @_ < 2;
+    my $stmt = $method . $args . q{;};
+
+    warn qq|$class\->$stmt\n| if $self->debug;
+    $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
+    return;
+}
+
+# generates the accompanying pod for a DBIC class method statement,
+# storing it with $self->_pod
+sub _make_pod {
+    my $self   = shift;
+    my $class  = shift;
+    my $method = shift;
+
     if ( $method eq 'table' ) {
         my ($table) = @_;
         $self->_pod( $class, "=head1 NAME" );
@@ -1241,14 +1263,27 @@ sub _dbic_stmt {
         $self->_pod_cut( $class );
     } elsif ( $method eq 'add_columns' ) {
         $self->_pod( $class, "=head1 ACCESSORS" );
-        my $i = 0;
-        foreach ( @_ ) {
-            $i++;
-            next unless $i % 2;
-            $self->_pod( $class, '=head2 ' . $_  );
-            my $comment;
-            $comment = $self->_column_comment( $self->{_class2table}{$class}, ($i - 1) / 2 + 1  ) if $self->can('_column_comment');
-            $self->_pod( $class, $comment ) if $comment;
+        my $col_counter = 0;
+       my @cols = @_;
+        while( my ($name,$attrs) = splice @cols,0,2 ) {
+           $col_counter++;
+            $self->_pod( $class, '=head2 ' . $name  );
+           $self->_pod( $class,
+                        join "\n", map {
+                            my $s = $attrs->{$_};
+                            $s = !defined $s      ? 'undef'          :
+                                 length($s) == 0  ? '(empty string)' :
+                                                     $s;
+
+                            "  $_: $s"
+                        } sort keys %$attrs,
+                      );
+
+           if( $self->can('_column_comment')
+               and my $comment = $self->_column_comment( $self->{_class2table}{$class}, $col_counter)
+             ) {
+               $self->_pod( $class, $comment );
+           }
         }
         $self->_pod_cut( $class );
     } elsif ( $method =~ /^(belongs_to|has_many|might_have)$/ ) {
@@ -1260,13 +1295,6 @@ sub _dbic_stmt {
         $self->_pod_cut( $class );
         $self->{_relations_started} { $class } = 1;
     }
-    my $args = dump(@_);
-    $args = '(' . $args . ')' if @_ < 2;
-    my $stmt = $method . $args . q{;};
-
-    warn qq|$class\->$stmt\n| if $self->debug;
-    $self->_raw_stmt($class, '__PACKAGE__->' . $stmt);
-    return;
 }
 
 # Stores a POD documentation