X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FLoader%2FBase.pm;h=fbfc4d390730535a0cf1cac88cd187614fb4cf3a;hb=a8acb698c8b9d11794d863aa2fc9b8885f4282de;hp=006aaad5eedd900011cc4596160afaa6d9cde738;hpb=9c703ffb5c4fb7eb918a6e3463b1f07472c6dca2;p=dbsrgits%2FDBIx-Class-Schema-Loader.git

diff --git a/lib/DBIx/Class/Schema/Loader/Base.pm b/lib/DBIx/Class/Schema/Loader/Base.pm
index 006aaad..fbfc4d3 100644
--- a/lib/DBIx/Class/Schema/Loader/Base.pm
+++ b/lib/DBIx/Class/Schema/Loader/Base.pm
@@ -64,7 +64,6 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 monikers
                                 dynamic
                                 naming
-                                naming_set
                                 datetime_timezone
                                 datetime_locale
                                 config_file
@@ -93,6 +92,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 result_roles_map
                                 datetime_undef_if_invalid
                                 _result_class_methods
+                                naming_set
 /);
 
 =head1 NAME
@@ -765,7 +765,7 @@ sub _check_back_compat {
 # just in case, though no one is likely to dump a dynamic schema
         $self->schema_version_to_dump('0.04006');
 
-        if (not %{ $self->naming }) {
+        if (not $self->naming_set) {
             warn <<EOF unless $ENV{SCHEMA_LOADER_BACKCOMPAT};
 
 Dynamic schema detected, will run in 0.04006 mode.
@@ -781,7 +781,7 @@ EOF
             $self->_upgrading_from('v4');
         }
 
-        if ((not defined $self->use_namespaces) && (not $self->naming_set)) {
+        if ((not defined $self->use_namespaces) && ($self->naming_set)) {
             $self->use_namespaces(1);
         }
 
@@ -1187,6 +1187,8 @@ sub _load_tables {
         @INC = grep $_ ne $self->dump_directory, @INC;
     }
 
+    $self->_load_roles($_) for @tables;
+
     $self->_load_external($_)
         for map { $self->classes->{$_} } @tables;
 
@@ -1393,6 +1395,10 @@ sub _dump_to_dir {
         else {
              $src_text .= qq|use base '$result_base_class';\n\n|;
         }
+
+        $self->_base_class_pod($src_class, $result_base_class)
+            unless $result_base_class eq 'DBIx::Class::Core';
+
         $self->_write_classfile($src_class, $src_text);
     }
 
@@ -1683,7 +1689,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 || [] };
@@ -1691,15 +1702,20 @@ sub _make_src_class {
     push @components, @{ $self->result_components_map->{$table_moniker} }
         if exists $self->result_components_map->{$table_moniker};
 
-    $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
+    my @fq_components = @components;
+    foreach my $component (@fq_components) {
+        if ($component !~ s/^\+//) {
+            $component = "DBIx::Class::$component";
+        }
+    }
 
-    $self->_inject($table_class, @{$self->additional_base_classes});
+    $self->_pod_class_list($table_class, 'COMPONENTS LOADED', @fq_components);
 
-    my @roles = @{ $self->result_roles || [] };
-    push @roles, @{ $self->result_roles_map->{$table_moniker} }
-        if exists $self->result_roles_map->{$table_moniker};
+    $self->_dbic_stmt($table_class, 'load_components', @components) if @components;
 
-    $self->_with($table_class, @roles) if @roles;
+    $self->_pod_class_list($table_class, 'ADDITIONAL BASE CLASSES', @{$self->additional_base_classes});
+
+    $self->_inject($table_class, @{$self->additional_base_classes});
 }
 
 sub _is_result_class_method {
@@ -1833,7 +1849,7 @@ sub _setup_src_meta {
     my $schema       = $self->schema;
     my $schema_class = $self->schema_class;
 
-    my $table_class = $self->classes->{$table};
+    my $table_class   = $self->classes->{$table};
     my $table_moniker = $self->monikers->{$table};
 
     my $table_name = $table;
@@ -1998,6 +2014,23 @@ sub _load_relationships {
     }
 }
 
+sub _load_roles {
+    my ($self, $table) = @_;
+
+    my $table_moniker = $self->monikers->{$table};
+    my $table_class   = $self->classes->{$table};
+
+    my @roles = @{ $self->result_roles || [] };
+    push @roles, @{ $self->result_roles_map->{$table_moniker} }
+        if exists $self->result_roles_map->{$table_moniker};
+
+    if (@roles) {
+        $self->_pod_class_list($table_class, 'L<Moose> ROLES APPLIED', @roles);
+
+        $self->_with($table_class, @roles);
+    }
+}
+
 # Overload these in driver class:
 
 # Returns an arrayref of column names
@@ -2095,6 +2128,31 @@ 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 _base_class_pod {
+    my ($self, $class, $base_class) = @_;
+
+    return unless $self->generate_pod;
+
+    $self->_pod($class, "=head1 BASE CLASS: L<$base_class>");
+    $self->_pod_cut($class);
+}
+
 sub _filter_comment {
     my ($self, $txt) = @_;