[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Generic.pm

package DBIx::Class::Schema::Loader::Generic;

use strict;
use warnings;
use Class::C3;

use Carp;
use Lingua::EN::Inflect;
use base qw/Class::Accessor::Fast/;

require DBIx::Class::Core;

# 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

DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.

=head1 SYNOPSIS

See L<DBIx::Class::Schema::Loader>

=head1 DESCRIPTION

=head2 OPTIONS

Available constructor options are:

=head3 additional_base_classes

List of additional base classes your table classes will use.

=head3 left_base_classes

List of additional base classes, that need to be leftmost.

=head3 additional_classes

List of additional classes which your table classes will use.

=head3 constraint

Only load tables matching regex.

=head3 exclude

Exclude tables matching regex.

=head3 debug

Enable debug messages.

=head3 dsn

DBI Data Source Name.

=head3 password

Password.

=head3 relationships

Try to automatically detect/setup has_a and has_many relationships.

=head3 inflect

An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
Useful for foreign language column names.

=head3 user

Username.

=head2 METHODS

=cut

=head3 new

Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
by L<DBIx::Class::Schema::Loader>.

=head3 load

Does the actual schema-construction work, used internally by
L<DBIx::Class::Schema::Loader> right after object construction.

=cut

# 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;

    foreach (@_) {
        $self->{$_} ||= [];
        $self->{$_} = [ $self->{$_} ]
            unless ref $self->{$_} eq 'ARRAY';
    }
}

sub new {
    my ( $class, %args ) = @_;

    my $self = { %args };

    bless $self => $class;

    $self->{db_schema}  ||= '';
    $self->{constraint} ||= '.*';
    $self->{inflect}    ||= {};
    $self->_ensure_arrayref(qw/additional_classes
                               additional_base_classes
                               left_base_classes/);

    $self->{monikers} = {};
    $self->{classes} = {};

    $self;
}

sub load {
    my $self = shift;

    $self->schema->connection($self->dsn, $self->user,
                              $self->password, $self->options);

    warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
        if $self->debug;

    $self->_load_classes;
    $self->_load_relationships if $self->relationships;

    warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
        if $self->debug;
    $self->schema->storage->disconnect;

    $self;
}

# Overload in your driver class
sub _db_classes { croak "ABSTRACT METHOD" }

