From: Rafael Kitover <rkitover@cpan.org>
Date: Tue, 17 May 2011 20:34:38 +0000 (-0400)
Subject: generate POD for additional_classes, additional_base_classes, left_base_classes,... 
X-Git-Tag: 0.07011~113
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=06e06245678990c8195ebadc5d8f2cf82754325d;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

generate POD for additional_classes, additional_base_classes, left_base_classes, components, result_components_map, result_roles and result_roles_map
---

diff --git a/Changes b/Changes
index 25ab433..228d759 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Perl extension DBIx::Class::Schema::Loader
 
+        - generate POD for additional_classes, additional_base_classes,
+          left_base_classes, components, result_components_map,
+          result_roles and result_roles_map
         - rename result_component_map to result_components_map (old name still
           works)
         - fix accessor collision detection for methods from
diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index f425f4a..18dc57c 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -1685,7 +1685,12 @@ sub _make_src_class {
     $self->classes->{$table}  = $table_class;
     $self->monikers->{$table} = $table_moniker;
 
+    $self->_pod_class_list($table_class, 'ADDITIONAL CLASSES USED', @{$self->additional_classes});
+
     $self->_use   ($table_class, @{$self->additional_classes});
+
+    $self->_pod_class_list($table_class, 'LEFT BASE CLASSES', @{$self->left_base_classes});
+
     $self->_inject($table_class, @{$self->left_base_classes});
 
     my @components = @{ $self->components || [] };
@@ -1693,8 +1698,19 @@ sub _make_src_class {
     push @components, @{ $self->result_components_map->{$table_moniker} }
         if exists $self->result_components_map->{$table_moniker};
 
+    my @fq_components = @components;
+    foreach my $component (@fq_components) {
+        if ($component !~ s/^\+//) {
+            $component = "DBIx::Class::$component";
+        }
+    }
+
+    $self->_pod_class_list($table_class, 'COMPONENTS LOADED', @fq_components);
+
     $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
 
+    $self->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes});
+
     $self->_inject($table_class, @{$self->additional_base_classes});
 }
 
@@ -2004,7 +2020,11 @@ sub _load_roles {
     push @roles, @{ $self->result_roles_map->{$table_moniker} }
         if exists $self->result_roles_map->{$table_moniker};
 
-    $self->_with($table_class, @roles) if @roles;
+    if (@roles) {
+        $self->_pod_class_list($table_class, 'L<Moose> ROLES APPLIED', @roles);
+
+        $self->_with($table_class, @roles);
+    }
 }
 
 # Overload these in driver class:
@@ -2104,6 +2124,22 @@ sub _make_pod {
     }
 }
 
