loader as a schema subclass basically working (needs some cleanup and docs and whatnot)
Brandon Black [Sat, 21 Jan 2006 23:21:41 +0000 (23:21 +0000)]
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/mysql.pm
t/dbixcl_common_tests.pm

index 75318cf..5238c78 100644 (file)
@@ -1,9 +1,16 @@
 package DBIx::Class::Schema::Loader;
 
 use strict;
+use warnings;
+
+use vars qw($VERSION @ISA);
 use UNIVERSAL::require;
 
-our $VERSION = '0.01';
+# Always remember to do all digits for the version even if they're 0
+# i.e. first release of 0.XX *must* be 0.XX000. This avoids fBSD ports
+# brain damage and presumably various other packaging systems too
+
+$VERSION = '0.01000';
 
 =head1 NAME
 
@@ -11,13 +18,14 @@ DBIx::Class::Schema::Loader - Dynamic definition of a DBIx::Class::Schema
 
 =head1 SYNOPSIS
 
-  use DBIx::Class::Schema::Loader;
+  package My::Schema;
+  use base qw/DBIx::Class::Schema::Loader/;
 
-  my $loader = DBIx::Class::Schema::Loader->new(
+  __PACKAGE__->load_from_connection(
     dsn                     => "dbi:mysql:dbname",
     user                    => "root",
     password                => "",
-    namespace               => "Data",
+    namespace               => "My",
     additional_classes      => [qw/DBIx::Class::Foo/],
     additional_base_classes => [qw/My::Stuff/],
     left_base_classes       => [qw/DBIx::Class::Bar/],
@@ -28,30 +36,14 @@ DBIx::Class::Schema::Loader - Dynamic definition of a DBIx::Class::Schema
     debug                   => 1,
   );
 
-  my $conn = $loader->connection($dsn, $user, $password); #
-  my $conn = $loader->connection(); # uses same dsn as ->new();
-
-use with mod_perl
-
-in your startup.pl
-
-  # load all tables
-  use DBIx::Class::Loader;
-  my $loader = DBIx::Class::Loader->new(
-    dsn       => "dbi:mysql:dbname",
-    user      => "root",
-    password  => "",
-    namespace => "Data",
-  );
-
-in your web application.
+  # in seperate application code ...
 
-  use strict;
+  use My::Schema;
 
-  # you can use Data::Film directly
-  my $conn = $loader->connection();
-  my $film_moniker = $loader->moniker('film');
-  my $a_film = $conn->resultset($film_moniker)->find($id);
+  my $schema1 = My::Schema->connect( $dsn, $user, $password, $attrs);
+  # -or-
+  my $schema1 = My::Schema->connect();
+  # ^^ defaults to dsn/user/pass from load_from_connection()
 
 =head1 DESCRIPTION
 
@@ -79,7 +71,7 @@ L<DBIx::Class::Schema::Loader::Generic> documentation.
 
 =cut
 
-sub new {
+sub load_from_connection {
     my ( $class, %args ) = @_;
 
     foreach (qw/namespace dsn/) {
@@ -96,7 +88,8 @@ sub new {
     $impl->require or
     die qq/Couldn't require loader class "$impl", "$UNIVERSAL::require::ERROR"/;
 
-    return $impl->new(%args);
+    push(@ISA, $impl);
+    $class->_load_from_connection(%args);
 }
 
 =head1 AUTHOR
index 70a22b6..49153a9 100644 (file)
@@ -34,10 +34,10 @@ sub _db_classes {
 }
 
 sub _tables {
-    my $self = shift;
+    my $class = shift;
     my %args = @_; 
     my $db_schema = uc ($args{db_schema} || '');
-    my $dbh = $self->{_storage}->dbh;
+    my $dbh = $class->storage->dbh;
 
     # this is split out to avoid version parsing errors...
     my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 );
@@ -53,14 +53,14 @@ sub _tables {
 }
 
 sub _table_info {
-    my ( $self, $table ) = @_;
+    my ( $class, $table ) = @_;
 #    $|=1;
 #    print "_table_info($table)\n";
     my ($db_schema, $tabname) = split /\./, $table, 2;
     # print "DB_Schema: $db_schema, Table: $tabname\n";
     
     # FIXME: Horribly inefficient and just plain evil. (JMM)
-    my $dbh = $self->{_storage}->dbh;
+    my $dbh = $class->storage->dbh;
     $dbh->{RaiseError} = 1;
 
     my $sth = $dbh->prepare(<<'SQL') or die;
index 70bca82..d79776a 100644 (file)
@@ -1,13 +1,18 @@
 package DBIx::Class::Schema::Loader::Generic;
 
 use strict;
-use base 'DBIx::Class::Componentised';
+use warnings;
+
+use base qw/DBIx::Class::Schema/;
+
 use Carp;
 use Lingua::EN::Inflect;
-use UNIVERSAL::require;
-use DBIx::Class::Storage::DBI;
+
 require DBIx::Class::Core;
-require DBIx::Class::Schema;
+
+__PACKAGE__->mk_classdata('loader_data');
+
+# XXX convert all usage of $class/$self->debug to ->debug_loader
 
 =head1 NAME
 
@@ -83,11 +88,11 @@ C<new()> method in L<DBIx::Class::Schema::Loader>.
 
 =cut
 
-sub new {
+sub _load_from_connection {
     my ( $class, %args ) = @_;
     if ( $args{debug} ) {
         no strict 'refs';
-        *{"$class\::debug"} = sub { 1 };
+        *{"$class\::debug_loader"} = sub { 1 };
     }
     my $additional = $args{additional_classes} || [];
     $additional = [$additional] unless ref $additional eq 'ARRAY';
@@ -96,10 +101,10 @@ sub new {
       unless ref $additional_base eq 'ARRAY';
     my $left_base = $args{left_base_classes} || [];
     $left_base = [$left_base] unless ref $left_base eq 'ARRAY';
-    my $self = bless {
+    $class->loader_data({
         _datasource =>
           [ $args{dsn}, $args{user}, $args{password}, $args{options} ],
-        _namespace       => $args{namespace},
+        _namespace       => $args{namespace} || $class,
         _additional      => $additional,
         _additional_base => $additional_base,
         _left_base       => $left_base,
@@ -107,37 +112,33 @@ sub new {
         _exclude         => $args{exclude},
         _relationships   => $args{relationships},
         _inflect         => $args{inflect},
-        _db_schema       => $args{schema},
-        _drop_db_schema  => $args{dropschema},
-        _schema_class    => "$args{namespace}\::_schema",
+        _db_schema       => $args{db_schema},
+        _drop_db_schema  => $args{drop_db_schema},
         TABLE_CLASSES    => {},
         MONIKERS         => {},
-    }, $class;
-    warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/ if $self->debug;
-    $self->_load_classes;
-    $self->_relationships                            if $self->{_relationships};
-    warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/ if $self->debug;
-    $self->{_storage}->dbh->disconnect;
-    $self;
+    });
+
+    $class->connection(@{$class->loader_data->{_datasource}});
+    warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/ if $class->debug;
+    $class->_load_classes;
+    $class->_relationships                            if $class->loader_data->{_relationships};
+    warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/ if $class->debug;
+    $class->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later?
+
+    1;
 }
 
 # The original table class name during Loader,
 sub _find_table_class {
-    my ( $self, $table ) = @_;
-    return $self->{TABLE_CLASSES}->{$table};
+    my ( $class, $table ) = @_;
+    return $class->loader_data->{TABLE_CLASSES}->{$table};
 }
 
 # Returns the moniker for a given table name,
 # for use in $conn->resultset($moniker)
 sub moniker {
-    my ( $self, $table ) = @_;
-    return $self->{MONIKERS}->{$table};
-}
-
-sub connect {
-    my $self = shift;
-    return $self->{_schema_class}->connect(@_) if(@_);
-    return $self->{_schema_class}->connect(@{$self->{_datasource}});
+    my ( $class, $table ) = @_;
+    return $class->loader_data->{MONIKERS}->{$table};
 }
 
 =head3 debug
@@ -157,8 +158,8 @@ Returns a sorted list of tables.
 =cut
 
 sub tables {
-    my $self = shift;
-    return sort keys %{ $self->{MONIKERS} };
+    my $class = shift;
+    return sort keys %{ $class->loader_data->{MONIKERS} };
 }
 
 # Overload in your driver class
@@ -166,17 +167,17 @@ sub _db_classes { croak "ABSTRACT METHOD" }
 
 # Setup has_a and has_many relationships
 sub _belongs_to_many {
-    my ( $self, $table, $column, $other, $other_column ) = @_;
-    my $table_class = $self->_find_table_class($table);
-    my $other_class = $self->_find_table_class($other);
+    my ( $class, $table, $column, $other, $other_column ) = @_;
+    my $table_class = $class->_find_table_class($table);
+    my $other_class = $class->_find_table_class($other);
 
-    warn qq/\# Belongs_to relationship\n/ if $self->debug;
+    warn qq/\# Belongs_to relationship\n/ if $class->debug;
 
     if($other_column) {
         warn qq/$table_class->belongs_to( '$column' => '$other_class',/
           .  qq/ { "foreign.$other_column" => "self.$column" },/
           .  qq/ { accessor => 'filter' });\n\n/
-          if $self->debug;
+          if $class->debug;
         $table_class->belongs_to( $column => $other_class, 
           { "foreign.$other_column" => "self.$column" },
           { accessor => 'filter' }
@@ -184,22 +185,22 @@ sub _belongs_to_many {
     }
     else {
         warn qq/$table_class->belongs_to( '$column' => '$other_class' );\n\n/
-          if $self->debug;
+          if $class->debug;
         $table_class->belongs_to( $column => $other_class );
     }
 
     my ($table_class_base) = $table_class =~ /.*::(.+)/;
     my $plural = Lingua::EN::Inflect::PL( lc $table_class_base );
-    $plural = $self->{_inflect}->{ lc $table_class_base }
-      if $self->{_inflect}
-      and exists $self->{_inflect}->{ lc $table_class_base };
+    $plural = $class->loader_data->{_inflect}->{ lc $table_class_base }
+      if $class->loader_data->{_inflect}
+      and exists $class->loader_data->{_inflect}->{ lc $table_class_base };
 
-    warn qq/\# Has_many relationship\n/ if $self->debug;
+    warn qq/\# Has_many relationship\n/ if $class->debug;
 
     if($other_column) {
         warn qq/$other_class->has_many( '$plural' => '$table_class',/
           .  qq/ { "foreign.$column" => "self.$other_column" } );\n\n/
-          if $self->debug;
+          if $class->debug;
         $other_class->has_many( $plural => $table_class,
                                 { "foreign.$column" => "self.$other_column" }
                               );
@@ -207,29 +208,25 @@ sub _belongs_to_many {
     else {
         warn qq/$other_class->has_many( '$plural' => '$table_class',/
           .  qq/'$other_column' );\n\n/
-          if $self->debug;
+          if $class->debug;
         $other_class->has_many( $plural => $table_class, $column );
     }
 }
 
 # Load and setup classes
 sub _load_classes {
-    my $self            = shift;
+    my $class = shift;
 
-    my $namespace      = $self->{_namespace};
-    my $schema_class   = $self->{_schema_class};
-    $self->inject_base( $schema_class, 'DBIx::Class::Schema' );
-    $self->{_storage} = $schema_class->storage(DBIx::Class::Storage::DBI->new());
-    $schema_class->storage->connect_info($self->{_datasource});
+    my $namespace    = $class->loader_data->{_namespace};
 
-    my @tables          = $self->_tables();
-    my @db_classes      = $self->_db_classes();
-    my $additional      = join '', map "use $_;\n", @{ $self->{_additional} };
+    my @tables          = $class->_tables();
+    my @db_classes      = $class->_db_classes();
+    my $additional      = join '', map "use $_;\n", @{ $class->loader_data->{_additional} };
     my $additional_base = join '', map "use base '$_';\n",
-      @{ $self->{_additional_base} };
-    my $left_base  = join '', map "use base '$_';\n", @{ $self->{_left_base} };
-    my $constraint = $self->{_constraint};
-    my $exclude    = $self->{_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/;
@@ -240,49 +237,49 @@ sub _load_classes {
         my $table_name_only = $table_name_db_schema;
         my ($db_schema, $tbl) = split /\./, $table;
         if($tbl) {
-            $table_name_db_schema = $tbl if $self->{_drop_db_schema};
+            $table_name_db_schema = $tbl if $class->loader_data->{_drop_db_schema};
             $table_name_only = $tbl;
         }
         else {
             undef $db_schema;
         }
 
-        my $subclass = $self->_table2subclass($db_schema, $table_name_only);
-        my $class = $namespace . '::' . $subclass;
+        my $table_subclass = $class->_table2subclass($db_schema, $table_name_only);
+        my $table_class = $namespace . '::' . $table_subclass;
 
-        $self->inject_base( $class, 'DBIx::Class::Core' );
+        $class->inject_base( $table_class, 'DBIx::Class::Core' );
         $_->require for @db_classes;
-        $self->inject_base( $class, $_ ) for @db_classes;
-        warn qq/\# Initializing table "$table_name_db_schema" as "$class"\n/ if $self->debug;
-        $class->table(lc $table_name_db_schema);
+        $class->inject_base( $table_class, $_ ) for @db_classes;
+        warn qq/\# Initializing table "$table_name_db_schema" as "$table_class"\n/ if $class->debug;
+        $table_class->table(lc $table_name_db_schema);
 
-        my ( $cols, $pks ) = $self->_table_info($table_name_db_schema);
+        my ( $cols, $pks ) = $class->_table_info($table_name_db_schema);
         carp("$table has no primary key") unless @$pks;
-        $class->add_columns(@$cols);
-        $class->set_primary_key(@$pks) if @$pks;
+        $table_class->add_columns(@$cols);
+        $table_class->set_primary_key(@$pks) if @$pks;
 
-        my $code = "package $class;\n$additional_base$additional$left_base";
-        warn qq/$code/                        if $self->debug;
-        warn qq/$class->table('$table_name_db_schema');\n/ if $self->debug;
+        my $code = "package $table_class;\n$additional_base$additional$left_base";
+        warn qq/$code/                        if $class->debug;
+        warn qq/$table_class->table('$table_name_db_schema');\n/ if $class->debug;
         my $columns = join "', '", @$cols;
-        warn qq/$class->add_columns('$columns')\n/ if $self->debug;
+        warn qq/$table_class->add_columns('$columns')\n/ if $class->debug;
         my $primaries = join "', '", @$pks;
-        warn qq/$class->set_primary_key('$primaries')\n/ if $self->debug && @$pks;
+        warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->debug && @$pks;
         eval $code;
         croak qq/Couldn't load additional classes "$@"/ if $@;
-        unshift @{"$class\::ISA"}, $_ foreach ( @{ $self->{_left_base} } );
+        unshift @{"$table_class\::ISA"}, $_ foreach ( @{ $class->loader_data->{_left_base} } );
 
-        $schema_class->register_class($subclass, $class);
-        $self->{TABLE_CLASSES}->{$table_name_db_schema} = $class;
-        $self->{MONIKERS}->{$table_name_db_schema} = $subclass;
+        $class->register_class($table_subclass, $table_class);
+        $class->loader_data->{TABLE_CLASSES}->{$table_name_db_schema} = $table_class;
+        $class->loader_data->{MONIKERS}->{$table_name_db_schema} = $table_subclass;
     }
 }
 
 # Find and setup relationships
 sub _relationships {
-    my $self = shift;
-    my $dbh = $self->{_storage}->dbh;
-    foreach my $table ( $self->tables ) {
+    my $class = shift;
+    my $dbh = $class->storage->dbh;
+    foreach my $table ( $class->tables ) {
         my $quoter = $dbh->get_info(29) || q{"};
         if ( my $sth = $dbh->foreign_key_info( '', '', '', '', '', $table ) ) {
             for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) {
@@ -292,10 +289,10 @@ sub _relationships {
                 $column =~ s/$quoter//g;
                 $other =~ s/$quoter//g;
                 $other_column =~ s/$quoter//g;
-                eval { $self->_belongs_to_many( $table, $column, $other,
+                eval { $class->_belongs_to_many( $table, $column, $other,
                   $other_column ) };
                 warn qq/\# belongs_to_many failed "$@"\n\n/
-                  if $@ && $self->debug;
+                  if $@ && $class->debug;
             }
         }
     }
@@ -303,15 +300,15 @@ sub _relationships {
 
 # Make a subclass (dbix moniker) from a table
 sub _table2subclass {
-    my ( $self, $db_schema, $table ) = @_;
+    my ( $class, $db_schema, $table ) = @_;
 
-    my $subclass = join '', map ucfirst, split /[\W_]+/, $table;
+    my $table_subclass = join '', map ucfirst, split /[\W_]+/, $table;
 
-    if($db_schema && !$self->{_drop_db_schema}) {
-        $subclass = (ucfirst lc $db_schema) . '-' . $subclass;
+    if($db_schema && !$class->loader_data->{_drop_db_schema}) {
+        $table_subclass = (ucfirst lc $db_schema) . '-' . $table_subclass;
     }
 
-    $subclass;
+    $table_subclass;
 }
 
 # Overload in driver class
index 6bc4f80..04e67f1 100644 (file)
@@ -2,7 +2,6 @@ package DBIx::Class::Schema::Loader::Pg;
 
 use strict;
 use base 'DBIx::Class::Schema::Loader::Generic';
-use DBI;
 use Carp;
 
 =head1 NAME
@@ -32,13 +31,13 @@ sub _db_classes {
 }
 
 sub _tables {
-    my $self = shift;
-    my $dbh = $self->{_storage}->dbh;
+    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, $self->{_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;
@@ -46,14 +45,14 @@ sub _tables {
 }
 
 sub _table_info {
-    my ( $self, $table ) = @_;
-    my $dbh = $self->{_storage}->dbh;
+    my ( $class, $table ) = @_;
+    my $dbh = $class->storage->dbh;
 
-    my $sth = $dbh->column_info(undef, $self->{_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, $self->{_db_schema}, $table);
+    my @primary = $dbh->primary_key(undef, $class->loader_data->{_db_schema}, $table);
 
     s/"//g for @primary;
 
index 70859dd..6f8fa4f 100644 (file)
@@ -1,9 +1,8 @@
 package DBIx::Class::Schema::Loader::SQLite;
 
 use strict;
-use base 'DBIx::Class::Schema::Loader::Generic';
+use base qw/DBIx::Class::Schema::Loader::Generic/;
 use Text::Balanced qw( extract_bracketed );
-use DBI;
 use Carp;
 
 =head1 NAME
@@ -31,10 +30,10 @@ sub _db_classes {
 }
 
 sub _relationships {
-    my $self = shift;
-    foreach my $table ( $self->tables ) {
+    my $class = shift;
+    foreach my $table ( $class->tables ) {
 
-        my $dbh = $self->{_storage}->dbh;
+        my $dbh = $class->storage->dbh;
         my $sth = $dbh->prepare(<<"");
 SELECT sql FROM sqlite_master WHERE tbl_name = ?
 
@@ -80,18 +79,18 @@ SELECT sql FROM sqlite_master WHERE tbl_name = ?
             if ( $col =~ /^(\w+).*REFERENCES\s+(\w+)\s*(\w+)?/i ) {
                 chomp $col;
                 warn qq/\# Found foreign key definition "$col"\n\n/
-                  if $self->debug;
-                eval { $self->_belongs_to_many( $table, $1, $2, $3 ) };
+                  if $class->debug;
+                eval { $class->_belongs_to_many( $table, $1, $2, $3 ) };
                 warn qq/\# belongs_to_many failed "$@"\n\n/
-                  if $@ && $self->debug;
+                  if $@ && $class->debug;
             }
         }
     }
 }
 
 sub _tables {
-    my $self = shift;
-    my $dbh = $self->{_storage}->dbh;
+    my $class = shift;
+    my $dbh = $class->storage->dbh;
     my $sth  = $dbh->prepare("SELECT * FROM sqlite_master");
     $sth->execute;
     my @tables;
@@ -103,10 +102,10 @@ sub _tables {
 }
 
 sub _table_info {
-    my ( $self, $table ) = @_;
+    my ( $class, $table ) = @_;
 
     # find all columns.
-    my $dbh = $self->{_storage}->dbh;
+    my $dbh = $class->storage->dbh;
     my $sth = $dbh->prepare("PRAGMA table_info('$table')");
     $sth->execute();
     my @columns;
index d065764..9c045ba 100644 (file)
@@ -2,7 +2,6 @@ package DBIx::Class::Schema::Loader::mysql;
 
 use strict;
 use base 'DBIx::Class::Schema::Loader::Generic';
-use DBI;
 use Carp;
 
 =head1 NAME
@@ -33,10 +32,10 @@ sub _db_classes {
 
 # Very experimental and untested!
 sub _relationships {
-    my $self   = shift;
-    my @tables = $self->tables;
-    my $dbh    = $self->{_storage}->dbh;
-    my $dsn    = $self->{_datasource}[0];
+    my $class   = shift;
+    my @tables = $class->tables;
+    my $dbh    = $class->storage->dbh;
+    my $dsn    = $class->loader_data->{_datasource}[0];
     my %conn   =
       $dsn =~ m/\Adbi:\w+(?:\(.*?\))?:(.+)\z/i
       && index( $1, '=' ) >= 0
@@ -59,8 +58,8 @@ sub _relationships {
             my $remote_table = shift @cols;
             my $remote_column = shift @cols;
             
-            eval { $self->_belongs_to_many( $table, $column, $remote_table, $remote_column) };
-            warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $self->debug;
+            eval { $class->_belongs_to_many( $table, $column, $remote_table, $remote_column) };
+            warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $class->debug;
         }
         
         $sth->finish;
@@ -68,8 +67,8 @@ sub _relationships {
 }
 
 sub _tables {
-    my $self = shift;
-    my $dbh    = $self->{_storage}->dbh;
+    my $class = shift;
+    my $dbh    = $class->storage->dbh;
     my @tables;
     foreach my $table ( $dbh->tables ) {
         my $quoter = $dbh->get_info(29);
@@ -81,8 +80,8 @@ sub _tables {
 }
 
 sub _table_info {
-    my ( $self, $table ) = @_;
-    my $dbh    = $self->{_storage}->dbh;
+    my ( $class, $table ) = @_;
+    my $dbh    = $class->storage->dbh;
 
     # MySQL 4.x doesn't support quoted tables
     my $query = "DESCRIBE $table";
index e92496e..2135175 100644 (file)
@@ -36,7 +36,7 @@ sub skip_tests {
 sub run_tests {
     my $self = shift;
 
-    plan tests => 26;
+    plan tests => 27;
 
     $self->create();
 
@@ -44,21 +44,29 @@ sub run_tests {
 
     my $debug = ($self->{verbose} > 1) ? 1 : 0;
 
-    my $loader = DBIx::Class::Schema::Loader->new(
-         dsn           => $self->{dsn},
-         user          => $self->{user},
-         password      => $self->{password},
-         namespace     => $namespace,
-         constraint    => '^loader_test.*',
-         relationships => 1,
-         debug         => $debug,
-    );
+    my $schema_pkg = "$namespace\::Schema";
+
+    eval qq{
+        package $schema_pkg;
+       use base qw/DBIx::Class::Schema::Loader/;
+
+        __PACKAGE__->load_from_connection(
+            dsn           => "$self->{dsn}",
+            user          => "$self->{user}",
+            password      => "$self->{password}",
+            namespace     => "$namespace",
+            constraint    => '^loader_test.*',
+            relationships => 1,
+            debug         => "$debug",
+        );
+    };
+    ok(!$@, "Loader initialization failed: $@");
 
-    my $conn = $loader->connect();
+    my $conn = $schema_pkg->connect($self->{dsn},$self->{user},$self->{passwd});
 
-    my $moniker1 = $loader->moniker('loader_test1');
+    my $moniker1 = $conn->moniker('loader_test1');
     my $rsobj1 = $conn->resultset($moniker1);
-    my $moniker2 = $loader->moniker('loader_test2');
+    my $moniker2 = $conn->moniker('loader_test2');
     my $rsobj2 = $conn->resultset($moniker2);
 
     isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
@@ -75,19 +83,19 @@ sub run_tests {
     SKIP: {
         skip $self->{skip_rels}, 20 if $self->{skip_rels};
 
-        my $moniker3 = $loader->moniker('loader_test3');
+        my $moniker3 = $conn->moniker('loader_test3');
         my $rsobj3 = $conn->resultset($moniker3);
-        my $moniker4 = $loader->moniker('loader_test4');
+        my $moniker4 = $conn->moniker('loader_test4');
         my $rsobj4 = $conn->resultset($moniker4);
-        my $moniker5 = $loader->moniker('loader_test5');
+        my $moniker5 = $conn->moniker('loader_test5');
         my $rsobj5 = $conn->resultset($moniker5);
-        my $moniker6 = $loader->moniker('loader_test6');
+        my $moniker6 = $conn->moniker('loader_test6');
         my $rsobj6 = $conn->resultset($moniker6);
-        my $moniker7 = $loader->moniker('loader_test7');
+        my $moniker7 = $conn->moniker('loader_test7');
         my $rsobj7 = $conn->resultset($moniker7);
-        my $moniker8 = $loader->moniker('loader_test8');
+        my $moniker8 = $conn->moniker('loader_test8');
         my $rsobj8 = $conn->resultset($moniker8);
-        my $moniker9 = $loader->moniker('loader_test9');
+        my $moniker9 = $conn->moniker('loader_test9');
         my $rsobj9 = $conn->resultset($moniker9);
 
         isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
@@ -125,9 +133,9 @@ sub run_tests {
                 skip 'SQLite cannot do the advanced tests', 8;
             }
 
-            my $moniker10 = $loader->moniker('loader_test10');
+            my $moniker10 = $conn->moniker('loader_test10');
             my $rsobj10 = $conn->resultset($moniker10);
-            my $moniker11 = $loader->moniker('loader_test11');
+            my $moniker11 = $conn->moniker('loader_test11');
             my $rsobj11 = $conn->resultset($moniker11);
 
             isa_ok( $rsobj10, "DBIx::Class::ResultSet" );