various identifier cleanups, to help prevent clashing with Schema stuff down the...
Brandon Black [Tue, 24 Jan 2006 21:55:36 +0000 (21:55 +0000)]
Makefile.PL
lib/DBIx/Class/Schema/Loader.pm
lib/DBIx/Class/Schema/Loader/DB2.pm
lib/DBIx/Class/Schema/Loader/Generic.pm
lib/DBIx/Class/Schema/Loader/Pg.pm
lib/DBIx/Class/Schema/Loader/SQLite.pm
lib/DBIx/Class/Schema/Loader/Writing.pm
lib/DBIx/Class/Schema/Loader/mysql.pm

index b3134e4..76c030c 100644 (file)
@@ -5,7 +5,7 @@ WriteMakefile(
     'VERSION_FROM' => 'lib/DBIx/Class/Schema/Loader.pm',
     'PREREQ_PM'    => {
         Test::More          => 0.32,
-        DBIx::Class         => 0.04999_04,
+        DBIx::Class         => 0.05,
         DBI                 => 1.30,
         Lingua::EN::Inflect => 0,
         Text::Balanced      => 0,
index 51b2792..f7f1305 100644 (file)
@@ -2,6 +2,7 @@ package DBIx::Class::Schema::Loader;
 
 use strict;
 use warnings;
+use Carp;
 
 use vars qw($VERSION @ISA);
 use UNIVERSAL::require;
@@ -55,8 +56,8 @@ L<DBIx::Class::Schema::Loader::Generic> for more, and
 L<DBIx::Class::Schema::Loader::Writing> for notes on writing your own
 db-specific subclass for an unsupported db.
 
-This module obsoletes L<DBIx::Class::Loader> for L<DBIx::Class> version 0.5
-and later.
+This module requires DBIx::Class::Loader 0.5 or later, and obsoletes
+L<DBIx::Class::Loader> for L<DBIx::Class> version 0.5 and later.
 
 =cut
 
@@ -73,7 +74,7 @@ L<DBIx::Class::Schema::Loader::Generic> documentation.
 sub load_from_connection {
     my ( $class, %args ) = @_;
 
-    die qq/dsn argument is required/ if ! $args{dsn};
+    croak 'dsn argument is required' if ! $args{dsn};
 
     my $dsn = $args{dsn};
     my ($driver) = $dsn =~ m/^dbi:(\w*?)(?:\((.*?)\))?:/i;
@@ -81,8 +82,8 @@ sub load_from_connection {
     my $impl = "DBIx::Class::Schema::Loader::" . $driver;
 
     $impl->require or
-      die qq/Couldn't require loader class "$impl",/ .
-          qq/"$UNIVERSAL::require::ERROR"/;
+      croak qq/Couldn't require loader class "$impl",/ .
+            qq/"$UNIVERSAL::require::ERROR"/;
 
     push(@ISA, $impl);
     $class->_load_from_connection(%args);
index a6de578..10e7ca3 100644 (file)
@@ -27,14 +27,14 @@ See L<DBIx::Class::Schema::Loader>.
 
 =cut
 
-sub _db_classes {
+sub _loader_db_classes {
     return qw/DBIx::Class::PK::Auto::DB2/;
 }
 
-sub _tables {
+sub _loader_tables {
     my $class = shift;
     my %args = @_; 
-    my $db_schema = uc $class->loader_data->{_db_schema};
+    my $db_schema = uc $class->_loader_data->{db_schema};
     my $dbh = $class->storage->dbh;
 
     # this is split out to avoid version parsing errors...
@@ -50,10 +50,10 @@ sub _tables {
     return @tables;
 }
 
-sub _table_info {
+sub _loader_table_info {
     my ( $class, $table ) = @_;
 #    $|=1;
-#    print "_table_info($table)\n";
+#    print "_loader_table_info($table)\n";
     my ($db_schema, $tabname) = split /\./, $table, 2;
     # print "DB_Schema: $db_schema, Table: $tabname\n";
     
@@ -89,7 +89,7 @@ SQL
 }
 
 # Find and setup relationships
-sub _relationships {
+sub _loader_relationships {
     my $class = shift;
 
     my $dbh = $class->storage->dbh;
@@ -116,9 +116,9 @@ SQL
                     $cond{$other_cols[$i]} = $self_cols[$i];
                 }
 
-                eval { $class->_belongs_to_many ($table, $other, \%cond); };
+                eval { $class->_loader_make_relations ($table, $other, \%cond); };
                 warn qq/\# belongs_to_many failed "$@"\n\n/
-                  if $@ && $class->debug_loader;
+                  if $@ && $class->_loader_debug;
             }
         }
     }
index 2c175a8..04c593a 100644 (file)
@@ -10,7 +10,8 @@ use Lingua::EN::Inflect;
 
 require DBIx::Class::Core;
 
-__PACKAGE__->mk_classdata('loader_data');
+__PACKAGE__->mk_classdata('_loader_data');
+__PACKAGE__->mk_classdata('_loader_debug' => 0);
 
 =head1 NAME
 
@@ -84,47 +85,51 @@ C<new()> method in L<DBIx::Class::Schema::Loader>.
 
 sub _load_from_connection {
     my ( $class, %args ) = @_;
-    if ( $args{debug} ) {
-        no strict 'refs';
-        *{"$class\::debug_loader"} = sub { 1 };
-    }
+
+    $class->_loader_debug( $args{debug} ? 1 : 0);
+
     my $additional = $args{additional_classes} || [];
     $additional = [$additional] unless ref $additional eq 'ARRAY';
+
     my $additional_base = $args{additional_base_classes} || [];
     $additional_base = [$additional_base]
       unless ref $additional_base eq 'ARRAY';
+
     my $left_base = $args{left_base_classes} || [];
     $left_base = [$left_base] unless ref $left_base eq 'ARRAY';
-    $class->loader_data({
-        _datasource =>
+
+    $class->_loader_data({
+        datasource =>
           [ $args{dsn}, $args{user}, $args{password}, $args{options} ],
-        _additional      => $additional,
-        _additional_base => $additional_base,
-        _left_base       => $left_base,
-        _constraint      => $args{constraint} || '.*',
-        _exclude         => $args{exclude},
-        _relationships   => $args{relationships},
-        _inflect         => $args{inflect},
-        _db_schema       => $args{db_schema} || '',
-        _drop_db_schema  => $args{drop_db_schema},
-        TABLE_CLASSES    => {},
-        MONIKERS         => {},
+        additional      => $additional,
+        additional_base => $additional_base,
+        left_base       => $left_base,
+        constraint      => $args{constraint} || '.*',
+        exclude         => $args{exclude},
+        relationships   => $args{relationships},
+        inflect         => $args{inflect},
+        db_schema       => $args{db_schema} || '',
+        drop_db_schema  => $args{drop_db_schema},
+        TABLE_CLASSES   => {},
+        MONIKERS        => {},
     });
 
-    $class->connection(@{$class->loader_data->{_datasource}});
-    warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/ if $class->debug_loader;
-    $class->_load_classes;
-    $class->_relationships                            if $class->loader_data->{_relationships};
-    warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/ if $class->debug_loader;
+    $class->connection(@{$class->_loader_data->{datasource}});
+    warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
+        if $class->_loader_debug;
+    $class->_loader_load_classes;
+    $class->_loader_relationships if $class->_loader_data->{relationships};
+    warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
+        if $class->_loader_debug;
     $class->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later?
 
     1;
 }
 
 # The original table class name during Loader,
-sub _find_table_class {
+sub _loader_find_table_class {
     my ( $class, $table ) = @_;
-    return $class->loader_data->{TABLE_CLASSES}->{$table};
+    return $class->_loader_data->{TABLE_CLASSES}->{$table};
 }
 
 # Returns the moniker for a given table name,
@@ -138,17 +143,9 @@ as $schema->resultset($moniker), etc.
 =cut
 sub moniker {
     my ( $class, $table ) = @_;
-    return $class->loader_data->{MONIKERS}->{$table};
+    return $class->_loader_data->{MONIKERS}->{$table};
 }
 
-=head3 debug_loader
-
-Overload to enable Loader debug messages.
-
-=cut
-
-sub debug_loader { 0 }
-
 =head3 tables
 
 Returns a sorted list of tables.
@@ -159,24 +156,24 @@ Returns a sorted list of tables.
 
 sub tables {
     my $class = shift;
-    return sort keys %{ $class->loader_data->{MONIKERS} };
+    return sort keys %{ $class->_loader_data->{MONIKERS} };
 }
 
 # Overload in your driver class
-sub _db_classes { croak "ABSTRACT METHOD" }
+sub _loader_db_classes { croak "ABSTRACT METHOD" }
 
 # Setup has_a and has_many relationships
-sub _belongs_to_many {
+sub _loader_make_relations {
     use Data::Dumper;
 
     my ( $class, $table, $other, $cond ) = @_;
-    my $table_class = $class->_find_table_class($table);
-    my $other_class = $class->_find_table_class($other);
+    my $table_class = $class->_loader_find_table_class($table);
+    my $other_class = $class->_loader_find_table_class($other);
 
     my $table_relname = lc $table;
     my $other_relname = lc $other;
 
-    if(my $inflections = $class->loader_data->{_inflect}) {
+    if(my $inflections = $class->_loader_data->{inflect}) {
         $table_relname = $inflections->{$table_relname}
           if exists $inflections->{$table_relname};
     }
@@ -193,37 +190,37 @@ sub _belongs_to_many {
 
     my $rev_cond = { reverse %$cond };
 
-    warn qq/\# Belongs_to relationship\n/ if $class->debug_loader;
+    warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
 
     warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
       .  Dumper($cond)
       .  qq/);\n\n/
-      if $class->debug_loader;
+      if $class->_loader_debug;
 
     $table_class->belongs_to( $other_relname => $other_class, $cond);
 
-    warn qq/\# Has_many relationship\n/ if $class->debug_loader;
+    warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
 
     warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
       .  Dumper($rev_cond)
       .  qq/);\n\n/
-      if $class->debug_loader;
+      if $class->_loader_debug;
 
     $other_class->has_many( $table_relname => $table_class, $rev_cond);
 }
 
 # Load and setup classes
-sub _load_classes {
+sub _loader_load_classes {
     my $class = shift;
 
-    my @tables          = $class->_tables();
-    my @db_classes      = $class->_db_classes();
-    my $additional      = join '', map "use $_;\n", @{ $class->loader_data->{_additional} };
+    my @tables          = $class->_loader_tables();
+    my @db_classes      = $class->_loader_db_classes();
+    my $additional      = join '', map "use $_;\n", @{ $class->_loader_data->{additional} };
     my $additional_base = join '', map "use base '$_';\n",
-      @{ $class->loader_data->{_additional_base} };
-    my $left_base  = join '', map "use base '$_';\n", @{ $class->loader_data->{_left_base} };
-    my $constraint = $class->loader_data->{_constraint};
-    my $exclude    = $class->loader_data->{_exclude};
+      @{ $class->_loader_data->{additional_base} };
+    my $left_base  = join '', map "use base '$_';\n", @{ $class->_loader_data->{left_base} };
+    my $constraint = $class->_loader_data->{constraint};
+    my $exclude    = $class->_loader_data->{exclude};
 
     foreach my $table (@tables) {
         next unless $table =~ /$constraint/;
@@ -232,49 +229,49 @@ sub _load_classes {
         my ($db_schema, $tbl) = split /\./, $table;
         my $tablename = lc $table;
         if($tbl) {
-            $tablename = $class->loader_data->{_drop_db_schema} ? $tbl : lc $table;
+            $tablename = $class->_loader_data->{drop_db_schema} ? $tbl : lc $table;
         }
 
-        my $table_moniker = $class->_table2moniker($db_schema, $tbl);
+        my $table_moniker = $class->_loader_table2moniker($db_schema, $tbl);
         my $table_class = "$class\::$table_moniker";
 
         $class->inject_base( $table_class, 'DBIx::Class::Core' );
         $_->require for @db_classes;
         $class->inject_base( $table_class, $_ ) for @db_classes;
-        warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->debug_loader;
+        warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->_loader_debug;
         $table_class->table(lc $tablename);
 
-        my ( $cols, $pks ) = $class->_table_info($table);
+        my ( $cols, $pks ) = $class->_loader_table_info($table);
         carp("$table has no primary key") unless @$pks;
         $table_class->add_columns(@$cols);
         $table_class->set_primary_key(@$pks) if @$pks;
 
         my $code = "package $table_class;\n$additional_base$additional$left_base";
-        warn qq/$code/                        if $class->debug_loader;
-        warn qq/$table_class->table('$tablename');\n/ if $class->debug_loader;
+        warn qq/$code/                        if $class->_loader_debug;
+        warn qq/$table_class->table('$tablename');\n/ if $class->_loader_debug;
         my $columns = join "', '", @$cols;
-        warn qq/$table_class->add_columns('$columns')\n/ if $class->debug_loader;
+        warn qq/$table_class->add_columns('$columns')\n/ if $class->_loader_debug;
         my $primaries = join "', '", @$pks;
-        warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->debug_loader && @$pks;
+        warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->_loader_debug && @$pks;
         eval $code;
         croak qq/Couldn't load additional classes "$@"/ if $@;
-        unshift @{"$table_class\::ISA"}, $_ foreach ( @{ $class->loader_data->{_left_base} } );
+        unshift @{"$table_class\::ISA"}, $_ foreach ( @{ $class->_loader_data->{left_base} } );
 
         $class->register_class($table_moniker, $table_class);
-        $class->loader_data->{TABLE_CLASSES}->{lc $tablename} = $table_class;
-        $class->loader_data->{MONIKERS}->{lc $tablename} = $table_moniker;
+        $class->_loader_data->{TABLE_CLASSES}->{lc $tablename} = $table_class;
+        $class->_loader_data->{MONIKERS}->{lc $tablename} = $table_moniker;
     }
 }
 
 # Find and setup relationships
-sub _relationships {
+sub _loader_relationships {
     my $class = shift;
     my $dbh = $class->storage->dbh;
     my $quoter = $dbh->get_info(29) || q{"};
     foreach my $table ( $class->tables ) {
         my $rels = {};
         my $sth = $dbh->foreign_key_info( '',
-            $class->loader_data->{_db_schema}, '', '', '', $table );
+            $class->_loader_data->{db_schema}, '', '', '', $table );
         next if !$sth;
         while(my $raw_rel = $sth->fetchrow_hashref) {
             my $uk_tbl  = lc $raw_rel->{UK_TABLE_NAME};
@@ -288,22 +285,22 @@ sub _relationships {
 
         foreach my $reltbl (keys %$rels) {
             my $cond = $rels->{$reltbl};
-            eval { $class->_belongs_to_many( $table, $reltbl, $cond ) };
+            eval { $class->_loader_make_relations( $table, $reltbl, $cond ) };
               warn qq/\# belongs_to_many failed "$@"\n\n/
-                if $@ && $class->debug_loader;
+                if $@ && $class->_loader_debug;
         }
     }
 }
 
 # Make a moniker from a table
-sub _table2moniker {
+sub _loader_table2moniker {
     my ( $class, $db_schema, $table ) = @_;
 
     my $db_schema_ns;
 
     if($table) {
         $db_schema = ucfirst lc $db_schema;
-        $db_schema_ns = $db_schema if(!$class->loader_data->{_drop_db_schema});
+        $db_schema_ns = $db_schema if(!$class->_loader_data->{drop_db_schema});
     } else {
         $table = $db_schema;
     }
@@ -315,9 +312,9 @@ sub _table2moniker {
 }
 
 # Overload in driver class
-sub _tables { croak "ABSTRACT METHOD" }
+sub _loader_tables { croak "ABSTRACT METHOD" }
 
-sub _table_info { croak "ABSTRACT METHOD" }
+sub _loader_table_info { croak "ABSTRACT METHOD" }
 
 =head1 SEE ALSO
 
index 791ff81..62515ff 100644 (file)
@@ -25,33 +25,33 @@ See L<DBIx::Class::Schema::Loader>.
 
 =cut
 
-sub _db_classes {
+sub _loader_db_classes {
     return qw/DBIx::Class::PK::Auto::Pg/;
 }
 
-sub _tables {
+sub _loader_tables {
     my $class = shift;
     my $dbh = $class->storage->dbh;
 
     # This is split out to avoid version parsing errors...
     my $is_dbd_pg_gte_131 = ( $DBD::Pg::VERSION >= 1.31 );
     my @tables = $is_dbd_pg_gte_131 ? 
-        $dbh->tables( undef, $class->loader_data->{_db_schema}, "", "table", { noprefix => 1, pg_noprefix => 1 } )
+        $dbh->tables( undef, $class->_loader_data->{db_schema}, "", "table", { noprefix => 1, pg_noprefix => 1 } )
         : $dbh->tables;
 
     s/"//g for @tables;
     return @tables;
 }
 
-sub _table_info {
+sub _loader_table_info {
     my ( $class, $table ) = @_;
     my $dbh = $class->storage->dbh;
 
-    my $sth = $dbh->column_info(undef, $class->loader_data->{_db_schema}, $table, undef);
+    my $sth = $dbh->column_info(undef, $class->_loader_data->{db_schema}, $table, undef);
     my @cols = map { $_->[3] } @{ $sth->fetchall_arrayref };
     s/"//g for @cols;
     
-    my @primary = $dbh->primary_key(undef, $class->loader_data->{_db_schema}, $table);
+    my @primary = $dbh->primary_key(undef, $class->_loader_data->{db_schema}, $table);
 
     s/"//g for @primary;
 
index a8c675f..bf76503 100644 (file)
@@ -24,12 +24,12 @@ See L<DBIx::Class::Schema::Loader>.
 
 =cut
 
-sub _db_classes {
+sub _loader_db_classes {
     return qw/DBIx::Class::PK::Auto::SQLite/;
 }
 
 # XXX this really needs a re-factor
-sub _relationships {
+sub _loader_relationships {
     my $class = shift;
     foreach my $table ( $class->tables ) {
 
@@ -90,15 +90,15 @@ SELECT sql FROM sqlite_master WHERE tbl_name = ?
                     $cond->{$f_cols[$i]} = $cols[$i];
                 }
 
-                eval { $class->_belongs_to_many( $table, $f_table, $cond ) };
+                eval { $class->_loader_make_relations( $table, $f_table, $cond ) };
                 warn qq/\# belongs_to_many failed "$@"\n\n/
-                  if $@ && $class->debug_loader;
+                  if $@ && $class->_loader_debug;
             }
         }
     }
 }
 
-sub _tables {
+sub _loader_tables {
     my $class = shift;
     my $dbh = $class->storage->dbh;
     my $sth  = $dbh->prepare("SELECT * FROM sqlite_master");
@@ -111,7 +111,7 @@ sub _tables {
     return @tables;
 }
 
-sub _table_info {
+sub _loader_table_info {
     my ( $class, $table ) = @_;
 
     # find all columns.
index 9d93b0f..410ae3f 100644 (file)
@@ -18,27 +18,27 @@ DBIx::Class::Schema::Loader::Writing - Loader subclass writing guide
   use base 'DBIx::Class::Schema::Loader::Generic';
   use Carp;
 
-  sub _db_classes {
+  sub _loader_db_classes {
       return qw/DBIx::Class::PK::Auto::Foo/;
           # You may want to return more, or less, than this.
   }
 
-  sub _tables {
+  sub _loader_tables {
       my $class = shift;
       my $dbh = $class->storage->dbh;
       return $dbh->tables; # Your DBD may need something different
   }
 
-  sub _table_info {
+  sub _loader_table_info {
       my ( $class, $table ) = @_;
       ...
       return ( \@cols, \@primary );
   }
 
-  sub _relationships {
+  sub _loader_relationships {
       my $class = shift;
       ...
-      $class->_belongs_to_many($table, $f_key, $f_table, $f_column);
+      $class->_loader_make_relations($table, $f_key, $f_table, $f_column);
           # For each relationship you want to set up ($f_column is
           # optional, default is $f_table's primary key)
       ...
index 9250593..fb7bb26 100644 (file)
@@ -25,15 +25,15 @@ See L<DBIx::Class::Schema::Loader>.
 
 =cut
 
-sub _db_classes {
+sub _loader_db_classes {
     return qw/DBIx::Class::PK::Auto::MySQL/;
 }
 
-sub _relationships {
+sub _loader_relationships {
     my $class   = shift;
     my @tables = $class->tables;
     my $dbh    = $class->storage->dbh;
-    my $dsn    = $class->loader_data->{_datasource}[0];
+    my $dsn    = $class->_loader_data->{datasource}[0];
     my %conn   =
       $dsn =~ m/\Adbi:\w+(?:\(.*?\))?:(.+)\z/i
       && index( $1, '=' ) >= 0
@@ -68,15 +68,15 @@ sub _relationships {
                 $cond->{$f_cols[$i]} = $cols[$i];
             }
 
-            eval { $class->_belongs_to_many( $table, $f_table, $cond) };
-            warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $class->debug_loader;
+            eval { $class->_loader_make_relations( $table, $f_table, $cond) };
+            warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $class->_loader_debug;
         }
         
         $sth->finish;
     }
 }
 
-sub _tables {
+sub _loader_tables {
     my $class = shift;
     my $dbh    = $class->storage->dbh;
     my @tables;
@@ -89,7 +89,7 @@ sub _tables {
     return @tables;
 }
 
-sub _table_info {
+sub _loader_table_info {
     my ( $class, $table ) = @_;
     my $dbh    = $class->storage->dbh;