Added missing space in error message
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Generic.pm
index bdb5d95..a2fbd21 100644 (file)
@@ -14,10 +14,7 @@ require DBIx::Class;
 
 __PACKAGE__->mk_ro_accessors(qw/
                                 schema
-                                dsn
-                                user
-                                password
-                                options
+                                connect_info
                                 exclude
                                 constraint
                                 additional_classes
@@ -32,6 +29,7 @@ __PACKAGE__->mk_ro_accessors(qw/
                                 drop_db_schema
                                 debug
 
+                                _tables
                                 classes
                                 monikers
                              /);
@@ -53,6 +51,16 @@ classes, and implements the common functionality between them.
 
 Available constructor options are:
 
+=head2 connect_info
+
+Identical to the connect_info arguments to C<connect> and C<connection>
+that are mentioned in L<DBIx::Class::Schema>.
+
+An arrayref of connection information.  For DBI-based Schemas,
+this takes the form:
+
+  connect_info => [ $dsn, $user, $pass, { AutoCommit => 1 } ],
+
 =head2 additional_base_classes
 
 List of additional base classes your table classes will use.
@@ -89,14 +97,6 @@ Exclude tables matching regex.
 
 Enable debug messages.
 
-=head2 dsn
-
-DBI Data Source Name.
-
-=head2 password
-
-Password.
-
 =head2 relationships
 
 Try to automatically detect/setup has_a and has_many relationships.
@@ -121,10 +121,32 @@ Deprecated.  Equivalent to L</inflect_map>, but previously only took
 a hashref argument, not a coderef.  If you set C<inflect> to anything,
 that setting will be copied to L</inflect_map>.
 
+=head2 dsn
+
+DEPRECATED, use L</connect_info> instead.
+
+DBI Data Source Name.
+
 =head2 user
 
+DEPRECATED, use L</connect_info> instead.
+
 Username.
 
+=head2 password
+
+DEPRECATED, use L</connect_info> instead.
+
+Password.
+
+=head2 options
+
+DEPRECATED, use L</connect_info> instead.
+
+DBI connection options hashref, like:
+
+  { AutoCommit => 1 }
+
 =head1 METHODS
 
 =cut
@@ -161,7 +183,8 @@ sub new {
                                additional_base_classes
                                left_base_classes
                                components
-                               resultset_components/);
+                               resultset_components
+                               connect_info/);
 
     push(@{$self->{components}}, 'ResultSetManager')
         if @{$self->{resultset_components}};
@@ -172,6 +195,13 @@ sub new {
     # Support deprecated argument name
     $self->{inflect_map} ||= $self->{inflect};
 
+    # Support deprecated connect_info args, even mixed
+    #  with a valid partially-filled connect_info
+    $self->{connect_info}->[0] ||= $self->{dsn};
+    $self->{connect_info}->[1] ||= $self->{user};
+    $self->{connect_info}->[2] ||= $self->{password};
+    $self->{connect_info}->[3] ||= $self->{options};
+
     $self;
 }
 
