From: Robert Buels <rmb32@cornell.edu>
Date: Fri, 1 Jan 2010 21:54:22 +0000 (+0000)
Subject: added column attributes to generated POD
X-Git-Tag: 0.04999_13~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=79a005304a4f31bced785134fd3559042504f692;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

added column attributes to generated POD
---

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 721816c..e572331 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -1241,14 +1241,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)$/ ) {
diff --git a/t/12pg_common.t b/t/12pg_common.t
index 963ba0d..dd4412a 100644
--- a/t/12pg_common.t
+++ b/t/12pg_common.t
@@ -44,8 +44,8 @@ my $tester = dbixcsl_common_tests->new(
             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';
         },
     },
 );