[Bast-commits] r8396 - in
branches/DBIx-Class-Schema-Loader/current: .
lib/DBIx/Class/Schema lib/DBIx/Class/Schema/Loader
lib/DBIx/Class/Schema/Loader/DBI
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Thu Jan 21 14:32:43 GMT 2010
Author: caelum
Date: 2010-01-21 14:32:43 +0000 (Thu, 21 Jan 2010)
New Revision: 8396
Modified:
branches/DBIx-Class-Schema-Loader/current/Changes
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm
branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
Log:
add patch from waawaamilk to generate POD for long table comments in DESCRIPTION instead of NAME, still needs tests
Modified: branches/DBIx-Class-Schema-Loader/current/Changes
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/Changes 2010-01-21 05:48:14 UTC (rev 8395)
+++ branches/DBIx-Class-Schema-Loader/current/Changes 2010-01-21 14:32:43 UTC (rev 8396)
@@ -1,6 +1,8 @@
Revision history for Perl extension DBIx::Class::Schema::Loader
- added 'generate_pod' option, defaults to on
+ - added 'pod_comment_mode' and 'pod_comment_spillover_length' to
+ control table comment generation (waawaamilk)
0.04999_14 2010-01-14 06:47:07
- use_namespaces now default, with upgrade/downgrade support
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-21 05:48:14 UTC (rev 8395)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/Base.pm 2010-01-21 14:32:43 UTC (rev 8396)
@@ -66,6 +66,8 @@
use_namespaces
result_namespace
generate_pod
+ pod_comment_mode
+ pod_comment_spillover_length
/);
=head1 NAME
@@ -169,6 +171,25 @@
Set this to C<0> to turn off all POD generation.
+=head2 pod_comment_mode
+
+Controls where table comments appear in the generated POD. By default table
+comments are appended to the C<NAME> section of the documentation. You can
+force a C<DESCRIPTION> section to be generated with the comment instead, or
+choose the length threshold at which the comment is forced into the
+description.
+
+ pod_comment_mode => 'name' # default behaviour
+ pod_comment_mode => 'description' # force creation of DESCRIPTION section
+ pod_comment_mode => 'auto' # use description if length > pod_comment_spillover_length
+
+=head2 pod_comment_spillover_length
+
+When pod_comment_mode is set to C<auto>, this is the length of the comment at
+which it will be forced into a separate description section.
+
+The default is C<60>
+
=head2 relationship_attrs
Hashref of attributes to pass to each generated relationship, listed
@@ -431,6 +452,8 @@
$self->use_namespaces(1) unless defined $self->use_namespaces;
$self->generate_pod(1) unless defined $self->generate_pod;
+ $self->pod_comment_mode('auto') unless defined $self->pod_comment_mode;
+ $self->pod_comment_spillover_length(60) unless defined $self->pod_comment_spillover_length;
$self;
}
@@ -1373,7 +1396,7 @@
my $method = shift;
# generate the pod for this statement, storing it with $self->_pod
- $self->_make_pod( $class, $method, @_ );
+ $self->_make_pod( $class, $method, @_ ) if $self->generate_pod;
my $args = dump(@_);
$args = '(' . $args . ')' if @_ < 2;
@@ -1391,18 +1414,25 @@
my $class = shift;
my $method = shift;
- return unless $self->generate_pod;
-
if ( $method eq 'table' ) {
my ($table) = @_;
+ my $pcm = $self->pod_comment_mode;
+ my ($comment, $comment_overflows, $comment_in_name, $comment_in_desc);
+ if ( $self->can('_table_comment') ) {
+ $comment = $self->_table_comment($table);
+ $comment_overflows = ($comment and length $comment > $self->pod_comment_spillover_length);
+ $comment_in_name = ($pcm eq 'name' or ($pcm eq 'auto' and !$comment_overflows));
+ $comment_in_desc = ($pcm eq 'description' or ($pcm eq 'auto' and $comment_overflows));
+ }
$self->_pod( $class, "=head1 NAME" );
my $table_descr = $class;
- if ( $self->can('_table_comment') ) {
- my $comment = $self->_table_comment($table);
- $table_descr .= " - " . $comment if $comment;
- }
+ $table_descr .= " - " . $comment if $comment and $comment_in_name;
$self->{_class2table}{ $class } = $table;
$self->_pod( $class, $table_descr );
+ if ($comment and $comment_in_desc) {
+ $self->_pod( $class, "=head1 DESCRIPTION" );
+ $self->_pod( $class, $comment );
+ }
$self->_pod_cut( $class );
} elsif ( $method eq 'add_columns' ) {
$self->_pod( $class, "=head1 ACCESSORS" );
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm 2010-01-21 05:48:14 UTC (rev 8395)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader/DBI/Pg.pm 2010-01-21 14:32:43 UTC (rev 8396)
@@ -139,7 +139,7 @@
delete $result->{$col}{size};
}
# for datetime types, check if it has a precision or not
- elsif ($data_type =~ /^(?:interval|time|timestamp)\b/) {
+ elsif ($data_type =~ /^(?:interval|time|timestamp)\b/i) {
my ($precision) = $self->schema->storage->dbh
->selectrow_array(<<EOF, {}, $table, $col);
SELECT datetime_precision
Modified: branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader.pm
===================================================================
--- branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader.pm 2010-01-21 05:48:14 UTC (rev 8395)
+++ branches/DBIx-Class-Schema-Loader/current/lib/DBIx/Class/Schema/Loader.pm 2010-01-21 14:32:43 UTC (rev 8396)
@@ -488,6 +488,8 @@
kane: Jos Boumans <kane at cpan.org>
+waawaamilk: Nigel McNie <nigel at mcnie.name>
+
... and lots of other folks. If we forgot you, please write the current
maintainer or RT.
More information about the Bast-commits
mailing list