# Inflect a relationship name
#   XXX (should pluralize, but currently also tends to de-pluralize plurals)
sub _inflect_relname {
    my ($self, $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 _make_simple_rel {
    my ($self, $table, $other, $col) = @_;

    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 $self->debug;
    warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
      if $self->debug;
    $table_class->belongs_to( $col => $other_class );

    warn qq/\# Has_many relationship\n/ if $self->debug;
    warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
      .  qq/$col);\n\n/
      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 _make_cond_rel {
    my ( $self, $table, $other, $cond ) = @_;

    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,
    # to make filter accessors work
    if(scalar keys %$cond == 1) {
        my ($col) = keys %$cond;
        $other_relname = $cond->{$col};
    }

    my $rev_cond = { reverse %$cond };

    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 $self->debug;

    warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
      .  qq/$cond_printable);\n\n/
      if $self->debug;

    $table_class->belongs_to( $other_relname => $other_class, $cond);

    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 $self->debug;

    $other_class->has_many( $table_relname => $table_class, $rev_cond);
}

sub _use {
    my $self = shift;
    my $target = shift;

    foreach (@_) {
        $_->require or croak ($_ . "->require: $@");
        eval "package $target; use $_;";
        croak "use $_: $@" if $@;
    }
}

sub _inject {
    my $self = shift;
    my $target = shift;
    my $schema = $self->schema;

    foreach (@_) {
        $_->require or croak ($_ . "->require: $@");
        $schema->inject_base($target, $_);
    }
}

# Load and setup classes
sub _load_classes {
    my $self = shift;

    my @tables     = $self->_tables();
    my @db_classes = $self->_db_classes();
    my $schema     = $self->schema;

    foreach my $table (@tables) {
        my $constraint = $self->constraint;
        my $exclude = $self->exclude;

        next unless $table =~ /$constraint/;
        next if defined $exclude && $table =~ /$exclude/;

        my ($db_schema, $tbl) = split /\./, $table;
        my $tablename = lc $table;
        if($tbl) {
            $tablename = $self->drop_db_schema ? $tbl : lc $table;
        }
        my $lc_tblname = lc $tablename;

        my $table_moniker = $self->_table2moniker($db_schema, $tbl);
        my $table_class = $schema . q{::} . $table_moniker;

        $self->_inject($table_class, 'DBIx::Class::Core');
        $self->_inject($table_class, @db_classes);
        $self->_inject($table_class, @{$self->additional_base_classes});
        $self->_use   ($table_class, @{$self->additional_classes});
        $self->_inject($table_class, @{$self->left_base_classes});

        warn qq/\# Initializing table "$tablename" as "$table_class"\n/
            if $self->debug;
        $table_class->table($lc_tblname);

        my ( $cols, $pks ) = $self->_table_info($table);
        carp("$table has no primary key") unless @$pks;
        $table_class->add_columns(@$cols);
        $table_class->set_primary_key(@$pks) if @$pks;

        warn qq/$table_class->table('$tablename');\n/ if $self->debug;
        my $columns = join "', '", @$cols;
        warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
        my $primaries = join "', '", @$pks;
        warn qq/$table_class->set_primary_key('$primaries')\n/
            if $self->debug && @$pks;

        $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 loaded tables, using the original database table
names.  Actually generated from the keys of the C<monikers> hash below.

    my @tables = $schema->loader->tables;

=head3 monikers

Returns a hashref of loaded table-to-moniker mappings for the original
database table names.

    my $monikers = $schema->loader->monikers;
    my $foo_tbl_moniker = $monikers->{foo_tbl};
    # -or-
    my $foo_tbl_moniker = $schema->loader->monikers->{foo_tbl};
    # $foo_tbl_moniker would look like "FooTbl"

=head3 classes

Returns a hashref of table-to-classname mappings for the original database
table names.  You probably shouldn't be using this for any normal or simple
usage of your Schema.  The usual way to run queries on your tables is via
C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
returned by C<monikers> above.

    my $classes = $schema->loader->classes;
    my $foo_tbl_class = $classes->{foo_tbl};
    # -or-
    my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
    # $foo_tbl_class would look like "My::Schema::FooTbl",
    #   assuming the schema class is "My::Schema"

=cut

sub tables {
    my $self = shift;

    return sort keys %{ $self->monikers };
}

# Find and setup relationships
sub _load_relationships {
    my $self = shift;

    my $dbh = $self->schema->storage->dbh;
    my $quoter = $dbh->get_info(29) || q{"};
    foreach my $table ( $self->tables ) {
        my $rels = {};
        my $sth = $dbh->foreign_key_info( '',
            $self->db_schema, '', '', '', $table );
        next if !$sth;
        while(my $raw_rel = $sth->fetchrow_hashref) {
            my $uk_tbl  = lc $raw_rel->{UK_TABLE_NAME};
            my $uk_col  = lc $raw_rel->{UK_COLUMN_NAME};
            my $fk_col  = lc $raw_rel->{FK_COLUMN_NAME};
            my $relid   = lc $raw_rel->{UK_NAME};
            $uk_tbl =~ s/$quoter//g;
            $uk_col =~ s/$quoter//g;
            $fk_col =~ s/$quoter//g;
            $relid  =~ s/$quoter//g;
            $rels->{$relid}->{tbl} = $uk_tbl;
            $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
        }

        foreach my $relid (keys %$rels) {
            my $reltbl = $rels->{$relid}->{tbl};
            my $cond   = $rels->{$relid}->{cols};
            eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
              warn qq/\# belongs_to_many failed "$@"\n\n/
                if $@ && $self->debug;
        }
    }
}

# Make a moniker from a 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(!$self->drop_db_schema);
    } else {
        $table = $db_schema;
    }

    my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
    $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;

    return $moniker;
}

# Overload in driver class
sub _tables { croak "ABSTRACT METHOD" }

sub _table_info { croak "ABSTRACT METHOD" }

=head1 SEE ALSO

L<DBIx::Class::Schema::Loader>

=cut

1;
Commit	Line	Data
18fca96a	1	package DBIx::Class::Schema::Loader::Generic;
a78e3fed	2
a78e3fed	3	use strict;
a4a19f3c	4	use warnings;
2a4b8262	5	use Class::C3;
a4a19f3c	6
a78e3fed	7	use Carp;
a78e3fed	8	use Lingua::EN::Inflect;
3980d69c	9	use base qw/Class::Accessor::Fast/;
a4a19f3c	10
a78e3fed	11	require DBIx::Class::Core;
a4a19f3c	12
3980d69c	13	# The first group are all arguments which are may be defaulted within,
	14	# The last two (classes, monikers) are generated locally:
	15
	16	__PACKAGE__->mk_ro_accessors(qw/
	17	schema
	18	dsn
	19	user
	20	password
	21	options
	22	exclude
	23	constraint
	24	additional_classes
	25	additional_base_classes
	26	left_base_classes
	27	relationships
	28	inflect
	29	db_schema
	30	drop_db_schema
	31	debug
	32
	33	classes
	34	monikers
	35	/);
a4a19f3c	36
a78e3fed	37	=head1 NAME
a78e3fed	38
18fca96a	39	DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
a78e3fed	40
	41	=head1 SYNOPSIS
	42
18fca96a	43	See L<DBIx::Class::Schema::Loader>
a78e3fed	44
	45	=head1 DESCRIPTION
	46
	47	=head2 OPTIONS
	48
	49	Available constructor options are:
	50
	51	=head3 additional_base_classes
	52
	53	List of additional base classes your table classes will use.
	54
	55	=head3 left_base_classes
	56
	57	List of additional base classes, that need to be leftmost.
	58
	59	=head3 additional_classes
	60
	61	List of additional classes which your table classes will use.
	62
	63	=head3 constraint
	64
	65	Only load tables matching regex.
	66
	67	=head3 exclude
	68
	69	Exclude tables matching regex.
	70
	71	=head3 debug
	72
	73	Enable debug messages.
	74
	75	=head3 dsn
	76
	77	DBI Data Source Name.
	78
a78e3fed	79	=head3 password
	80
	81	Password.
	82
	83	=head3 relationships
	84
	85	Try to automatically detect/setup has_a and has_many relationships.
	86
	87	=head3 inflect
	88
	89	An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
	90	Useful for foreign language column names.
	91
	92	=head3 user
	93
	94	Username.
	95
	96	=head2 METHODS
	97
	98	=cut
	99
	100	=head3 new
	101
3980d69c	102	Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
3980d69c	103	by L<DBIx::Class::Schema::Loader>.
a78e3fed	104
2a4b8262	105	=head3 load
	106
	107	Does the actual schema-construction work, used internally by
	108	L<DBIx::Class::Schema::Loader> right after object construction.
	109
a78e3fed	110	=cut
a78e3fed	111
3980d69c	112	# ensure that a peice of object data is a valid arrayref, creating
	113	# an empty one or encapsulating whatever's there.
	114	sub _ensure_arrayref {
	115	my $self = shift;
e26a4023	116
3980d69c	117	foreach (@_) {
	118	$self->{$_} \|\|= [];
	119	$self->{$_} = [ $self->{$_} ]
	120	unless ref $self->{$_} eq 'ARRAY';
	121	}
a78e3fed	122	}
a78e3fed	123
3980d69c	124	sub new {
3980d69c	125	my ( $class, %args ) = @_;
a78e3fed	126
3980d69c	127	my $self = { %args };
fbd83464	128
3980d69c	129	bless $self => $class;
fbd83464	130
3980d69c	131	$self->{db_schema} \|\|= '';
	132	$self->{constraint} \|\|= '.*';
	133	$self->{inflect} \|\|= {};
	134	$self->_ensure_arrayref(qw/additional_classes
	135	additional_base_classes
	136	left_base_classes/);
fbd83464	137
3980d69c	138	$self->{monikers} = {};
3980d69c	139	$self->{classes} = {};
a78e3fed	140
2a4b8262	141	$self;
	142	}
	143
	144	sub load {
	145	my $self = shift;
	146
3980d69c	147	$self->schema->connection($self->dsn, $self->user,
3980d69c	148	$self->password, $self->options);
a78e3fed	149
3980d69c	150	warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
3980d69c	151	if $self->debug;
a78e3fed	152
3980d69c	153	$self->_load_classes;
3980d69c	154	$self->_load_relationships if $self->relationships;
a78e3fed	155
3980d69c	156	warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
3980d69c	157	if $self->debug;
52bf3f26	158	$self->schema->storage->disconnect;
a78e3fed	159
3980d69c	160	$self;
a78e3fed	161	}
	162
	163	# Overload in your driver class
3980d69c	164	sub _db_classes { croak "ABSTRACT METHOD" }
66742793	165
16f6b6ac	166	# Inflect a relationship name
16f6b6ac	167	# XXX (should pluralize, but currently also tends to de-pluralize plurals)
3980d69c	168	sub _inflect_relname {
3980d69c	169	my ($self, $relname) = @_;
708c0939	170
3980d69c	171	return $self->inflect->{$relname} if exists $self->inflect->{$relname};
3980d69c	172	return Lingua::EN::Inflect::PL($relname);
16f6b6ac	173	}
a78e3fed	174
16f6b6ac	175	# Set up a simple relation with just a local col and foreign table
3980d69c	176	sub _make_simple_rel {
3980d69c	177	my ($self, $table, $other, $col) = @_;
708c0939	178
3980d69c	179	my $table_class = $self->classes->{$table};
	180	my $other_class = $self->classes->{$other};
	181	my $table_relname = $self->_inflect_relname(lc $table);
66742793	182
3980d69c	183	warn qq/\# Belongs_to relationship\n/ if $self->debug;
16f6b6ac	184	warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
3980d69c	185	if $self->debug;
16f6b6ac	186	$table_class->belongs_to( $col => $other_class );
708c0939	187
3980d69c	188	warn qq/\# Has_many relationship\n/ if $self->debug;
16f6b6ac	189	warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
16f6b6ac	190	. qq/$col);\n\n/
3980d69c	191	if $self->debug;
708c0939	192
16f6b6ac	193	$other_class->has_many( $table_relname => $table_class, $col);
16f6b6ac	194	}
a78e3fed	195
3980d69c	196	# not a class method, just a helper for cond_rel XXX
	197	sub _stringify_hash {
	198	my $href = shift;
	199
	200	return '{ ' .
	201	join(q{, }, map("$_ => $href->{$_}", keys %$href))
	202	. ' }';
	203	}
	204
16f6b6ac	205	# Set up a complex relation based on a hashref condition
3980d69c	206	sub _make_cond_rel {
3980d69c	207	my ( $self, $table, $other, $cond ) = @_;
a78e3fed	208
3980d69c	209	my $table_class = $self->classes->{$table};
	210	my $other_class = $self->classes->{$other};
	211	my $table_relname = $self->_inflect_relname(lc $table);
16f6b6ac	212	my $other_relname = lc $other;
708c0939	213
16f6b6ac	214	# for single-column case, set the relname to the column name,
	215	# to make filter accessors work
	216	if(scalar keys %$cond == 1) {
	217	my ($col) = keys %$cond;
	218	$other_relname = $cond->{$col};
4ce22656	219	}
16f6b6ac	220
	221	my $rev_cond = { reverse %$cond };
	222
3980d69c	223	my $cond_printable = _stringify_hash($cond)
	224	if $self->debug;
	225	my $rev_cond_printable = _stringify_hash($rev_cond)
	226	if $self->debug;
16f6b6ac	227
3980d69c	228	warn qq/\# Belongs_to relationship\n/ if $self->debug;
16f6b6ac	229
	230	warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
	231	. qq/$cond_printable);\n\n/
3980d69c	232	if $self->debug;
16f6b6ac	233
	234	$table_class->belongs_to( $other_relname => $other_class, $cond);
	235
3980d69c	236	warn qq/\# Has_many relationship\n/ if $self->debug;
16f6b6ac	237
	238	warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
	239	. qq/$rev_cond_printable);\n\n/
	240	. qq/);\n\n/
