Reminders to myself or whoever else ever looks in here...
-SQLite needs some heavy refactoring, the subroutines are becoming to complex to understand easily.
+SQLite needs some heavy refactoring, the subroutines are becoming too complex to understand easily.
MySQL needs implicit FK support, I think.
-the base/use injection stuff needs error checking/reporting
+the base/use injection stuff needs error checking/reporting, and some testing
-The whole things needs to be refactored so that we don't pollute Schema's namespace.
-
- - Currently, the user's schema class ISA Schema::Loader ISA Schema::Loader::VENDOR ISA Schema::Loader::Generic ISA Schema, which means all of our methods and accessors in those classes end up in the final user "Schema" class. The current hack to minimize that is that all the names are prefixed with "_loader" to avoid clashes.
- - Ideally, user schema class ISA Schema::Loader, and that's it. Schema::Loader only implements the methods that we need to export to the Schema class for later user (load_from_connection, tables, moniker). Schema::Loader::VENDOR ISA Schema::Loader::Generic, but they have a new() routine and instantiate an object which does the Loading. Schema::Loader passes them the its own class name (the user schema class) so that they know what namespace to target the loading operations at.
-
-After all that, consider:
+Consider:
If local column is UNIQUE or PK, use has_one() for relation?
Re-scan relations/tables after initial relation setup to find ->many_to_many() relations to be set up?
Check NULLability of columns involved in the relationship, which might suggest a more optimal non-default -join-type?
use strict;
use warnings;
use Carp;
-
-use vars qw($VERSION @ISA);
use UNIVERSAL::require;
+use vars qw($VERSION);
+
# 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';
+use base qw/DBIx::Class::Schema/;
+
+__PACKAGE__->mk_classaccessor('loader');
+
=head1 NAME
DBIx::Class::Schema::Loader - Dynamic definition of a DBIx::Class::Schema
my $schema1 = "My::Schema";
# ^^ defaults to dsn/user/pass from load_from_connection()
+ # Get a list of the original (database) names of the tables that
+ # were loaded
+ my @tables = $schema1->loader->tables;
+
+ # Get a hashref of table_name => 'TableName' table-to-moniker
+ # mappings.
+ my $monikers = $schema1->loader->monikers;
+
+ # Get a hashref of table_name => 'My::Schema::TableName'
+ # table-to-classname mappings.
+ my $classes = $schema1->loader->classes;
+
+ # Use the schema as per normal for L<DBIx::Class::Schema>
+ my $rs = $schema1->resultset($monikers->{table_table})->search(...);
+
=head1 DESCRIPTION
DBIx::Class::Schema::Loader automates the definition of a
my ( $class, %args ) = @_;
croak 'dsn argument is required' if ! $args{dsn};
-
my $dsn = $args{dsn};
my ($driver) = $dsn =~ m/^dbi:(\w*?)(?:\((.*?)\))?:/i;
$driver = 'SQLite' if $driver eq 'SQLite2';
croak qq/Couldn't require loader class "$impl",/ .
qq/"$UNIVERSAL::require::ERROR"/;
- push(@ISA, $impl);
- $class->_load_from_connection(%args);
+ $args{schema} = $class;
+
+ $class->loader($impl->new(%args));
}
=head1 AUTHOR
package DBIx::Class::Schema::Loader::DB2;
use strict;
+use warnings;
use base 'DBIx::Class::Schema::Loader::Generic';
-use Carp;
=head1 NAME
=cut
-sub _loader_db_classes {
+sub _db_classes {
return qw/DBIx::Class::PK::Auto::DB2/;
}
-sub _loader_tables {
- my $class = shift;
+sub _tables {
+ my $self = shift;
my %args = @_;
- my $db_schema = uc $class->_loader_db_schema;
- my $dbh = $class->storage->dbh;
+ my $db_schema = uc $self->db_schema;
+ my $dbh = $self->schema->storage->dbh;
my $quoter = $dbh->get_info(29) || q{"};
# this is split out to avoid version parsing errors...
return @tables;
}
-sub _loader_table_info {
- my ( $class, $table ) = @_;
+sub _table_info {
+ my ( $self, $table ) = @_;
# $|=1;
-# print "_loader_table_info($table)\n";
+# 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 = $class->storage->dbh;
+ my $dbh = $self->schema->storage->dbh;
$dbh->{RaiseError} = 1;
my $sth = $dbh->prepare(<<'SQL') or die;
}
# Find and setup relationships
-sub _loader_relationships {
- my $class = shift;
+sub _load_relationships {
+ my $self = shift;
- my $dbh = $class->storage->dbh;
+ my $dbh = $self->schema->storage->dbh;
my $sth = $dbh->prepare(<<'SQL') or die;
SELECT SR.COLCOUNT, SR.REFTBNAME, SR.PKCOLNAMES, SR.FKCOLNAMES
FROM SYSIBM.SYSRELS SR WHERE SR.TBNAME = ?
SQL
- foreach my $table ( $class->tables ) {
+ foreach my $table ( $self->tables ) {
next if ! $sth->execute(uc $table);
while(my $res = $sth->fetchrow_arrayref()) {
my ($colcount, $other, $other_column, $column) =
$cond{$other_cols[$i]} = $self_cols[$i];
}
- eval { $class->_loader_make_cond_rel ($table, $other, \%cond); };
+ eval { $self->_make_cond_rel ($table, $other, \%cond); };
warn qq/\# belongs_to_many failed "$@"\n\n/
- if $@ && $class->_loader_debug;
+ if $@ && $self->debug;
}
}
use strict;
use warnings;
-use base qw/DBIx::Class::Schema/;
-
use Carp;
use Lingua::EN::Inflect;
+use base qw/Class::Accessor::Fast/;
require DBIx::Class::Core;
-__PACKAGE__->mk_classaccessor('_loader_inflect');
-__PACKAGE__->mk_classaccessor('_loader_db_schema');
-__PACKAGE__->mk_classaccessor('_loader_drop_db_schema');
-__PACKAGE__->mk_classaccessor('_loader_classes' => {} );
-__PACKAGE__->mk_classaccessor('_loader_monikers' => {} );
-__PACKAGE__->mk_classaccessor('_loader_debug' => 0);
+# The first group are all arguments which are may be defaulted within,
+# The last two (classes, monikers) are generated locally:
+
+__PACKAGE__->mk_ro_accessors(qw/
+ schema
+ dsn
+ user
+ password
+ options
+ exclude
+ constraint
+ additional_classes
+ additional_base_classes
+ left_base_classes
+ relationships
+ inflect
+ db_schema
+ drop_db_schema
+ debug
+
+ classes
+ monikers
+ /);
=head1 NAME
=head3 new
-Not intended to be called directly. This is used internally by the
-C<new()> method in L<DBIx::Class::Schema::Loader>.
+Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
+by L<DBIx::Class::Schema::Loader>.
=cut
-sub _load_from_connection {
- my ( $class, %args ) = @_;
-
- $class->_loader_debug(1) if $args{debug};
- $class->_loader_inflect($args{inflect});
- $class->_loader_db_schema($args{db_schema} || '');
- $class->_loader_drop_db_schema($args{drop_db_schema});
-
- 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';
-
- my %load_classes_args = (
- additional => $additional,
- additional_base => $additional_base,
- left_base => $left_base,
- constraint => $args{constraint} || '.*',
- exclude => $args{exclude},
- );
-
- $class->connection($args{dsn}, $args{user},
- $args{password}, $args{options});
+# ensure that a peice of object data is a valid arrayref, creating
+# an empty one or encapsulating whatever's there.
+sub _ensure_arrayref {
+ my $self = shift;
- warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
- if $class->_loader_debug;
-
- $class->_loader_load_classes(%load_classes_args);
- $class->_loader_relationships if $args{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;
+ foreach (@_) {
+ $self->{$_} ||= [];
+ $self->{$_} = [ $self->{$_} ]
+ unless ref $self->{$_} eq 'ARRAY';
+ }
}
-# The original table class name during Loader,
-sub _loader_find_table_class {
- my ( $class, $table ) = @_;
- return $class->_loader_classes->{$table};
-}
+sub new {
+ my ( $class, %args ) = @_;
-# Returns the moniker for a given table name,
-# for use in $conn->resultset($moniker)
+ my $self = { %args };
-=head3 moniker
+ bless $self => $class;
-Returns the moniker for a given literal table name. Used
-as $schema->resultset($moniker), etc.
+ $self->{db_schema} ||= '';
+ $self->{constraint} ||= '.*';
+ $self->{inflect} ||= {};
+ $self->_ensure_arrayref(qw/additional_classes
+ additional_base_classes
+ left_base_classes/);
-=cut
-sub moniker {
- my ( $class, $table ) = @_;
- return $class->_loader_monikers->{$table};
-}
+ $self->{monikers} = {};
+ $self->{classes} = {};
-=head3 tables
+ $self->schema->connection($self->dsn, $self->user,
+ $self->password, $self->options);
-Returns a sorted list of tables.
+ warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
+ if $self->debug;
- my @tables = $loader->tables;
+ $self->_load_classes;
+ $self->_load_relationships if $self->relationships;
-=cut
+ warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
+ if $self->debug;
+ $self->schema->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later?
-sub tables {
- my $class = shift;
- return sort keys %{ $class->_loader_monikers };
+ $self;
}
# Overload in your driver class
-sub _loader_db_classes { croak "ABSTRACT METHOD" }
-
-# not a class method.
-sub _loader_stringify_hash {
- my $href = shift;
-
- return '{ ' .
- join(q{, }, map("$_ => $href->{$_}", keys %$href))
- . ' }';
-}
+sub _db_classes { croak "ABSTRACT METHOD" }
# Inflect a relationship name
# XXX (should pluralize, but currently also tends to de-pluralize plurals)
-sub _loader_inflect_relname {
- my ($class, $relname) = @_;
-
- if(my $inflections = $class->_loader_inflect) {
- $relname = $inflections->{$relname}
- if exists $inflections->{$relname};
- }
- else {
- $relname = Lingua::EN::Inflect::PL($relname);
- }
+sub _inflect_relname {
+ my ($self, $relname) = @_;
- return $relname;
+ return $self->inflect->{$relname} if exists $self->inflect->{$relname};
+ return Lingua::EN::Inflect::PL($relname);
}
# Set up a simple relation with just a local col and foreign table
-sub _loader_make_simple_rel {
- my ($class, $table, $other, $col) = @_;
+sub _make_simple_rel {
+ my ($self, $table, $other, $col) = @_;
- my $table_class = $class->_loader_find_table_class($table);
- my $other_class = $class->_loader_find_table_class($other);
- my $table_relname = $class->_loader_inflect_relname(lc $table);
+ my $table_class = $self->classes->{$table};
+ my $other_class = $self->classes->{$other};
+ my $table_relname = $self->_inflect_relname(lc $table);
- warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
+ warn qq/\# Belongs_to relationship\n/ if $self->debug;
warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
- if $class->_loader_debug;
+ if $self->debug;
$table_class->belongs_to( $col => $other_class );
- warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
+ warn qq/\# Has_many relationship\n/ if $self->debug;
warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
. qq/$col);\n\n/
- if $class->_loader_debug;
+ if $self->debug;
$other_class->has_many( $table_relname => $table_class, $col);
}
+# not a class method, just a helper for cond_rel XXX
+sub _stringify_hash {
+ my $href = shift;
+
+ return '{ ' .
+ join(q{, }, map("$_ => $href->{$_}", keys %$href))
+ . ' }';
+}
+
# Set up a complex relation based on a hashref condition
-sub _loader_make_cond_rel {
- my ( $class, $table, $other, $cond ) = @_;
+sub _make_cond_rel {
+ my ( $self, $table, $other, $cond ) = @_;
- my $table_class = $class->_loader_find_table_class($table);
- my $other_class = $class->_loader_find_table_class($other);
- my $table_relname = $class->_loader_inflect_relname(lc $table);
+ my $table_class = $self->classes->{$table};
+ my $other_class = $self->classes->{$other};
+ my $table_relname = $self->_inflect_relname(lc $table);
my $other_relname = lc $other;
# for single-column case, set the relname to the column name,
my $rev_cond = { reverse %$cond };
- my $cond_printable = _loader_stringify_hash($cond)
- if $class->_loader_debug;
- my $rev_cond_printable = _loader_stringify_hash($rev_cond)
- if $class->_loader_debug;
+ my $cond_printable = _stringify_hash($cond)
+ if $self->debug;
+ my $rev_cond_printable = _stringify_hash($rev_cond)
+ if $self->debug;
- warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
+ warn qq/\# Belongs_to relationship\n/ if $self->debug;
warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
. qq/$cond_printable);\n\n/
- if $class->_loader_debug;
+ if $self->debug;
$table_class->belongs_to( $other_relname => $other_class, $cond);
- warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
+ warn qq/\# Has_many relationship\n/ if $self->debug;
warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
. qq/$rev_cond_printable);\n\n/
. qq/);\n\n/
- if $class->_loader_debug;
+ if $self->debug;
$other_class->has_many( $table_relname => $table_class, $rev_cond);
}
# Load and setup classes
-sub _loader_load_classes {
- my ($class, %args) = @_;
-
- my $additional = join '',
- map "use $_;\n", @{$args{additional}};
+sub _load_classes {
+ my $self = shift;
- my @tables = $class->_loader_tables();
- my @db_classes = $class->_loader_db_classes();
+ my @tables = $self->_tables();
+ my @db_classes = $self->_db_classes();
+ my $schema = $self->schema;
foreach my $table (@tables) {
- next unless $table =~ /$args{constraint}/;
- next if defined $args{exclude} && $table =~ /$args{exclude}/;
+ my $constraint = $self->constraint;
+ my $exclude = $self->exclude;
+
+ next unless $table =~ /$constraint/;
+ next if defined $exclude && $table =~ /$exclude/;
my ($db_schema, $tbl) = split /\./, $table;
my $tablename = lc $table;
if($tbl) {
- $tablename = $class->_loader_drop_db_schema ? $tbl : lc $table;
+ $tablename = $self->drop_db_schema ? $tbl : lc $table;
}
- my $lc_tblname = lc $tablename;
+ my $lc_tblname = lc $tablename;
- my $table_moniker = $class->_loader_table2moniker($db_schema, $tbl);
- my $table_class = "$class\::$table_moniker";
+ my $table_moniker = $self->_table2moniker($db_schema, $tbl);
+ my $table_class = $schema . q{::} . $table_moniker;
# XXX all of this needs require/eval error checking
- $class->inject_base( $table_class, 'DBIx::Class::Core' );
+ $schema->inject_base( $table_class, 'DBIx::Class::Core' );
$_->require for @db_classes;
- $class->inject_base( $table_class, $_ ) for @db_classes;
- $class->inject_base( $table_class, $_ ) for @{$args{additional_base}};
- eval "package $table_class;$_;" for @{$args{additional}};
- $class->inject_base( $table_class, $_ ) for @{$args{left_base}};
-
- warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->_loader_debug;
+ $schema->inject_base( $table_class, $_ ) for @db_classes;
+ $schema->inject_base( $table_class, $_ )
+ for @{$self->additional_base_classes};
+ eval "package $table_class; use $_;"
+ for @{$self->additional_classes};
+ $schema->inject_base( $table_class, $_ )
+ for @{$self->left_base_classes};
+
+ warn qq/\# Initializing table "$tablename" as "$table_class"\n/
+ if $self->debug;
$table_class->table($lc_tblname);
- my ( $cols, $pks ) = $class->_loader_table_info($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 $class->_loader_debug;
+ warn qq/$table_class->table('$tablename');\n/ if $self->debug;
my $columns = join "', '", @$cols;
- warn qq/$table_class->add_columns('$columns')\n/ if $class->_loader_debug;
+ 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 $class->_loader_debug && @$pks;
+ warn qq/$table_class->set_primary_key('$primaries')\n/
+ if $self->debug && @$pks;
- $class->register_class($table_moniker, $table_class);
- $class->_loader_classes->{$lc_tblname} = $table_class;
- $class->_loader_monikers->{$lc_tblname} = $table_moniker;
+ $schema->register_class($table_moniker, $table_class);
+ $self->classes->{$lc_tblname} = $table_class;
+ $self->monikers->{$lc_tblname} = $table_moniker;
}
}
+=head3 tables
+
+Returns a sorted list of tables.
+
+ my @tables = $loader->tables;
+
+=cut
+
+sub tables {
+ my $self = shift;
+
+ return sort keys %{ $self->monikers };
+}
+
# Find and setup relationships
-sub _loader_relationships {
- my $class = shift;
- my $dbh = $class->storage->dbh;
+sub _load_relationships {
+ my $self = shift;
+
+ my $dbh = $self->schema->storage->dbh;
my $quoter = $dbh->get_info(29) || q{"};
- foreach my $table ( $class->tables ) {
+ foreach my $table ( $self->tables ) {
my $rels = {};
my $sth = $dbh->foreign_key_info( '',
- $class->_loader_db_schema, '', '', '', $table );
+ $self->db_schema, '', '', '', $table );
next if !$sth;
while(my $raw_rel = $sth->fetchrow_hashref) {
my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
foreach my $relid (keys %$rels) {
my $reltbl = $rels->{$relid}->{tbl};
my $cond = $rels->{$relid}->{cols};
- eval { $class->_loader_make_cond_rel( $table, $reltbl, $cond ) };
+ eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
warn qq/\# belongs_to_many failed "$@"\n\n/
- if $@ && $class->_loader_debug;
+ if $@ && $self->debug;
}
}
}
# Make a moniker from a table
-sub _loader_table2moniker {
- my ( $class, $db_schema, $table ) = @_;
+sub _table2moniker {
+ my ( $self, $db_schema, $table ) = @_;
my $db_schema_ns;
if($table) {
$db_schema = ucfirst lc $db_schema;
- $db_schema_ns = $db_schema if(!$class->_loader_drop_db_schema);
+ $db_schema_ns = $db_schema if(!$self->drop_db_schema);
} else {
$table = $db_schema;
}
}
# Overload in driver class
-sub _loader_tables { croak "ABSTRACT METHOD" }
+sub _tables { croak "ABSTRACT METHOD" }
-sub _loader_table_info { croak "ABSTRACT METHOD" }
+sub _table_info { croak "ABSTRACT METHOD" }
=head1 SEE ALSO
package DBIx::Class::Schema::Loader::Pg;
use strict;
+use warnings;
use base 'DBIx::Class::Schema::Loader::Generic';
-use Carp;
=head1 NAME
=cut
-sub _loader_db_classes {
+sub _db_classes {
return qw/DBIx::Class::PK::Auto::Pg/;
}
-sub _loader_tables {
- my $class = shift;
- my $dbh = $class->storage->dbh;
+sub _tables {
+ my $self = shift;
+ my $dbh = $self->schema->storage->dbh;
my $quoter = $dbh->get_info(29) || q{"};
# 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_db_schema, "",
+ ? $dbh->tables( undef, $self->db_schema, "",
"table", { noprefix => 1, pg_noprefix => 1 } )
: $dbh->tables;
return @tables;
}
-sub _loader_table_info {
- my ( $class, $table ) = @_;
- my $dbh = $class->storage->dbh;
+sub _table_info {
+ my ( $self, $table ) = @_;
+ my $dbh = $self->schema->storage->dbh;
my $quoter = $dbh->get_info(29) || q{"};
- my $sth = $dbh->column_info(undef, $class->_loader_db_schema, $table, undef);
+ my $sth = $dbh->column_info(undef, $self->db_schema, $table, undef);
my @cols = map { $_->[3] } @{ $sth->fetchall_arrayref };
s/$quoter//g for @cols;
- my @primary = $dbh->primary_key(undef, $class->_loader_db_schema, $table);
+ my @primary = $dbh->primary_key(undef, $self->db_schema, $table);
s/$quoter//g for @primary;
package DBIx::Class::Schema::Loader::SQLite;
use strict;
+use warnings;
use base qw/DBIx::Class::Schema::Loader::Generic/;
+
use Text::Balanced qw( extract_bracketed );
-use Carp;
=head1 NAME
=cut
-sub _loader_db_classes {
+sub _db_classes {
return qw/DBIx::Class::PK::Auto::SQLite/;
}
# XXX this really needs a re-factor
-sub _loader_relationships {
- my $class = shift;
- foreach my $table ( $class->tables ) {
+sub _load_relationships {
+ my $self = shift;
+ foreach my $table ( $self->tables ) {
- my $dbh = $class->storage->dbh;
+ my $dbh = $self->schema->storage->dbh;
my $sth = $dbh->prepare(<<"");
SELECT sql FROM sqlite_master WHERE tbl_name = ?
for(my $i = 0 ; $i < @cols; $i++) {
$cond->{$f_cols[$i]} = $cols[$i];
}
- eval { $class->_loader_make_cond_rel( $table, $f_table, $cond ) };
+ eval { $self->_make_cond_rel( $table, $f_table, $cond ) };
}
else {
- eval { $class->_loader_make_simple_rel( $table, $f_table, $cols ) };
+ eval { $self->_make_simple_rel( $table, $f_table, $cols ) };
}
warn qq/\# belongs_to_many failed "$@"\n\n/
- if $@ && $class->_loader_debug;
+ if $@ && $self->debug;
}
}
}
-sub _loader_tables {
- my $class = shift;
- my $dbh = $class->storage->dbh;
+sub _tables {
+ my $self = shift;
+ my $dbh = $self->schema->storage->dbh;
my $sth = $dbh->prepare("SELECT * FROM sqlite_master");
$sth->execute;
my @tables;
return @tables;
}
-sub _loader_table_info {
- my ( $class, $table ) = @_;
+sub _table_info {
+ my ( $self, $table ) = @_;
# find all columns.
- my $dbh = $class->storage->dbh;
+ my $dbh = $self->schema->storage->dbh;
my $sth = $dbh->prepare("PRAGMA table_info('$table')");
$sth->execute();
my @columns;
# THIS IS JUST A TEMPLATE TO GET YOU STARTED.
use strict;
+ use warnings;
use base 'DBIx::Class::Schema::Loader::Generic';
- use Carp;
- sub _loader_db_classes {
+ sub _db_classes {
return qw/DBIx::Class::PK::Auto::Foo/;
# You may want to return more, or less, than this.
}
- sub _loader_tables {
- my $class = shift;
- my $dbh = $class->storage->dbh;
+ sub _tables {
+ my $self = shift;
+ my $dbh = $self->schema->storage->dbh;
return $dbh->tables; # Your DBD may need something different
}
- sub _loader_table_info {
- my ( $class, $table ) = @_;
+ sub _table_info {
+ my ( $self, $table ) = @_;
...
return ( \@cols, \@primary );
}
- sub _loader_relationships {
- my $class = shift;
+ sub _load_relationships {
+ my $self = shift;
...
- $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)
+
+ # make a simple relationship, where $table($column)
+ # references the PK of $f_table:
+ $self->_make_simple_rel($table, $f_table, $column);
+
+ # make a relationship with a complex condition-clause:
+ $self->_make_cond_rel($table, $f_table,
+ { foo => bar, baz => xaa } );
+
...
}
package DBIx::Class::Schema::Loader::mysql;
use strict;
+use warnings;
use base 'DBIx::Class::Schema::Loader::Generic';
-use Carp;
=head1 NAME
=cut
-sub _loader_db_classes {
+sub _db_classes {
return qw/DBIx::Class::PK::Auto::MySQL/;
}
-sub _loader_relationships {
- my $class = shift;
- my @tables = $class->tables;
- my $dbh = $class->storage->dbh;
- my $dsn = $class->storage->connect_info->[0];
+sub _load_relationships {
+ my $self = shift;
+ my @tables = $self->tables;
+ my $dbh = $self->schema->storage->dbh;
+ my $dsn = $self->dsn;
my %conn =
$dsn =~ m/\Adbi:\w+(?:\(.*?\))?:(.+)\z/i
&& index( $1, '=' ) >= 0
$cond->{$f_cols[$i]} = $cols[$i];
}
- eval { $class->_loader_make_cond_rel( $table, $f_table, $cond) };
- warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $class->_loader_debug;
+ eval { $self->_make_cond_rel( $table, $f_table, $cond) };
+ warn qq/\# belongs_to_many failed "$@"\n\n/ if $@ && $self->debug;
}
$sth->finish;
}
}
-sub _loader_tables {
- my $class = shift;
- my $dbh = $class->storage->dbh;
+sub _tables {
+ my $self = shift;
+ my $dbh = $self->schema->storage->dbh;
my @tables;
my $quoter = $dbh->get_info(29) || q{`};
foreach my $table ( $dbh->tables ) {
return @tables;
}
-sub _loader_table_info {
- my ( $class, $table ) = @_;
- my $dbh = $class->storage->dbh;
+sub _table_info {
+ my ( $self, $table ) = @_;
+ my $dbh = $self->schema->storage->dbh;
# MySQL 4.x doesn't support quoted tables
my $query = "DESCRIBE $table";
package dbixcsl_common_tests;
use strict;
+use warnings;
use Test::More;
use DBIx::Class::Schema::Loader;
ok(!$@, "Loader initialization failed: $@");
my $conn = $schema_class->connect($self->{dsn},$self->{user},$self->{password});
+ my $monikers = $schema_class->loader->monikers;
+ my $classes = $schema_class->loader->classes;
- my $moniker1 = $conn->moniker('loader_test1');
- my $rsobj1 = $conn->resultset($moniker1);
- my $moniker2 = $conn->moniker('loader_test2');
- my $rsobj2 = $conn->resultset($moniker2);
+ my $moniker1 = $monikers->{loader_test1};
+ my $class1 = $classes->{loader_test1};
+ my $rsobj1 = $conn->resultset($moniker1);
+
+ my $moniker2 = $monikers->{loader_test2};
+ my $class2 = $classes->{loader_test2};
+ my $rsobj2 = $conn->resultset($moniker2);
isa_ok( $rsobj1, "DBIx::Class::ResultSet" );
isa_ok( $rsobj2, "DBIx::Class::ResultSet" );
SKIP: {
skip $self->{skip_rels}, 25 if $self->{skip_rels};
- my $moniker3 = $conn->moniker('loader_test3');
- my $rsobj3 = $conn->resultset($moniker3);
- my $moniker4 = $conn->moniker('loader_test4');
- my $rsobj4 = $conn->resultset($moniker4);
- my $moniker5 = $conn->moniker('loader_test5');
- my $rsobj5 = $conn->resultset($moniker5);
- my $moniker6 = $conn->moniker('loader_test6');
- my $rsobj6 = $conn->resultset($moniker6);
- my $moniker7 = $conn->moniker('loader_test7');
- my $rsobj7 = $conn->resultset($moniker7);
- my $moniker8 = $conn->moniker('loader_test8');
- my $rsobj8 = $conn->resultset($moniker8);
- my $moniker9 = $conn->moniker('loader_test9');
- my $rsobj9 = $conn->resultset($moniker9);
+ my $moniker3 = $monikers->{loader_test3};
+ my $class3 = $classes->{loader_test3};
+ my $rsobj3 = $conn->resultset($moniker3);
+
+ my $moniker4 = $monikers->{loader_test4};
+ my $class4 = $classes->{loader_test4};
+ my $rsobj4 = $conn->resultset($moniker4);
+
+ my $moniker5 = $monikers->{loader_test5};
+ my $class5 = $classes->{loader_test5};
+ my $rsobj5 = $conn->resultset($moniker5);
+
+ my $moniker6 = $monikers->{loader_test6};
+ my $class6 = $classes->{loader_test6};
+ my $rsobj6 = $conn->resultset($moniker6);
+
+ my $moniker7 = $monikers->{loader_test7};
+ my $class7 = $classes->{loader_test7};
+ my $rsobj7 = $conn->resultset($moniker7);
+
+ my $moniker8 = $monikers->{loader_test8};
+ my $class8 = $classes->{loader_test8};
+ my $rsobj8 = $conn->resultset($moniker8);
+
+ my $moniker9 = $monikers->{loader_test9};
+ my $class9 = $classes->{loader_test9};
+ my $rsobj9 = $conn->resultset($moniker9);
isa_ok( $rsobj3, "DBIx::Class::ResultSet" );
isa_ok( $rsobj4, "DBIx::Class::ResultSet" );
# basic rel test
my $obj4 = $rsobj4->find(123);
- isa_ok( $obj4->fkid, "$schema_class\::$moniker3");
+ isa_ok( $obj4->fkid, $class3);
# fk def in comments should not be parsed
my $obj5 = $rsobj5->find( id1 => 1, id2 => 1 );
# mulit-col fk def
my $obj6 = $rsobj6->find(1);
- isa_ok( $obj6->loader_test2, "$schema_class\::$moniker2");
- isa_ok( $obj6->loader_test5, "$schema_class\::$moniker5");
+ isa_ok( $obj6->loader_test2, $class2);
+ isa_ok( $obj6->loader_test5, $class5);
# fk that references a non-pk key (UNIQUE)
my $obj8 = $rsobj8->find(1);
- isa_ok( $obj8->loader_test7, "$schema_class\::$moniker7");
+ isa_ok( $obj8->loader_test7, $class7);
# from Chisel's tests...
SKIP: {
skip 'SQLite cannot do the advanced tests', 8;
}
- my $moniker10 = $conn->moniker('loader_test10');
- my $rsobj10 = $conn->resultset($moniker10);
- my $moniker11 = $conn->moniker('loader_test11');
- my $rsobj11 = $conn->resultset($moniker11);
+ my $moniker10 = $monikers->{loader_test10};
+ my $class10 = $classes->{loader_test10};
+ my $rsobj10 = $conn->resultset($moniker10);
+
+ my $moniker11 = $monikers->{loader_test11};
+ my $class11 = $classes->{loader_test11};
+ my $rsobj11 = $conn->resultset($moniker11);
isa_ok( $rsobj10, "DBIx::Class::ResultSet" );
isa_ok( $rsobj11, "DBIx::Class::ResultSet" );
'One $rsobj10 returned from search' );
my $obj10_3 = $results->first();
- isa_ok( $obj10_3, "$schema_class\::$moniker10" );
+ isa_ok( $obj10_3, $class10 );
is( $obj10_3->loader_test11()->id(), $obj11->id(),
'found same $rsobj11 object we expected' );
}
skip 'This vendor cannot do inline relationship definitions', 5
if $self->{no_inline_rels};
- my $moniker12 = $conn->moniker('loader_test12');
- my $rsobj12 = $conn->resultset($moniker12);
- my $moniker13 = $conn->moniker('loader_test13');
- my $rsobj13 = $conn->resultset($moniker13);
+ my $moniker12 = $monikers->{loader_test12};
+ my $class12 = $classes->{loader_test12};
+ my $rsobj12 = $conn->resultset($moniker12);
+
+ my $moniker13 = $monikers->{loader_test13};
+ my $class13 = $classes->{loader_test13};
+ my $rsobj13 = $conn->resultset($moniker13);
isa_ok( $rsobj12, "DBIx::Class::ResultSet" );
isa_ok( $rsobj13, "DBIx::Class::ResultSet" );
my $obj13 = $rsobj13->find(1);
- isa_ok( $obj13->id, "$schema_class\::$moniker12" );
- isa_ok( $obj13->loader_test12, "$schema_class\::$moniker12");
- isa_ok( $obj13->dat, "$schema_class\::$moniker12");
+ isa_ok( $obj13->id, $class12 );
+ isa_ok( $obj13->loader_test12, $class12);
+ isa_ok( $obj13->dat, $class12);
}
}
}
projects / dbsrgits/DBIx-Class-Schema-Loader.git / commitdiff