add quiet option
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Base.pm
index db415c4..6b27f3e 100644 (file)
@@ -38,6 +38,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 additional_base_classes
                                 left_base_classes
                                 components
+                                schema_components
                                 skip_relationships
                                 skip_load_external
                                 moniker_map
@@ -74,6 +75,7 @@ __PACKAGE__->mk_group_ro_accessors('simple', qw/
                                 tables
                                 class_to_table
                                 uniq_to_primary
+                                quiet
 /);
 
 
@@ -92,6 +94,7 @@ __PACKAGE__->mk_group_accessors('simple', qw/
                                 preserve_case
                                 col_collision_map
                                 rel_collision_map
+                                rel_name_map
                                 real_dump_directory
                                 result_components_map
                                 result_roles_map
@@ -238,6 +241,12 @@ next major version upgrade:
 
     __PACKAGE__->naming('v7');
 
+=head2 quiet
+
+If true, will not print the usual C<Dumping manual schema ... Schema dump
+completed.> messages. Does not affect warnings (except for warnings related to
+L</really_erase_my_files>.)
+
 =head2 generate_pod
 
 By default POD will be generated for columns and relationships, using database
@@ -351,6 +360,43 @@ passed, the code is called with arguments of
       column_info     => hashref of column info (data_type, is_nullable, etc),
     }
 
+=head2 rel_name_map
+
+Similar in idea to moniker_map, but different in the details.  It can be
+a hashref or a code ref.
+
+If it is a hashref, keys can be either the default relationship name, or the
+moniker. The keys that are the default relationship name should map to the
+name you want to change the relationship to. Keys that are monikers should map
+to hashes mapping relationship names to their translation.  You can do both at
+once, and the more specific moniker version will be picked up first.  So, for
+instance, you could have
+
+    {
+        bar => "baz",
+        Foo => {
+            bar => "blat",
+        },
+    }
+
+and relationships that would have been named C<bar> will now be named C<baz>
+except that in the table whose moniker is C<Foo> it will be named C<blat>.
+
+If it is a coderef, the argument passed will be a hashref of this form:
+
+    {
+        name           => default relationship name,
+        type           => the relationship type eg: C<has_many>,
+        local_class    => name of the DBIC class we are building,
+        local_moniker  => moniker of the DBIC class we are building,
+        local_columns  => columns in this table in the relationship,
+        remote_class   => name of the DBIC class we are related to,
+        remote_moniker => moniker of the DBIC class we are related to,
+        remote_columns => columns in the other table in the relationship,
+    }
+
+DBICSL will try to use the value returned as the relationship name.
+
 =head2 inflect_plural
 
 Just like L</moniker_map> above (can be hash/code-ref, falls back to default
@@ -385,9 +431,13 @@ that need to be leftmost.
 
 List of additional classes which all of your table classes will use.
 
+=head2 schema_components
+
+List of components to load into the Schema class.
+
 =head2 components
 
-List of additional components to be loaded into all of your table
+List of additional components to be loaded into all of your Result
 classes.  A good example would be
 L<InflateColumn::DateTime|DBIx::Class::InflateColumn::DateTime>
 
@@ -605,8 +655,9 @@ L<DBIx::Class::Schema::Loader>.
 my $CURRENT_V = 'v7';
 
 my @CLASS_ARGS = qw(
-    schema_base_class result_base_class additional_base_classes
-    left_base_classes additional_classes components result_roles
+    schema_components schema_base_class result_base_class
+    additional_base_classes left_base_classes additional_classes components
+    result_roles
 );
 
 # ensure that a peice of object data is a valid arrayref, creating
@@ -656,17 +707,26 @@ sub new {
         }
     }
 
-    $self->result_components_map($self->{result_component_map})
-        if defined $self->{result_component_map};
-
-    $self->result_roles_map($self->{result_role_map})
-        if defined $self->{result_role_map};
+    if (defined $self->{result_component_map}) {
+        if (defined $self->result_components_map) {
+            croak "Specify only one of result_components_map or result_component_map";
+        }
+        $self->result_components_map($self->{result_component_map})
+    }
+    
+    if (defined $self->{result_role_map}) {
+        if (defined $self->result_roles_map) {
+            croak "Specify only one of result_roles_map or result_role_map";
+        }
+        $self->result_roles_map($self->{result_role_map})
+    }
 
     croak "the result_roles and result_roles_map options may only be used in conjunction with use_moose=1"
         if ((not defined $self->use_moose) || (not $self->use_moose))
             && ((defined $self->result_roles) || (defined $self->result_roles_map));
 