+sub _pod_class_list {
+    my ($self, $class, $title, @classes) = @_;
+
+    return unless @classes && $self->generate_pod;
+
+    $self->_pod($class, "=head1 $title");
+    $self->_pod($class, '=over 4');
+
+    foreach my $link (@classes) {
+        $self->_pod($class, "=item L<$link>");
+    }
+
+    $self->_pod($class, '=back');
+    $self->_pod_cut($class);
+}
+
 sub _filter_comment {
     my ($self, $txt) = @_;
 
diff --git a/t/23dumpmore.t b/t/23dumpmore.t
index 36806cc..8da4e1d 100644
--- a/t/23dumpmore.t
+++ b/t/23dumpmore.t
@@ -81,7 +81,11 @@ $t->dump_test(
     custom_column_info => sub {
       my ($table, $col, $info) = @_;
       return +{ extra => { is_footext => 1 } } if $col eq 'footext';
-    }
+    },
+    additional_classes => 'TestAdditional',
+    additional_base_classes => 'TestAdditionalBase',
+    left_base_classes => 'TestLeftBase',
+    components => [ 'TestComponent', '+TestComponentFQN' ],
   },
   warnings => [
     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
@@ -94,25 +98,33 @@ $t->dump_test(
     ],
     Foo => [
       qr/package DBICTest::DumpMore::1::Foo;/,
-      qr/=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
-      qr/=head1 ACCESSORS\n\n/,
-      qr/=head2 fooid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
-      qr/=head2 footext\n\n  data_type: 'text'\n  default_value: 'footext'\n  extra: {is_footext => 1}\n  is_nullable: 1\n\n/,
+      qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Foo\n\n=cut\n\n/,
+      qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item L<TestAdditional>\n\n=back\n\n=cut\n\n/,
+      qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
+      qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
+      qr/\n=head1 COMPONENTS LOADED\n\n=over 4\n\n=item L<DBIx::Class::TestComponent>\n\n=item L<TestComponentFQN>\n\n=back\n\n=cut\n\n/,
+      qr/\n=head1 ACCESSORS\n\n/,
+      qr/\n=head2 fooid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
+      qr/\n=head2 footext\n\n  data_type: 'text'\n  default_value: 'footext'\n  extra: {is_footext => 1}\n  is_nullable: 1\n\n/,
       qr/->set_primary_key/,
-      qr/=head1 RELATIONS\n\n/,
-      qr/=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
+      qr/\n=head1 RELATIONS\n\n/,
+      qr/\n=head2 bars\n\nType: has_many\n\nRelated object: L<DBICTest::DumpMore::1::Bar>\n\n=cut\n\n/,
       qr/1;\n$/,
     ],
     Bar => [
       qr/package DBICTest::DumpMore::1::Bar;/,
-      qr/=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
-      qr/=head1 ACCESSORS\n\n/,
-      qr/=head2 barid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
-      qr/=head2 fooref\n\n  data_type: 'integer'\n  is_foreign_key: 1\n  is_nullable: 1\n\n/,
+      qr/\n=head1 NAME\n\nDBICTest::DumpMore::1::Bar\n\n=cut\n\n/,
+      qr/\n=head1 ADDITIONAL CLASSES USED\n\n=over 4\n\n=item L<TestAdditional>\n\n=back\n\n=cut\n\n/,
+      qr/\n=head1 ADDITIONAL BASE CLASSES\n\n=over 4\n\n=item L<TestAdditionalBase>\n\n=back\n\n=cut\n\n/,
+      qr/\n=head1 LEFT BASE CLASSES\n\n=over 4\n\n=item L<TestLeftBase>\n\n=back\n\n=cut\n\n/,
+      qr/\n=head1 COMPONENTS LOADED\n\n=over 4\n\n=item L<DBIx::Class::TestComponent>\n\n=item L<TestComponentFQN>\n\n=back\n\n=cut\n\n/,
+      qr/\n=head1 ACCESSORS\n\n/,
+      qr/\n=head2 barid\n\n  data_type: 'integer'\n  is_auto_increment: 1\n  is_nullable: 0\n\n/,
+      qr/\n=head2 fooref\n\n  data_type: 'integer'\n  is_foreign_key: 1\n  is_nullable: 1\n\n/,
       qr/->set_primary_key/,
-      qr/=head1 RELATIONS\n\n/,
-      qr/=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
-      qr/1;\n$/,
+      qr/\n=head1 RELATIONS\n\n/,
+      qr/\n=head2 fooref\n\nType: belongs_to\n\nRelated object: L<DBICTest::DumpMore::1::Foo>\n\n=cut\n\n/,
+      qr/\n1;\n$/,
     ],
   },
 );
diff --git a/t/26dump_use_moose.t b/t/26dump_use_moose.t
index d24001d..5f8f40c 100644
--- a/t/26dump_use_moose.t
+++ b/t/26dump_use_moose.t
@@ -22,6 +22,7 @@ $t->dump_test(
     use_moose => 1,
     result_base_class => 'My::ResultBaseClass',
     schema_base_class => 'My::SchemaBaseClass',
+    result_roles => ['TestRole', 'TestRole2'],
   },
   warnings => [
     qr/Dumping manual schema for DBICTest::DumpMore::1 to directory /,
@@ -34,10 +35,14 @@ $t->dump_test(
     ],
     Foo => [
       qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
+      qr/=head1 L<Moose> ROLES APPLIED\n\n=over 4\n\n=item L<TestRole>\n\n=item L<TestRole2>\n\n=back\n\n=cut\n\n/,
+      qr/\nwith 'TestRole', 'TestRole2';\n\n/,
       qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
     ],
     Bar => [
       qr/\nuse Moose;\nuse MooseX::NonMoose;\nuse namespace::autoclean;\nextends 'My::ResultBaseClass';\n\n/,
+      qr/=head1 L<Moose> ROLES APPLIED\n\n=over 4\n\n=item L<TestRole>\n\n=item L<TestRole2>\n\n=back\n\n=cut\n\n/,
+      qr/\nwith 'TestRole', 'TestRole2';\n\n/,
       qr/\n__PACKAGE__->meta->make_immutable;\n1;(?!\n1;\n)\n.*/,
     ],
   },
diff --git a/t/lib/TestRole2.pm b/t/lib/TestRole2.pm
new file mode 100644
index 0000000..ccc1df9
--- /dev/null
+++ b/t/lib/TestRole2.pm
@@ -0,0 +1,7 @@
+package TestRole2;
+
+use Moose::Role;
+
+sub test_role2_method { 'test_role2_method works' }
+
+1;