From: Brandon Black Date: Sat, 21 Jan 2006 21:44:51 +0000 (+0000) Subject: existing Loader patchwork for Schema support, module not fully renamed yet X-Git-Tag: 0.03000~53 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=af6c266584e3842998e4c2af0c15d82a089238f4;p=dbsrgits%2FDBIx-Class-Schema-Loader.git existing Loader patchwork for Schema support, module not fully renamed yet --- diff --git a/Changes b/Changes index bfd802e..8776746 100644 --- a/Changes +++ b/Changes @@ -1,58 +1,4 @@ -Revision history for Perl extension DBIx::Class::Loader +Revision history for Perl extension DBIx::Class::Schema::Loader -0.14 Sat Jan 21 00:05:11 2006 - - Bugfix to pgsql tests - - Bugfix for pause/cpan module version parsing - -0.13 Thu Jan 19 06:40:11 2006 - - Test suite infrastructure overhauled - - New advanced relationship testing [chisel] - - Several relationship fixes - - some minor pod cleanup - - misc bugfixes - -0.12 Fri Jan 13 06:09:04 2006 - - Changed "comment" to "Comment" for mysql "SHOW TABLE STATUS" - - Added relationship tests for pg, mysql, and db2 - -0.11 Mon Jan 02 17:25:14 2006 - - use UNIVERSAL::require for loading the implementation class [Jason Kohles] - - docs fixes [Jason Kohles] - - fixed http://rt.cpan.org/NoAuth/Bug.html?id=16100 (implicit disconnects) [blblack] - - carp rather than croak if a table has no PKs [blblack] - - Added test for DB2 [blblack] - -0.10 Tue Dec 20 06:22:23 2005 - - Fixed foreign key relationships to columns other than primary keys [blblack] - - Fixed mysql test script [blblack] - - Some schema support added [castaway] - - DB2 support added [castaway] - -0.09 Mon Nov 07 18:00:00 2005 - - Updated mysql loader - -0.08 Mon Nov 07 18:00:00 2005 - - Fixed Pg loader - -0.07 Mon Nov 07 18:00:00 2005 - - Fixed mysql loader - -0.06 Thu Nov 03 18:00:00 2005 - - Fixed the _croak bug - -0.05 Wed Nov 02 18:00:00 2005 - - Fixed dump output - -0.04 Wed Nov 02 18:00:00 2005 - - Fixed Pg loader - -0.03 Wed Nov 02 18:00:00 2005 - - new version number :P - -0.02 Mon Oct 24 18:00:00 2005 - - Added $DBIx::Class::Loader::SCHEMA - - Fixed Pg loader - - Bumped version dependency. - -0.01 Mon Sep 19 00:00:00 2005 - - original version. +0.01 Not released yet.... + - original version, created from DBIx::Class::Loader 0.14 diff --git a/Makefile.PL b/Makefile.PL index bf05841..b3134e4 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,11 +1,11 @@ use ExtUtils::MakeMaker; WriteMakefile( - 'NAME' => 'DBIx::Class::Loader', - 'VERSION_FROM' => 'lib/DBIx/Class/Loader.pm', + 'NAME' => 'DBIx::Class::Schema::Loader', + 'VERSION_FROM' => 'lib/DBIx/Class/Schema/Loader.pm', 'PREREQ_PM' => { Test::More => 0.32, - DBIx::Class => 0.03001, + DBIx::Class => 0.04999_04, DBI => 1.30, Lingua::EN::Inflect => 0, Text::Balanced => 0, diff --git a/lib/DBIx/Class/Loader.pm b/lib/DBIx/Class/Loader.pm index 1f434d4..7c7868e 100644 --- a/lib/DBIx/Class/Loader.pm +++ b/lib/DBIx/Class/Loader.pm @@ -3,7 +3,7 @@ package DBIx::Class::Loader; use strict; use UNIVERSAL::require; -our $VERSION = '0.14'; +our $VERSION = '0.01'; =head1 NAME @@ -27,8 +27,9 @@ DBIx::Class::Loader - Dynamic definition of DBIx::Class sub classes. inflect => { child => 'children' }, debug => 1, ); - my $class = $loader->find_class('film'); # $class => Data::Film - my $obj = $class->find(1); + + my $conn = $loader->get_connection($dsn, $user, $password); # + my $conn = $loader->get_connection(); # uses same dsn as ->new(); use with mod_perl @@ -86,12 +87,21 @@ L documentation. sub new { my ( $class, %args ) = @_; + + foreach (qw/namespace dsn/) { + die qq/Argument $_ is required/ if ! $args{$_}; + } + + $args{namespace} =~ s/(.*)::$/$1/; + my $dsn = $args{dsn}; my ($driver) = $dsn =~ m/^dbi:(\w*?)(?:\((.*?)\))?:/i; $driver = 'SQLite' if $driver eq 'SQLite2'; my $impl = "DBIx::Class::Loader::" . $driver; + $impl->require or die qq/Couldn't require loader class "$impl", "$UNIVERSAL::require::ERROR"/; + return $impl->new(%args); } diff --git a/lib/DBIx/Class/Loader/DB2.pm b/lib/DBIx/Class/Loader/DB2.pm index 0fcb112..8dce7e1 100644 --- a/lib/DBIx/Class/Loader/DB2.pm +++ b/lib/DBIx/Class/Loader/DB2.pm @@ -38,20 +38,19 @@ sub _db_classes { sub _tables { my $self = shift; my %args = @_; - my $schema = uc ($args{schema} || ''); - my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); + my $db_schema = uc ($args{db_schema} || ''); + my $dbh = $self->{_storage}->dbh; # this is split out to avoid version parsing errors... my $is_dbd_db2_gte_114 = ( $DBD::DB2::VERSION >= 1.14 ); my @tables = $is_dbd_db2_gte_114 ? $dbh->tables( { TABLE_SCHEM => '%', TABLE_TYPE => 'TABLE,VIEW' } ) : $dbh->tables; - $dbh->disconnect; # People who use table or schema names that aren't identifiers deserve # what they get. Still, FIXME? s/\"//g for @tables; @tables = grep {!/^SYSIBM\./ and !/^SYSCAT\./ and !/^SYSSTAT\./} @tables; - @tables = grep {/^$schema\./} @tables if($schema); + @tables = grep {/^$db_schema\./} @tables if($db_schema); return @tables; } @@ -59,11 +58,11 @@ sub _table_info { my ( $self, $table ) = @_; # $|=1; # print "_table_info($table)\n"; - my ($schema, $tabname) = split /\./, $table, 2; - # print "Schema: $schema, Table: $tabname\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 = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); + my $dbh = $self->{_storage}->dbh; $dbh->{RaiseError} = 1; my $sth = $dbh->prepare(<<'SQL') or die; @@ -72,7 +71,7 @@ FROM SYSCAT.COLUMNS as c WHERE c.TABSCHEMA = ? and c.TABNAME = ? SQL - $sth->execute($schema, $tabname) or die; + $sth->execute($db_schema, $tabname) or die; my @cols = map { @$_ } @{$sth->fetchall_arrayref}; $sth = $dbh->prepare(<<'SQL') or die; @@ -82,8 +81,7 @@ JOIN SYSCAT.KEYCOLUSE as kcu ON tc.constname = kcu.constname WHERE tc.TABSCHEMA = ? and tc.TABNAME = ? and tc.TYPE = 'P' SQL - $sth->execute($schema, $tabname) or die; - $dbh->disconnect; + $sth->execute($db_schema, $tabname) or die; my @pri = map { @$_ } @{$sth->fetchall_arrayref}; diff --git a/lib/DBIx/Class/Loader/Generic.pm b/lib/DBIx/Class/Loader/Generic.pm index 5a7621e..a1b4744 100644 --- a/lib/DBIx/Class/Loader/Generic.pm +++ b/lib/DBIx/Class/Loader/Generic.pm @@ -5,8 +5,9 @@ use base 'DBIx::Class::Componentised'; use Carp; use Lingua::EN::Inflect; use UNIVERSAL::require; -require DBIx::Class::DB; +use DBIx::Class::Storage::DBI; require DBIx::Class::Core; +require DBIx::Class::Schema; =head1 NAME @@ -106,41 +107,37 @@ sub new { _exclude => $args{exclude}, _relationships => $args{relationships}, _inflect => $args{inflect}, - _schema => $args{schema}, - _dropschema => $args{dropschema}, - CLASSES => {}, + _db_schema => $args{schema}, + _drop_db_schema => $args{dropschema}, + _schema_class => "$args{namespace}\::_schema", + TABLE_CLASSES => {}, + MONIKERS => {}, }, $class; warn qq/\### START DBIx::Class::Loader dump ###\n/ if $self->debug; $self->_load_classes; $self->_relationships if $self->{_relationships}; warn qq/\### END DBIx::Class::Loader dump ###\n/ if $self->debug; + $self->{_storage}->dbh->disconnect; $self; } -=head3 find_class - -Returns a tables class. - - my $class = $loader->find_class($table); - -=cut - -sub find_class { +# The original table class name during Loader, +sub _find_table_class { my ( $self, $table ) = @_; - return $self->{CLASSES}->{$table}; + return $self->{TABLE_CLASSES}->{$table}; } -=head3 classes - -Returns a sorted list of classes. - - my $@classes = $loader->classes; - -=cut +# Returns the moniker for a given table name, +# for use in $conn->resultset($moniker) +sub moniker { + my ( $self, $table ) = @_; + return $self->{MONIKERS}->{$table}; +} -sub classes { +sub connect { my $self = shift; - return sort values %{ $self->{CLASSES} }; + return $self->{_schema_class}->connect(@_) if(@_); + return $self->{_schema_class}->connect(@{$self->{_datasource}}); } =head3 debug @@ -161,7 +158,7 @@ Returns a sorted list of tables. sub tables { my $self = shift; - return sort keys %{ $self->{CLASSES} }; + return sort keys %{ $self->{MONIKERS} }; } # Overload in your driver class @@ -170,8 +167,8 @@ 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_class($table); - my $other_class = $self->find_class($other); + my $table_class = $self->_find_table_class($table); + my $other_class = $self->_find_table_class($other); warn qq/\# Belongs_to relationship\n/ if $self->debug; @@ -218,8 +215,14 @@ sub _belongs_to_many { # Load and setup classes sub _load_classes { my $self = shift; - my @schema = ('schema' => $self->{_schema}) if($self->{_schema}); - my @tables = $self->_tables(@schema); + + 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 @tables = $self->_tables(); my @db_classes = $self->_db_classes(); my $additional = join '', map "use $_;\n", @{ $self->{_additional} }; my $additional_base = join '', map "use base '$_';\n", @@ -228,33 +231,39 @@ sub _load_classes { my $constraint = $self->{_constraint}; my $exclude = $self->{_exclude}; - my $namespace = $self->{_namespace}; - my $dbclass = "$namespace\::_db"; - $self->inject_base( $dbclass, 'DBIx::Class::DB' ); - $dbclass->connection( @{ $self->{_datasource} } ); - foreach my $table (@tables) { next unless $table =~ /$constraint/; next if ( defined $exclude && $table =~ /$exclude/ ); - my ($schema, $tbl) = split /\./, $table; - my $tablename = lc $table; + + my $table = lc $table; + my $table_name_db_schema = $table; + my $table_name_only = $table_name_db_schema; + my ($db_schema, $tbl) = split /\./, $table; if($tbl) { - $tablename = $self->{_dropschema} ? $tbl : lc $table; + $table_name_db_schema = $tbl if $self->{_drop_db_schema}; + $table_name_only = $tbl; } - my $class = $self->_table2class($schema, $tbl); - $self->inject_base( $class, $dbclass, 'DBIx::Class::Core' ); + else { + undef $db_schema; + } + + my $subclass = $self->_table2subclass($db_schema, $table_name_only); + my $class = $namespace . '::' . $subclass; + + $self->inject_base( $class, 'DBIx::Class::Core' ); $_->require for @db_classes; $self->inject_base( $class, $_ ) for @db_classes; - warn qq/\# Initializing table "$table" as "$class"\n/ if $self->debug; - $class->table(lc $tablename); - my ( $cols, $pks ) = $self->_table_info($table); + warn qq/\# Initializing table "$table_name_db_schema" as "$class"\n/ if $self->debug; + $class->table(lc $table_name_db_schema); + + my ( $cols, $pks ) = $self->_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; - $self->{CLASSES}->{lc $tablename} = $class; + my $code = "package $class;\n$additional_base$additional$left_base"; warn qq/$code/ if $self->debug; - warn qq/$class->table('$tablename');\n/ if $self->debug; + warn qq/$class->table('$table_name_db_schema');\n/ if $self->debug; my $columns = join "', '", @$cols; warn qq/$class->add_columns('$columns')\n/ if $self->debug; my $primaries = join "', '", @$pks; @@ -262,14 +271,18 @@ sub _load_classes { eval $code; croak qq/Couldn't load additional classes "$@"/ if $@; unshift @{"$class\::ISA"}, $_ foreach ( @{ $self->{_left_base} } ); + + $schema_class->register_class($subclass, $class); + $self->{TABLE_CLASSES}->{$table_name_db_schema} = $class; + $self->{MONIKERS}->{$table_name_db_schema} = $subclass; } } # Find and setup relationships sub _relationships { my $self = shift; + my $dbh = $self->{_storage}->dbh; foreach my $table ( $self->tables ) { - my $dbh = $self->find_class($table)->storage->dbh; my $quoter = $dbh->get_info(29) || q{"}; if ( my $sth = $dbh->foreign_key_info( '', '', '', '', '', $table ) ) { for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) { @@ -288,19 +301,17 @@ sub _relationships { } } -# Make a class from a table -sub _table2class { - my ( $self, $schema, $table ) = @_; - my $namespace = $self->{_namespace} || ""; - $namespace =~ s/(.*)::$/$1/; - if($table) { - $schema = ucfirst lc $schema; - $namespace .= "::$schema" if(!$self->{_dropschema}); - } else { - $table = $schema; +# Make a subclass (dbix moniker) from a table +sub _table2subclass { + my ( $self, $db_schema, $table ) = @_; + + my $subclass = join '', map ucfirst, split /[\W_]+/, $table; + + if($db_schema && !$self->{_drop_db_schema}) { + $subclass = (ucfirst lc $db_schema) . '-' . $subclass; } - my $subclass = join '', map ucfirst, split /[\W_]+/, lc $table; - my $class = $namespace ? "$namespace\::" . $subclass : $subclass; + + $subclass; } # Overload in driver class diff --git a/lib/DBIx/Class/Loader/Pg.pm b/lib/DBIx/Class/Loader/Pg.pm index babd80e..a44db20 100644 --- a/lib/DBIx/Class/Loader/Pg.pm +++ b/lib/DBIx/Class/Loader/Pg.pm @@ -5,8 +5,6 @@ use base 'DBIx::Class::Loader::Generic'; use DBI; use Carp; -our $SCHEMA = 'public'; - =head1 NAME DBIx::Class::Loader::Pg - DBIx::Class::Loader Postgres Implementation. @@ -37,30 +35,27 @@ sub _db_classes { sub _tables { my $self = shift; - my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); + my $dbh = $self->{_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, $SCHEMA, "", "table", { noprefix => 1, pg_noprefix => 1 } ) + $dbh->tables( undef, $self->{_db_schema}, "", "table", { noprefix => 1, pg_noprefix => 1 } ) : $dbh->tables; - $dbh->disconnect; s/"//g for @tables; return @tables; } sub _table_info { my ( $self, $table ) = @_; - my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); + my $dbh = $self->{_storage}->dbh; - my $sth = $dbh->column_info(undef, $SCHEMA, $table, undef); + my $sth = $dbh->column_info(undef, $self->{_db_schema}, $table, undef); my @cols = map { $_->[3] } @{ $sth->fetchall_arrayref }; s/"//g for @cols; - my @primary = $dbh->primary_key(undef, $SCHEMA, $table); - - $dbh->disconnect; + my @primary = $dbh->primary_key(undef, $self->{_db_schema}, $table); s/"//g for @primary; diff --git a/lib/DBIx/Class/Loader/SQLite.pm b/lib/DBIx/Class/Loader/SQLite.pm index 466253f..61be9ab 100644 --- a/lib/DBIx/Class/Loader/SQLite.pm +++ b/lib/DBIx/Class/Loader/SQLite.pm @@ -36,7 +36,7 @@ sub _relationships { my $self = shift; foreach my $table ( $self->tables ) { - my $dbh = $self->find_class($table)->storage->dbh; + my $dbh = $self->{_storage}->dbh; my $sth = $dbh->prepare(<<""); SELECT sql FROM sqlite_master WHERE tbl_name = ? @@ -93,7 +93,7 @@ SELECT sql FROM sqlite_master WHERE tbl_name = ? sub _tables { my $self = shift; - my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); + my $dbh = $self->{_storage}->dbh; my $sth = $dbh->prepare("SELECT * FROM sqlite_master"); $sth->execute; my @tables; @@ -101,7 +101,6 @@ sub _tables { next unless lc( $row->{type} ) eq 'table'; push @tables, $row->{tbl_name}; } - $dbh->disconnect; return @tables; } @@ -109,7 +108,7 @@ sub _table_info { my ( $self, $table ) = @_; # find all columns. - my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); + my $dbh = $self->{_storage}->dbh; my $sth = $dbh->prepare("PRAGMA table_info('$table')"); $sth->execute(); my @columns; @@ -125,7 +124,6 @@ SQL $sth->execute($table); my ($sql) = $sth->fetchrow_array; $sth->finish; - $dbh->disconnect; my ($primary) = $sql =~ m/ (?:\(|\,) # either a ( to start the definition or a , for next \s* # maybe some whitespace diff --git a/lib/DBIx/Class/Loader/Writing.pm b/lib/DBIx/Class/Loader/Writing.pm index 7d1a10f..5fd54f3 100644 --- a/lib/DBIx/Class/Loader/Writing.pm +++ b/lib/DBIx/Class/Loader/Writing.pm @@ -26,8 +26,7 @@ DBIx::Class::Loader::Writing - Loader subclass writing guide sub _tables { my $self = shift; - my $dbh = DBI->connect( @{ $self->{_datasource} } ) - or croak($DBI::errstr); + my $dbh = $self->{_storage}->dbh; return $dbh->tables; # Your DBD may need something different } diff --git a/lib/DBIx/Class/Loader/mysql.pm b/lib/DBIx/Class/Loader/mysql.pm index 23e90f8..c59e82a 100644 --- a/lib/DBIx/Class/Loader/mysql.pm +++ b/lib/DBIx/Class/Loader/mysql.pm @@ -37,7 +37,7 @@ sub _db_classes { sub _relationships { my $self = shift; my @tables = $self->tables; - my $dbh = $self->find_class( $tables[0] )->storage->dbh; + my $dbh = $self->{_storage}->dbh; my $dsn = $self->{_datasource}[0]; my %conn = $dsn =~ m/\Adbi:\w+(?:\(.*?\))?:(.+)\z/i @@ -71,7 +71,7 @@ sub _relationships { sub _tables { my $self = shift; - my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); + my $dbh = $self->{_storage}->dbh; my @tables; foreach my $table ( $dbh->tables ) { my $quoter = $dbh->get_info(29); @@ -79,13 +79,12 @@ sub _tables { push @tables, $1 if $table =~ /\A(\w+)\z/; } - $dbh->disconnect; return @tables; } sub _table_info { my ( $self, $table ) = @_; - my $dbh = DBI->connect( @{ $self->{_datasource} } ) or croak($DBI::errstr); + my $dbh = $self->{_storage}->dbh; # MySQL 4.x doesn't support quoted tables my $query = "DESCRIBE $table"; @@ -98,7 +97,6 @@ sub _table_info { push @pri, $col if $hash->{Key} eq "PRI"; } - $dbh->disconnect; return ( \@cols, \@pri ); } diff --git a/t/dbixcl_common_tests.pm b/t/dbixcl_common_tests.pm index 57c1256..21c4d50 100644 --- a/t/dbixcl_common_tests.pm +++ b/t/dbixcl_common_tests.pm @@ -21,6 +21,8 @@ sub new { # Only MySQL uses this $self->{innodb} ||= ''; + + $self->{verbose} = $ENV{TEST_VERBOSE} || 0; return bless $self => $class; } @@ -40,6 +42,8 @@ sub run_tests { my $namespace = 'DBIXCL_Test_' . $self->{vendor}; + my $debug = ($self->{verbose} > 1) ? 1 : 0; + my $loader = DBIx::Class::Loader->new( dsn => $self->{dsn}, user => $self->{user}, @@ -47,52 +51,64 @@ sub run_tests { namespace => $namespace, constraint => '^loader_test.*', relationships => 1, + debug => $debug, ); - my $class1 = $loader->find_class("loader_test1"); - my $class2 = $loader->find_class("loader_test2"); + my $conn = $loader->connect(); + + my $moniker1 = $loader->moniker('loader_test1'); + my $rsobj1 = $conn->resultset($moniker1); + my $moniker2 = $loader->moniker('loader_test2'); + my $rsobj2 = $conn->resultset($moniker2); - is( $class1, "${namespace}::LoaderTest1" ); - is( $class2, "${namespace}::LoaderTest2" ); + isa_ok( $rsobj1, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj2, "DBIx::Class::ResultSet" ); - my $obj = $class1->find(1); + my $obj = $rsobj1->find(1); is( $obj->id, 1 ); is( $obj->dat, "foo" ); - is( $class2->count, 4 ); + is( $rsobj2->count, 4 ); - my ($obj2) = $class2->find( dat => 'bbb' ); + my ($obj2) = $rsobj2->find( dat => 'bbb' ); is( $obj2->id, 2 ); SKIP: { skip $self->{skip_rels}, 20 if $self->{skip_rels}; - my $class3 = $loader->find_class("loader_test3"); - my $class4 = $loader->find_class("loader_test4"); - my $class5 = $loader->find_class("loader_test5"); - my $class6 = $loader->find_class("loader_test6"); - my $class7 = $loader->find_class("loader_test7"); - my $class8 = $loader->find_class("loader_test8"); - my $class9 = $loader->find_class("loader_test9"); - - is( $class3, "${namespace}::LoaderTest3" ); - is( $class4, "${namespace}::LoaderTest4" ); - is( $class5, "${namespace}::LoaderTest5" ); - is( $class6, "${namespace}::LoaderTest6" ); - is( $class7, "${namespace}::LoaderTest7" ); - is( $class8, "${namespace}::LoaderTest8" ); - is( $class9, "${namespace}::LoaderTest9" ); + my $moniker3 = $loader->moniker('loader_test3'); + my $rsobj3 = $conn->resultset($moniker3); + my $moniker4 = $loader->moniker('loader_test4'); + my $rsobj4 = $conn->resultset($moniker4); + my $moniker5 = $loader->moniker('loader_test5'); + my $rsobj5 = $conn->resultset($moniker5); + my $moniker6 = $loader->moniker('loader_test6'); + my $rsobj6 = $conn->resultset($moniker6); + my $moniker7 = $loader->moniker('loader_test7'); + my $rsobj7 = $conn->resultset($moniker7); + my $moniker8 = $loader->moniker('loader_test8'); + my $rsobj8 = $conn->resultset($moniker8); + my $moniker9 = $loader->moniker('loader_test9'); + my $rsobj9 = $conn->resultset($moniker9); + + isa_ok( $rsobj3, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj4, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj5, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj6, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj7, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj8, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj9, "DBIx::Class::ResultSet" ); # basic rel test - my $obj4 = $class4->find(123); - is( ref($obj4->fkid), $class3); + my $obj4 = $rsobj4->find(123); + isa_ok( $obj4->fkid, "$namespace\::$moniker3"); # fk def in comments should not be parsed - my $obj5 = $class5->find( id1 => 1, id2 => 1 ); + my $obj5 = $rsobj5->find( id1 => 1, id2 => 1 ); is( ref( $obj5->id2 ), '' ); - # mulit-col fk def (works halfway for some, not others...) - my $obj6 = $class6->find(1); - isa_ok( $obj6->loader_test2, $class2 ); + # mulit-col fk def (works for some, not others...) + my $obj6 = $rsobj6->find(1); + isa_ok( $obj6->loader_test2, "$namespace\::$moniker2" ); SKIP: { skip "Multi-column FKs are only half-working for this vendor", 1 unless $self->{multi_fk_broken}; @@ -100,8 +116,8 @@ sub run_tests { } # fk that references a non-pk key (UNIQUE) - my $obj8 = $class8->find(1); - isa_ok( $obj8->loader_test7, $class7 ); + my $obj8 = $rsobj8->find(1); + isa_ok( $obj8->loader_test7, "$namespace\::$moniker7" ); # from Chisel's tests... SKIP: { @@ -109,18 +125,20 @@ sub run_tests { skip 'SQLite cannot do the advanced tests', 8; } - my $class10 = $loader->find_class('loader_test10'); - my $class11 = $loader->find_class('loader_test11'); + my $moniker10 = $loader->moniker('loader_test10'); + my $rsobj10 = $conn->resultset($moniker10); + my $moniker11 = $loader->moniker('loader_test11'); + my $rsobj11 = $conn->resultset($moniker11); - is( $class10, "${namespace}::LoaderTest10" ); - is( $class11, "${namespace}::LoaderTest11" ); + isa_ok( $rsobj10, "DBIx::Class::ResultSet" ); + isa_ok( $rsobj11, "DBIx::Class::ResultSet" ); - my $obj10 = $class10->create({ subject => 'xyzzy' }); + my $obj10 = $rsobj10->create({ subject => 'xyzzy' }); $obj10->update(); ok( defined $obj10, '$obj10 is defined' ); - my $obj11 = $class11->create({ loader_test10 => $obj10->id() }); + my $obj11 = $rsobj11->create({ loader_test10 => $obj10->id() }); $obj11->update(); ok( defined $obj11, '$obj11 is defined' ); @@ -135,29 +153,16 @@ sub run_tests { skip 'Previous eval block failed', 3 unless ($@ eq ''); - my $results = $class10->search({ subject => 'xyzzy' }); + my $results = $rsobj10->search({ subject => 'xyzzy' }); is( $results->count(), 1, - 'One $class10 returned from search' ); + 'One $rsobj10 returned from search' ); my $obj10_3 = $results->first(); - isa_ok( $obj10_3, $class10 ); + isa_ok( $obj10_3, "$namespace\::$moniker10" ); is( $obj10_3->loader_test11()->id(), $obj11->id(), - 'found same $class11 object we expected' ); - } - - for ( $class10, $class11 ) { - $_->storage->dbh->disconnect; + 'found same $rsobj11 object we expected' ); } } - - for ( $class3, $class4, $class5, $class6, $class7, - $class8, $class9 ) { - $_->storage->dbh->disconnect; - } - } - - for ( $class1, $class2 ) { - $_->storage->dbh->disconnect; } }