use Class::C3;
use Carp;
use Lingua::EN::Inflect;
-require DBIx::Class::Core;
+use UNIVERSAL::require;
+require DBIx::Class;
# 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
+ connect_info
exclude
constraint
additional_classes
additional_base_classes
left_base_classes
+ components
+ resultset_components
relationships
- inflect
+ inflect_map
+ moniker_map
db_schema
drop_db_schema
debug
+ _tables
classes
monikers
/);
Available constructor options are:
+=head2 connect_info
+
+Identical to the connect_info arguments to C<connect> and C<connection>
+that are mentioned in L<DBIx::Class::Schema>.
+
+An arrayref of connection information. For DBI-based Schemas,
+this takes the form:
+
+ connect_info => [ $dsn, $user, $pass, { AutoCommit => 1 } ],
+
=head2 additional_base_classes
List of additional base classes your table classes will use.
List of additional classes which your table classes will use.
+=head2 components
+
+List of additional components to be loaded into your table classes.
+A good example would be C<ResultSetManager>.
+
+=head2 resultset_components
+
+List of additional resultset components to be loaded into your table
+classes. A good example would be C<AlwaysRS>. Component
+C<ResultSetManager> will be automatically added to the above
+C<components> list if this option is set.
+
=head2 constraint
Only load tables matching regex.
Enable debug messages.
-=head2 dsn
+=head2 relationships
-DBI Data Source Name.
+Try to automatically detect/setup has_a and has_many relationships.
-=head2 password
+=head2 moniker_map
-Password.
+Overrides the default tablename -> moniker translation. Can be either
+a hashref of table => moniker names, or a coderef for a translator
+function taking a single scalar table name argument and returning
+a scalar moniker. If the hash entry does not exist, or the function
+returns a false/undef value, the code falls back to default behavior
+for that table name.
-=head2 relationships
+=head2 inflect_map
-Try to automatically detect/setup has_a and has_many relationships.
+Just like L</moniker_map> above, but for inflecting (pluralizing)
+relationship names.
=head2 inflect
-An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
-Useful for foreign language column names.
+Deprecated. Equivalent to L</inflect_map>, but previously only took
+a hashref argument, not a coderef. If you set C<inflect> to anything,
+that setting will be copied to L</inflect_map>.
+
+=head2 dsn
+
+DEPRECATED, use L</connect_info> instead.
+
+DBI Data Source Name.
=head2 user
+DEPRECATED, use L</connect_info> instead.
+
Username.
+=head2 password
+
+DEPRECATED, use L</connect_info> instead.
+
+Password.
+
+=head2 options
+
+DEPRECATED, use L</connect_info> instead.
+
+DBI connection options hashref, like:
+
+ { AutoCommit => 1 }
+
=head1 METHODS
=cut
$self->{db_schema} ||= '';
$self->{constraint} ||= '.*';
- $self->{inflect} ||= {};
$self->_ensure_arrayref(qw/additional_classes
additional_base_classes
- left_base_classes/);
+ left_base_classes
+ components
+ resultset_components
+ connect_info/);
+
+ push(@{$self->{components}}, 'ResultSetManager')
+ if @{$self->{resultset_components}};
$self->{monikers} = {};
$self->{classes} = {};
+ # Support deprecated argument name
+ $self->{inflect_map} ||= $self->{inflect};
+
+ # Support deprecated connect_info args, even mixed
+ # with a valid partially-filled connect_info
+ $self->{connect_info}->[0] ||= $self->{dsn};
+ $self->{connect_info}->[1] ||= $self->{user};
+ $self->{connect_info}->[2] ||= $self->{password};
+ $self->{connect_info}->[3] ||= $self->{options};
+
$self;
}
sub load {
my $self = shift;
- $self->schema->connection($self->dsn, $self->user,
- $self->password, $self->options);
+ $self->schema->connection(@{$self->connect_info});
warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
if $self->debug;
$self->_load_classes;
$self->_load_relationships if $self->relationships;
+ $self->_load_external;
warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
if $self->debug;
$self;
}
+sub _load_external {
+ my $self = shift;
+
+ foreach my $table_class (map { $self->classes->{$_} } $self->tables) {
+ $table_class->require;
+ if($@ && $@ !~ /^Can't locate /) {
+ croak "Failed to load external class definition"
+ . " for '$table_class': $@";
+ }
+ elsif(!$@) {
+ warn qq/# Loaded external class definition for '$table_class'\n/
+ if $self->debug;
+ }
+ }
+}
+
# 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};
+ if( ref $self->{inflect_map} eq 'HASH' ) {
+ return $self->inflect_map->{$relname}
+ if exists $self->inflect_map->{$relname};
+ }
+ elsif( ref $self->{inflect_map} eq 'CODE' ) {
+ my $inflected = $self->inflect_map->($relname);
+ return $inflected if $inflected;
+ }
+
return Lingua::EN::Inflect::PL($relname);
}
my $rev_cond = { reverse %$cond };
+ for (keys %$rev_cond) {
+ $rev_cond->{"foreign.$_"} = "self.".$rev_cond->{$_};
+ delete $rev_cond->{$_};
+ }
+
my $cond_printable = _stringify_hash($cond)
if $self->debug;
my $rev_cond_printable = _stringify_hash($rev_cond)
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;
+ my $constraint = $self->constraint;
+ my $exclude = $self->exclude;
+ my @tables = sort grep
+ { /$constraint/ && (!$exclude || ! /$exclude/) }
+ $self->_tables_list;
- next unless $table =~ /$constraint/;
- next if defined $exclude && $table =~ /$exclude/;
+ $self->{_tables} = \@tables;
+ foreach my $table (@tables) {
my ($db_schema, $tbl) = split /\./, $table;
- my $tablename = lc $table;
if($tbl) {
- $tablename = $self->drop_db_schema ? $tbl : lc $table;
+ $table = $self->drop_db_schema ? $tbl : $table;
}
- my $lc_tblname = lc $tablename;
+ my $lc_table = lc $table;
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->classes->{$lc_table} = $table_class;
+ $self->monikers->{$lc_table} = $table_moniker;
+ $self->classes->{$table} = $table_class;
+ $self->monikers->{$table} = $table_moniker;
+
+ no warnings 'redefine';
+ local *Class::C3::reinitialize = sub { };
+ use warnings;
+
+ { no strict 'refs';
+ @{"${table_class}::ISA"} = qw/DBIx::Class/;
+ }
$self->_use ($table_class, @{$self->additional_classes});
+ $self->_inject($table_class, @{$self->additional_base_classes});
+ $table_class->load_components(@{$self->components}, @db_classes, 'Core');
+ $table_class->load_resultset_components(@{$self->resultset_components})
+ if @{$self->resultset_components};
$self->_inject($table_class, @{$self->left_base_classes});
+ }
- warn qq/\# Initializing table "$tablename" as "$table_class"\n/
+ Class::C3::reinitialize;
+
+ foreach my $table (@tables) {
+ my $table_class = $self->classes->{$table};
+ my $table_moniker = $self->monikers->{$table};
+
+ warn qq/\# Initializing table "$table" as "$table_class"\n/
if $self->debug;
- $table_class->table($lc_tblname);
+ $table_class->table($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 $self->debug;
+ warn qq/$table_class->table('$table');\n/ if $self->debug;
my $columns = join "', '", @$cols;
warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
my $primaries = join "', '", @$pks;
if $self->debug && @$pks;
$schema->register_class($table_moniker, $table_class);
- $self->classes->{$lc_tblname} = $table_class;
- $self->monikers->{$lc_tblname} = $table_moniker;
}
}
=head2 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.
+names.
my @tables = $schema->loader->tables;
sub tables {
my $self = shift;
- return sort keys %{ $self->monikers };
+ return @{$self->_tables};
}
# Find and setup relationships
$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_tbl = $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};
+ my $relid = $raw_rel->{UK_NAME};
$uk_tbl =~ s/$quoter//g;
$uk_col =~ s/$quoter//g;
$fk_col =~ s/$quoter//g;
$table = $db_schema;
}
- my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
+ my $moniker;
+
+ if( ref $self->moniker_map eq 'HASH' ) {
+ $moniker = $self->moniker_map->{$table};
+ }
+ elsif( ref $self->moniker_map eq 'CODE' ) {
+ $moniker = $self->moniker_map->($table);
+ }
+
+ $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 _tables_list { croak "ABSTRACT METHOD" }
sub _table_info { croak "ABSTRACT METHOD" }
=head2 monikers
Returns a hashref of loaded table-to-moniker mappings for the original
-database table names.
+database table names. In cases where the database driver returns table
+names as uppercase or mixed case, there will also be a duplicate entry
+here in all lowercase. Best practice would be to use lower-case table
+names when accessing this.
my $monikers = $schema->loader->monikers;
my $foo_tbl_moniker = $monikers->{foo_tbl};
=head2 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
+table names. Same lowercase stuff as above applies here.
+
+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.
projects / dbsrgits/DBIx-Class-Schema-Loader.git / blobdiff