3980d69c	241	if $self->debug;
16f6b6ac	242
16f6b6ac	243	$other_class->has_many( $table_relname => $table_class, $rev_cond);
a78e3fed	244	}
a78e3fed	245
42c0680e	246	sub _use {
	247	my $self = shift;
	248	my $target = shift;
	249
	250	foreach (@_) {
	251	$_->require or croak ($_ . "->require: $@");
	252	eval "package $target; use $_;";
	253	croak "use $_: $@" if $@;
	254	}
	255	}
	256
	257	sub _inject {
	258	my $self = shift;
	259	my $target = shift;
	260	my $schema = $self->schema;
	261
	262	foreach (@_) {
	263	$_->require or croak ($_ . "->require: $@");
	264	$schema->inject_base($target, $_);
	265	}
	266	}
	267
a78e3fed	268	# Load and setup classes
3980d69c	269	sub _load_classes {
3980d69c	270	my $self = shift;
af6c2665	271
3980d69c	272	my @tables = $self->_tables();
	273	my @db_classes = $self->_db_classes();
	274	my $schema = $self->schema;
a78e3fed	275
a78e3fed	276	foreach my $table (@tables) {
3980d69c	277	my $constraint = $self->constraint;
	278	my $exclude = $self->exclude;
	279
	280	next unless $table =~ /$constraint/;
	281	next if defined $exclude && $table =~ /$exclude/;
af6c2665	282
af6c2665	283	my ($db_schema, $tbl) = split /\./, $table;
af96f52e	284	my $tablename = lc $table;
a78e3fed	285	if($tbl) {
3980d69c	286	$tablename = $self->drop_db_schema ? $tbl : lc $table;
af6c2665	287	}
3980d69c	288	my $lc_tblname = lc $tablename;
af6c2665	289
3980d69c	290	my $table_moniker = $self->_table2moniker($db_schema, $tbl);
3980d69c	291	my $table_class = $schema . q{::} . $table_moniker;
af6c2665	292
42c0680e	293	$self->_inject($table_class, 'DBIx::Class::Core');
	294	$self->_inject($table_class, @db_classes);
	295	$self->_inject($table_class, @{$self->additional_base_classes});
	296	$self->_use ($table_class, @{$self->additional_classes});
	297	$self->_inject($table_class, @{$self->left_base_classes});
3980d69c	298
	299	warn qq/\# Initializing table "$tablename" as "$table_class"\n/
	300	if $self->debug;
e26a4023	301	$table_class->table($lc_tblname);
af6c2665	302
3980d69c	303	my ( $cols, $pks ) = $self->_table_info($table);
a78e3fed	304	carp("$table has no primary key") unless @$pks;
a4a19f3c	305	$table_class->add_columns(@$cols);
a4a19f3c	306	$table_class->set_primary_key(@$pks) if @$pks;
af6c2665	307
3980d69c	308	warn qq/$table_class->table('$tablename');\n/ if $self->debug;
a78e3fed	309	my $columns = join "', '", @$cols;
3980d69c	310	warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
a78e3fed	311	my $primaries = join "', '", @$pks;
3980d69c	312	warn qq/$table_class->set_primary_key('$primaries')\n/
3980d69c	313	if $self->debug && @$pks;
af6c2665	314
3980d69c	315	$schema->register_class($table_moniker, $table_class);
	316	$self->classes->{$lc_tblname} = $table_class;
	317	$self->monikers->{$lc_tblname} = $table_moniker;
a78e3fed	318	}
	319	}
	320
