1 package DBIx::Class::Schema::Loader::Generic;
5 use base qw/Class::Accessor::Fast/;
8 use Lingua::EN::Inflect;
9 use UNIVERSAL::require;
12 # The first group are all arguments which are may be defaulted within,
13 # The last two (classes, monikers) are generated locally:
15 __PACKAGE__->mk_ro_accessors(qw/
21 additional_base_classes
38 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
42 See L<DBIx::Class::Schema::Loader>
46 This is the base class for the vendor-specific C<DBIx::Class::Schema::*>
47 classes, and implements the common functionality between them.
51 Available constructor options are:
55 Identical to the connect_info arguments to C<connect> and C<connection>
56 that are mentioned in L<DBIx::Class::Schema>.
58 An arrayref of connection information. For DBI-based Schemas,
61 connect_info => [ $dsn, $user, $pass, { AutoCommit => 1 } ],
63 =head2 additional_base_classes
65 List of additional base classes your table classes will use.
67 =head2 left_base_classes
69 List of additional base classes, that need to be leftmost.
71 =head2 additional_classes
73 List of additional classes which your table classes will use.
77 List of additional components to be loaded into your table classes.
78 A good example would be C<ResultSetManager>.
80 =head2 resultset_components
82 List of additional resultset components to be loaded into your table
83 classes. A good example would be C<AlwaysRS>. Component
84 C<ResultSetManager> will be automatically added to the above
85 C<components> list if this option is set.
89 Only load tables matching regex.
93 Exclude tables matching regex.
97 Enable debug messages.
101 Try to automatically detect/setup has_a and has_many relationships.
105 Overrides the default tablename -> moniker translation. Can be either
106 a hashref of table => moniker names, or a coderef for a translator
107 function taking a single scalar table name argument and returning
108 a scalar moniker. If the hash entry does not exist, or the function
109 returns a false/undef value, the code falls back to default behavior
114 Just like L</moniker_map> above, but for inflecting (pluralizing)
119 Deprecated. Equivalent to L</inflect_map>, but previously only took
120 a hashref argument, not a coderef. If you set C<inflect> to anything,
121 that setting will be copied to L</inflect_map>.
125 DEPRECATED, use L</connect_info> instead.
127 DBI Data Source Name.
131 DEPRECATED, use L</connect_info> instead.
137 DEPRECATED, use L</connect_info> instead.
143 DEPRECATED, use L</connect_info> instead.
145 DBI connection options hashref, like:
153 # ensure that a peice of object data is a valid arrayref, creating
154 # an empty one or encapsulating whatever's there.
155 sub _ensure_arrayref {
160 $self->{$_} = [ $self->{$_} ]
161 unless ref $self->{$_} eq 'ARRAY';
167 Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
168 by L<DBIx::Class::Schema::Loader>.
173 my ( $class, %args ) = @_;
175 my $self = { %args };
177 bless $self => $class;
179 $self->{db_schema} ||= '';
180 $self->{constraint} ||= '.*';
181 $self->_ensure_arrayref(qw/additional_classes
182 additional_base_classes
188 push(@{$self->{components}}, 'ResultSetManager')
189 if @{$self->{resultset_components}};
191 $self->{monikers} = {};
192 $self->{classes} = {};
194 # Support deprecated argument name
195 $self->{inflect_map} ||= $self->{inflect};
197 # Support deprecated connect_info args, even mixed
198 # with a valid partially-filled connect_info
199 $self->{connect_info}->[0] ||= $self->{dsn};
200 $self->{connect_info}->[1] ||= $self->{user};
201 $self->{connect_info}->[2] ||= $self->{password};
202 $self->{connect_info}->[3] ||= $self->{options};
209 Does the actual schema-construction work, used internally by
210 L<DBIx::Class::Schema::Loader> right after object construction.
217 $self->schema->connection(@{$self->connect_info});
219 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
222 $self->_load_classes;
223 $self->_load_relationships if $self->relationships;
225 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
227 $self->schema->storage->disconnect;
232 # Overload in your driver class
233 sub _db_classes { croak "ABSTRACT METHOD" }
235 # Inflect a relationship name
236 sub _inflect_relname {
237 my ($self, $relname) = @_;
239 if( ref $self->{inflect_map} eq 'HASH' ) {
240 return $self->inflect_map->{$relname}
241 if exists $self->inflect_map->{$relname};
243 elsif( ref $self->{inflect_map} eq 'CODE' ) {
244 my $inflected = $self->inflect_map->($relname);
245 return $inflected if $inflected;
248 return Lingua::EN::Inflect::PL($relname);
251 # Set up a simple relation with just a local col and foreign table
252 sub _make_simple_rel {
253 my ($self, $table, $other, $col) = @_;
255 my $table_class = $self->classes->{$table};
256 my $other_class = $self->classes->{$other};
257 my $table_relname = $self->_inflect_relname(lc $table);
259 warn qq/\# Belongs_to relationship\n/ if $self->debug;
260 warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
262 $table_class->belongs_to( $col => $other_class );
264 warn qq/\# Has_many relationship\n/ if $self->debug;
265 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
269 $other_class->has_many( $table_relname => $table_class, $col);
272 # not a class method, just a helper for cond_rel XXX
273 sub _stringify_hash {
277 join(q{, }, map("$_ => $href->{$_}", keys %$href))
281 # Set up a complex relation based on a hashref condition
283 my ( $self, $table, $other, $cond ) = @_;
285 my $table_class = $self->classes->{$table};
286 my $other_class = $self->classes->{$other};
287 my $table_relname = $self->_inflect_relname(lc $table);
288 my $other_relname = lc $other;
290 # for single-column case, set the relname to the column name,
291 # to make filter accessors work
292 if(scalar keys %$cond == 1) {
293 my ($col) = keys %$cond;
294 $other_relname = $cond->{$col};
297 my $rev_cond = { reverse %$cond };
299 for (keys %$rev_cond) {
300 $rev_cond->{"foreign.$_"} = "self.".$rev_cond->{$_};
301 delete $rev_cond->{$_};
304 my $cond_printable = _stringify_hash($cond)
306 my $rev_cond_printable = _stringify_hash($rev_cond)
309 warn qq/\# Belongs_to relationship\n/ if $self->debug;
311 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
312 . qq/$cond_printable);\n\n/
315 $table_class->belongs_to( $other_relname => $other_class, $cond);
317 warn qq/\# Has_many relationship\n/ if $self->debug;
319 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
320 . qq/$rev_cond_printable);\n\n/
324 $other_class->has_many( $table_relname => $table_class, $rev_cond);
332 $_->require or croak ($_ . "->require: $@");
333 eval "package $target; use $_;";
334 croak "use $_: $@" if $@;
341 my $schema = $self->schema;
344 $_->require or croak ($_ . "->require: $@");
345 $schema->inject_base($target, $_);
349 # Load and setup classes
353 my @tables = $self->_tables();
354 my @db_classes = $self->_db_classes();
355 my $schema = $self->schema;
357 foreach my $table (@tables) {
358 my $constraint = $self->constraint;
359 my $exclude = $self->exclude;
361 next unless $table =~ /$constraint/;
362 next if defined $exclude && $table =~ /$exclude/;
364 my ($db_schema, $tbl) = split /\./, $table;
365 my $tablename = lc $table;
367 $tablename = $self->drop_db_schema ? $tbl : lc $table;
369 my $lc_tblname = lc $tablename;
371 my $table_moniker = $self->_table2moniker($db_schema, $tbl);
372 my $table_class = $schema . q{::} . $table_moniker;
375 @{"${table_class}::ISA"} = qw/DBIx::Class/;
377 $self->_use ($table_class, @{$self->additional_classes});
378 $self->_inject($table_class, @{$self->additional_base_classes});
379 $table_class->load_components(@{$self->components}, @db_classes, 'Core');
380 $table_class->load_resultset_components(@{$self->resultset_components})
381 if @{$self->resultset_components};
382 $self->_inject($table_class, @{$self->left_base_classes});
384 warn qq/\# Initializing table "$tablename" as "$table_class"\n/
386 $table_class->table($lc_tblname);
388 my ( $cols, $pks ) = $self->_table_info($table);
389 carp("$table has no primary key") unless @$pks;
390 $table_class->add_columns(@$cols);
391 $table_class->set_primary_key(@$pks) if @$pks;
393 warn qq/$table_class->table('$tablename');\n/ if $self->debug;
394 my $columns = join "', '", @$cols;
395 warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
396 my $primaries = join "', '", @$pks;
397 warn qq/$table_class->set_primary_key('$primaries')\n/
398 if $self->debug && @$pks;
400 $table_class->require;
401 if($@ && $@ !~ /^Can't locate /) {
402 croak "Failed to load external class definition"
403 . "for '$table_class': $@";
406 warn qq/# Loaded external class definition for '$table_class'\n/
409 $schema->register_class($table_moniker, $table_class);
410 $self->classes->{$lc_tblname} = $table_class;
411 $self->monikers->{$lc_tblname} = $table_moniker;
417 Returns a sorted list of loaded tables, using the original database table
418 names. Actually generated from the keys of the C<monikers> hash below.
420 my @tables = $schema->loader->tables;
427 return sort keys %{ $self->monikers };
430 # Find and setup relationships
431 sub _load_relationships {
434 my $dbh = $self->schema->storage->dbh;
435 my $quoter = $dbh->get_info(29) || q{"};
436 foreach my $table ( $self->tables ) {
438 my $sth = $dbh->foreign_key_info( '',
439 $self->db_schema, '', '', '', $table );
441 while(my $raw_rel = $sth->fetchrow_hashref) {
442 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
443 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
444 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
445 my $relid = lc $raw_rel->{UK_NAME};
446 $uk_tbl =~ s/$quoter//g;
447 $uk_col =~ s/$quoter//g;
448 $fk_col =~ s/$quoter//g;
449 $relid =~ s/$quoter//g;
450 $rels->{$relid}->{tbl} = $uk_tbl;
451 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
454 foreach my $relid (keys %$rels) {
455 my $reltbl = $rels->{$relid}->{tbl};
456 my $cond = $rels->{$relid}->{cols};
457 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
458 warn qq/\# belongs_to_many failed "$@"\n\n/
459 if $@ && $self->debug;
464 # Make a moniker from a table
466 my ( $self, $db_schema, $table ) = @_;
471 $db_schema = ucfirst lc $db_schema;
472 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
479 if( ref $self->moniker_map eq 'HASH' ) {
480 $moniker = $self->moniker_map->{$table};
482 elsif( ref $self->moniker_map eq 'CODE' ) {
483 $moniker = $self->moniker_map->($table);
486 $moniker ||= join '', map ucfirst, split /[\W_]+/, lc $table;
488 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
493 # Overload in driver class
494 sub _tables { croak "ABSTRACT METHOD" }
496 sub _table_info { croak "ABSTRACT METHOD" }
500 Returns a hashref of loaded table-to-moniker mappings for the original
501 database table names.
503 my $monikers = $schema->loader->monikers;
504 my $foo_tbl_moniker = $monikers->{foo_tbl};
506 my $foo_tbl_moniker = $schema->loader->monikers->{foo_tbl};
507 # $foo_tbl_moniker would look like "FooTbl"
511 Returns a hashref of table-to-classname mappings for the original database
512 table names. You probably shouldn't be using this for any normal or simple
513 usage of your Schema. The usual way to run queries on your tables is via
514 C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
515 returned by C<monikers> above.
517 my $classes = $schema->loader->classes;
518 my $foo_tbl_class = $classes->{foo_tbl};
520 my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
521 # $foo_tbl_class would look like "My::Schema::FooTbl",
522 # assuming the schema class is "My::Schema"
526 L<DBIx::Class::Schema::Loader>