@@ -185,14 +215,14 @@ L<DBIx::Class::Schema::Loader> right after object construction.
 sub load {
     my $self = shift;
 
-    $self->schema->connection($self->dsn, $self->user,
-                              $self->password, $self->options);
+    $self->schema->connection(@{$self->connect_info});
 
     warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
         if $self->debug;
 
     $self->_load_classes;
     $self->_load_relationships if $self->relationships;
+    $self->_load_external;
 
     warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
         if $self->debug;
@@ -201,6 +231,22 @@ sub load {
     $self;
 }
 
+sub _load_external {
+    my $self = shift;
+
+    foreach my $table_class (map { $self->classes->{$_} } $self->tables) {
+        $table_class->require;
+        if($@ && $@ !~ /^Can't locate /) {
+            croak "Failed to load external class definition"
+                  . " for '$table_class': $@";
+        }
+        elsif(!$@) {
+            warn qq/# Loaded external class definition for '$table_class'\n/
+                if $self->debug;
+        }
+    }
+}
+
 # Overload in your driver class
 sub _db_classes { croak "ABSTRACT METHOD" }
 
@@ -322,27 +368,36 @@ sub _inject {
 sub _load_classes {
     my $self = shift;
 
-    my @tables     = $self->_tables();
     my @db_classes = $self->_db_classes();
     my $schema     = $self->schema;
 
-    foreach my $table (@tables) {
-        my $constraint = $self->constraint;
-        my $exclude = $self->exclude;
+    my $constraint = $self->constraint;
+    my $exclude = $self->exclude;
+    my @tables = sort grep
+        { /$constraint/ && (!$exclude || ! /$exclude/) }
+            $self->_tables_list;
 
-        next unless $table =~ /$constraint/;
-        next if defined $exclude && $table =~ /$exclude/;
+    $self->{_tables} = \@tables;
 
+    foreach my $table (@tables) {
         my ($db_schema, $tbl) = split /\./, $table;
-        my $tablename = lc $table;
         if($tbl) {
-            $tablename = $self->drop_db_schema ? $tbl : lc $table;
+            $table = $self->drop_db_schema ? $tbl : $table;
         }
-        my $lc_tblname = lc $tablename;
+        my $lc_table = lc $table;
 
         my $table_moniker = $self->_table2moniker($db_schema, $tbl);
         my $table_class = $schema . q{::} . $table_moniker;
 
+        $self->classes->{$lc_table} = $table_class;
+        $self->monikers->{$lc_table} = $table_moniker;
+        $self->classes->{$table} = $table_class;
+        $self->monikers->{$table} = $table_moniker;
+
+        no warnings 'redefine';
+        local *Class::C3::reinitialize = sub { };
+        use warnings;
+
         { no strict 'refs';
           @{"${table_class}::ISA"} = qw/DBIx::Class/;
         }
@@ -352,42 +407,38 @@ sub _load_classes {
         $table_class->load_resultset_components(@{$self->resultset_components})
             if @{$self->resultset_components};
         $self->_inject($table_class, @{$self->left_base_classes});
+    }
 
-        warn qq/\# Initializing table "$tablename" as "$table_class"\n/
+    Class::C3::reinitialize;
+
+    foreach my $table (@tables) {
+        my $table_class = $self->classes->{$table};
+        my $table_moniker = $self->monikers->{$table};
+
+        warn qq/\# Initializing table "$table" as "$table_class"\n/
             if $self->debug;
-        $table_class->table($lc_tblname);
+        $table_class->table($table);
 
         my ( $cols, $pks ) = $self->_table_info($table);
         carp("$table has no primary key") unless @$pks;
         $table_class->add_columns(@$cols);
         $table_class->set_primary_key(@$pks) if @$pks;
 
-        warn qq/$table_class->table('$tablename');\n/ if $self->debug;
+        warn qq/$table_class->table('$table');\n/ if $self->debug;
         my $columns = join "', '", @$cols;
         warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
         my $primaries = join "', '", @$pks;
         warn qq/$table_class->set_primary_key('$primaries')\n/
             if $self->debug && @$pks;
 
-        $table_class->require;
-        if($@ && $@ !~ /^Can't locate /) {
-            croak "Failed to load external class definition"
-                  . "for '$table_class': $@";
-        }
-
-        warn qq/# Loaded external class definition for '$table_class'\n/
-            if $self->debug;
-
         $schema->register_class($table_moniker, $table_class);
-        $self->classes->{$lc_tblname} = $table_class;
-        $self->monikers->{$lc_tblname} = $table_moniker;
     }
 }
 
 =head2 tables
 
 Returns a sorted list of loaded tables, using the original database table
-names.  Actually generated from the keys of the C<monikers> hash below.
+names.
 
   my @tables = $schema->loader->tables;
 
@@ -396,7 +447,7 @@ names.  Actually generated from the keys of the C<monikers> hash below.
 sub tables {
     my $self = shift;
 
-    return sort keys %{ $self->monikers };
+    return @{$self->_tables};
 }
 
 # Find and setup relationships
@@ -411,10 +462,10 @@ sub _load_relationships {
             $self->db_schema, '', '', '', $table );
         next if !$sth;
         while(my $raw_rel = $sth->fetchrow_hashref) {
-            my $uk_tbl  = lc $raw_rel->{UK_TABLE_NAME};
+            my $uk_tbl  = $raw_rel->{UK_TABLE_NAME};
             my $uk_col  = lc $raw_rel->{UK_COLUMN_NAME};
             my $fk_col  = lc $raw_rel->{FK_COLUMN_NAME};
-            my $relid   = lc $raw_rel->{UK_NAME};
+            my $relid   = $raw_rel->{UK_NAME};
             $uk_tbl =~ s/$quoter//g;
             $uk_col =~ s/$quoter//g;
             $fk_col =~ s/$quoter//g;
@@ -463,14 +514,17 @@ sub _table2moniker {
 }
 
 # Overload in driver class
-sub _tables { croak "ABSTRACT METHOD" }
+sub _tables_list { croak "ABSTRACT METHOD" }
 
 sub _table_info { croak "ABSTRACT METHOD" }
 
 =head2 monikers
 
 Returns a hashref of loaded table-to-moniker mappings for the original
-database table names.
+database table names.  In cases where the database driver returns table
+names as uppercase or mixed case, there will also be a duplicate entry
+here in all lowercase.  Best practice would be to use lower-case table
+names when accessing this.
 
   my $monikers = $schema->loader->monikers;
   my $foo_tbl_moniker = $monikers->{foo_tbl};
@@ -481,7 +535,9 @@ database table names.
 =head2 classes
 
 Returns a hashref of table-to-classname mappings for the original database
-table names.  You probably shouldn't be using this for any normal or simple
+table names.  Same lowercase stuff as above applies here. 
+
+You probably shouldn't be using this for any normal or simple
 usage of your Schema.  The usual way to run queries on your tables is via
 C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
 returned by C<monikers> above.