-    $self->_ensure_arrayref(qw/additional_classes
+    $self->_ensure_arrayref(qw/schema_components
+                               additional_classes
                                additional_base_classes
                                left_base_classes
                                components
@@ -784,6 +844,24 @@ sub new {
         }
     }
 
+    if (my $rel_collision_map = $self->rel_collision_map) {
+        if (my $reftype = ref $rel_collision_map) {
+            if ($reftype ne 'HASH') {
+                croak "Invalid type $reftype for option 'rel_collision_map'";
+            }
+        }
+        else {
+            $self->rel_collision_map({ '(.*)' => $rel_collision_map });
+        }
+    }
+
+    if (defined(my $rel_name_map = $self->rel_name_map)) {
+        my $reftype = ref $rel_name_map;
+        if ($reftype ne 'HASH' && $reftype ne 'CODE') {
+            croak "Invalid type $reftype for option 'rel_name_map', must be HASH or CODE";
+        }
+    }
+
     $self;
 }
 
@@ -1212,11 +1290,10 @@ sub _load_tables {
 
     if(!$self->skip_relationships) {
         # The relationship loader needs a working schema
-        $self->{quiet} = 1;
+        local $self->{quiet} = 1;
         local $self->{dump_directory} = $self->{temp_directory};
         $self->_reload_classes(\@tables);
         $self->_load_relationships(\@tables);
-        $self->{quiet} = 0;
 
         # Remove that temp dir from INC so it doesn't get reloaded
         @INC = grep $_ ne $self->dump_directory, @INC;
@@ -1369,7 +1446,7 @@ sub _dump_to_dir {
 
     my $target_dir = $self->dump_directory;
     warn "Dumping manual schema for $schema_class to directory $target_dir ...\n"
-        unless $self->{dynamic} or $self->{quiet};
+        unless $self->dynamic or $self->quiet;
 
     my $schema_text =
           qq|package $schema_class;\n\n|
@@ -1383,6 +1460,15 @@ sub _dump_to_dir {
         $schema_text .= qq|use strict;\nuse warnings;\n\nuse base '$schema_base_class';\n\n|;
     }
 
+    my @schema_components = @{ $self->schema_components || [] };
+
+    if (@schema_components) {
+        my $schema_components = dump @schema_components;
+        $schema_components = "($schema_components)" if @schema_components == 1;
+
+        $schema_text .= "__PACKAGE__->load_components${schema_components};\n\n";
+    }
+
     if ($self->use_namespaces) {
         $schema_text .= qq|__PACKAGE__->load_namespaces|;
         my $namespace_options;
@@ -1459,7 +1545,7 @@ sub _dump_to_dir {
         }
     }
 
-    warn "Schema dump completed.\n" unless $self->{dynamic} or $self->{quiet};
+    warn "Schema dump completed.\n" unless $self->dynamic or $self->quiet;
 
 }
 
@@ -1479,7 +1565,7 @@ sub _write_classfile {
 
     if (-f $filename && $self->really_erase_my_files) {
         warn "Deleting existing file '$filename' due to "
-            . "'really_erase_my_files' setting\n" unless $self->{quiet};
+            . "'really_erase_my_files' setting\n" unless $self->quiet;
         unlink($filename);
     }
 
@@ -1839,8 +1925,7 @@ EOF
     }
 }
 
-# use the same logic to run moniker_map, col_accessor_map, and
-# relationship_name_map
+# use the same logic to run moniker_map, col_accessor_map
 sub _run_user_map {
     my ( $self, $map, $default_code, $ident, @extra ) = @_;
 
@@ -2109,9 +2194,13 @@ sub _load_relationships {
     my $rel_stmts = $self->_relbuilder->generate_code(\@tables);
 
     foreach my $src_class (sort keys %$rel_stmts) {
-        my $src_stmts = $rel_stmts->{$src_class};
-        foreach my $stmt (@$src_stmts) {
-            $self->_dbic_stmt($src_class,$stmt->{method},@{$stmt->{args}});
+        # sort by rel name
+        my @src_stmts = map $_->[1],
+            sort { $a->[0] cmp $b->[0] }
+            map [ $_->{args}[0], $_ ], @{ $rel_stmts->{$src_class} };
+
+        foreach my $stmt (@src_stmts) {
+            $self->_dbic_stmt($src_class,$stmt->{method}, @{$stmt->{args}});
         }
     }
 }
@@ -2209,6 +2298,7 @@ sub _make_pod {
 
     if ($method eq 'table') {
         my $table = $_[0];
+        $table = $$table if ref $table eq 'SCALAR';
         $self->_pod($class, "=head1 TABLE: C<$table>");
         $self->_pod_cut($class);
     }