[Bast-commits] r8217 - in branches/DBIx-Class-Schema-Loader/current: lib/DBIx/Class/Schema/Loader t

[rbuels at dev.catalyst.perl.org]

Author: rbuels
Date: 2010-01-01 21:54:22 +0000 (Fri, 01 Jan 2010)
New Revision: 8217

Modified:
   branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
   branches/DBIx-Class-Schema-Loader/current/t/12pg_common.t
Log:
added column attributes to generated POD

Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2010-01-01 12:42:03 UTC (rev 8216)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm	2010-01-01 21:54:22 UTC (rev 8217)
@@ -1241,14 +1241,27 @@
         $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)$/ ) {

Modified: branches/DBIx-Class-Schema-Loader/current/t/12pg_common.t
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/t/12pg_common.t	2010-01-01 12:42:03 UTC (rev 8216)
+++ branches/DBIx-Class-Schema-Loader/current/t/12pg_common.t	2010-01-01 21:54:22 UTC (rev 8217)
@@ -44,8 +44,8 @@
             like $code, qr/^=head1 NAME\n\n^$class - The Table\n\n^=cut\n/m,
                 'table comment';
 
-            like $code, qr/^=head2 value\n\nThe Column\n\n/m,
-                'column comment';
+            like $code, qr/^=head2 value\n\n(.+:.+\n)+\nThe Column\n\n/m,
+                'column comment and attrs';
         },
     },
 );