3980d69c	321	=head3 tables
3980d69c	322
8a6b44ef	323	Returns a sorted list of loaded tables, using the original database table
8a6b44ef	324	names. Actually generated from the keys of the C<monikers> hash below.
3980d69c	325
8a6b44ef	326	my @tables = $schema->loader->tables;
	327
	328	=head3 monikers
	329
	330	Returns a hashref of loaded table-to-moniker mappings for the original
	331	database table names.
	332
	333	my $monikers = $schema->loader->monikers;
	334	my $foo_tbl_moniker = $monikers->{foo_tbl};
	335	# -or-
	336	my $foo_tbl_moniker = $schema->loader->monikers->{foo_tbl};
	337	# $foo_tbl_moniker would look like "FooTbl"
	338
	339	=head3 classes
	340
	341	Returns a hashref of table-to-classname mappings for the original database
aec93e93	342	table names. You probably shouldn't be using this for any normal or simple
	343	usage of your Schema. The usual way to run queries on your tables is via
	344	C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
	345	returned by C<monikers> above.
8a6b44ef	346
	347	my $classes = $schema->loader->classes;
	348	my $foo_tbl_class = $classes->{foo_tbl};
	349	# -or-
	350	my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
	351	# $foo_tbl_class would look like "My::Schema::FooTbl",
	352	# assuming the schema class is "My::Schema"
3980d69c	353
	354	=cut
	355
	356	sub tables {
	357	my $self = shift;
	358
	359	return sort keys %{ $self->monikers };
	360	}
	361
a78e3fed	362	# Find and setup relationships
3980d69c	363	sub _load_relationships {
	364	my $self = shift;
	365
	366	my $dbh = $self->schema->storage->dbh;
708c0939	367	my $quoter = $dbh->get_info(29) \|\| q{"};
3980d69c	368	foreach my $table ( $self->tables ) {
708c0939	369	my $rels = {};
708c0939	370	my $sth = $dbh->foreign_key_info( '',
3980d69c	371	$self->db_schema, '', '', '', $table );
708c0939	372	next if !$sth;
	373	while(my $raw_rel = $sth->fetchrow_hashref) {
	374	my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
	375	my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
	376	my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
4ce22656	377	my $relid = lc $raw_rel->{UK_NAME};
708c0939	378	$uk_tbl =~ s/$quoter//g;
	379	$uk_col =~ s/$quoter//g;
	380	$fk_col =~ s/$quoter//g;
4ce22656	381	$relid =~ s/$quoter//g;
	382	$rels->{$relid}->{tbl} = $uk_tbl;
	383	$rels->{$relid}->{cols}->{$uk_col} = $fk_col;
708c0939	384	}
708c0939	385
4ce22656	386	foreach my $relid (keys %$rels) {
	387	my $reltbl = $rels->{$relid}->{tbl};
	388	my $cond = $rels->{$relid}->{cols};
3980d69c	389	eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
708c0939	390	warn qq/\# belongs_to_many failed "$@"\n\n/
3980d69c	391	if $@ && $self->debug;
a78e3fed	392	}
	393	}
	394	}
	395
65644119	396	# Make a moniker from a table
3980d69c	397	sub _table2moniker {
3980d69c	398	my ( $self, $db_schema, $table ) = @_;
af6c2665	399
af96f52e	400	my $db_schema_ns;
af6c2665	401
af96f52e	402	if($table) {
af96f52e	403	$db_schema = ucfirst lc $db_schema;
3980d69c	404	$db_schema_ns = $db_schema if(!$self->drop_db_schema);
af96f52e	405	} else {
af96f52e	406	$table = $db_schema;
a78e3fed	407	}
af6c2665	408
65644119	409	my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
65644119	410	$moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
af96f52e	411
65644119	412	return $moniker;
a78e3fed	413	}
	414
	415	# Overload in driver class
3980d69c	416	sub _tables { croak "ABSTRACT METHOD" }
a78e3fed	417
3980d69c	418	sub _table_info { croak "ABSTRACT METHOD" }
a78e3fed	419
	420	=head1 SEE ALSO
	421
18fca96a	422	L<DBIx::Class::Schema::Loader>
a78e3fed	423
	424	=cut
	425
	426	1;