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/
24 additional_base_classes
41 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
45 See L<DBIx::Class::Schema::Loader>
49 This is the base class for the vendor-specific C<DBIx::Class::Schema::*>
50 classes, and implements the common functionality between them.
54 Available constructor options are:
56 =head2 additional_base_classes
58 List of additional base classes your table classes will use.
60 =head2 left_base_classes
62 List of additional base classes, that need to be leftmost.
64 =head2 additional_classes
66 List of additional classes which your table classes will use.
70 List of additional components to be loaded into your table classes.
71 A good example would be C<ResultSetManager>.
73 =head2 resultset_components
75 List of additional resultset components to be loaded into your table
76 classes. A good example would be C<AlwaysRS>. Component
77 C<ResultSetManager> will be automatically added to the above
78 C<components> list if this option is set.
82 Only load tables matching regex.
86 Exclude tables matching regex.
90 Enable debug messages.
102 Try to automatically detect/setup has_a and has_many relationships.
106 Overrides the default tablename -> moniker translation. Can be either
107 a hashref of table => moniker names, or a coderef for a translator
108 function taking a single scalar table name argument and returning
109 a scalar moniker. If the hash entry does not exist, or the function
110 returns a false/undef value, the code falls back to default behavior
115 Just like L</moniker_map> above, but for inflecting (pluralizing)
120 Deprecated. Equivalent to L</inflect_map>, but previously only took
121 a hashref argument, not a coderef. If you set C<inflect> to anything,
122 that setting will be copied to L</inflect_map>.
132 # ensure that a peice of object data is a valid arrayref, creating
133 # an empty one or encapsulating whatever's there.
134 sub _ensure_arrayref {
139 $self->{$_} = [ $self->{$_} ]
140 unless ref $self->{$_} eq 'ARRAY';
146 Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
147 by L<DBIx::Class::Schema::Loader>.
152 my ( $class, %args ) = @_;
154 my $self = { %args };
156 bless $self => $class;
158 $self->{db_schema} ||= '';
159 $self->{constraint} ||= '.*';
160 $self->_ensure_arrayref(qw/additional_classes
161 additional_base_classes
164 resultset_components/);
166 push(@{$self->{components}}, 'ResultSetManager')
167 if @{$self->{resultset_components}};
169 $self->{monikers} = {};
170 $self->{classes} = {};
172 # Support deprecated argument name
173 $self->{inflect_map} ||= $self->{inflect};
180 Does the actual schema-construction work, used internally by
181 L<DBIx::Class::Schema::Loader> right after object construction.
188 $self->schema->connection($self->dsn, $self->user,
189 $self->password, $self->options);
191 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
194 $self->_load_classes;
195 $self->_load_relationships if $self->relationships;
197 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
199 $self->schema->storage->disconnect;
204 # Overload in your driver class
205 sub _db_classes { croak "ABSTRACT METHOD" }
207 # Inflect a relationship name
208 sub _inflect_relname {
209 my ($self, $relname) = @_;
211 if( ref $self->{inflect_map} eq 'HASH' ) {
212 return $self->inflect_map->{$relname}
213 if exists $self->inflect_map->{$relname};
215 elsif( ref $self->{inflect_map} eq 'CODE' ) {
216 my $inflected = $self->inflect_map->($relname);
217 return $inflected if $inflected;
220 return Lingua::EN::Inflect::PL($relname);
223 # Set up a simple relation with just a local col and foreign table
224 sub _make_simple_rel {
225 my ($self, $table, $other, $col) = @_;
227 my $table_class = $self->classes->{$table};
228 my $other_class = $self->classes->{$other};
229 my $table_relname = $self->_inflect_relname(lc $table);
231 warn qq/\# Belongs_to relationship\n/ if $self->debug;
232 warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
234 $table_class->belongs_to( $col => $other_class );
236 warn qq/\# Has_many relationship\n/ if $self->debug;
237 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
241 $other_class->has_many( $table_relname => $table_class, $col);
244 # not a class method, just a helper for cond_rel XXX
245 sub _stringify_hash {
249 join(q{, }, map("$_ => $href->{$_}", keys %$href))
253 # Set up a complex relation based on a hashref condition
255 my ( $self, $table, $other, $cond ) = @_;
257 my $table_class = $self->classes->{$table};
258 my $other_class = $self->classes->{$other};
259 my $table_relname = $self->_inflect_relname(lc $table);
260 my $other_relname = lc $other;
262 # for single-column case, set the relname to the column name,
263 # to make filter accessors work
264 if(scalar keys %$cond == 1) {
265 my ($col) = keys %$cond;
266 $other_relname = $cond->{$col};
269 my $rev_cond = { reverse %$cond };
271 for (keys %$rev_cond) {
272 $rev_cond->{"foreign.$_"} = "self.".$rev_cond->{$_};
273 delete $rev_cond->{$_};
276 my $cond_printable = _stringify_hash($cond)
278 my $rev_cond_printable = _stringify_hash($rev_cond)
281 warn qq/\# Belongs_to relationship\n/ if $self->debug;
283 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
284 . qq/$cond_printable);\n\n/
287 $table_class->belongs_to( $other_relname => $other_class, $cond);
289 warn qq/\# Has_many relationship\n/ if $self->debug;
291 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
292 . qq/$rev_cond_printable);\n\n/
296 $other_class->has_many( $table_relname => $table_class, $rev_cond);
304 $_->require or croak ($_ . "->require: $@");
305 eval "package $target; use $_;";
306 croak "use $_: $@" if $@;
313 my $schema = $self->schema;
316 $_->require or croak ($_ . "->require: $@");
317 $schema->inject_base($target, $_);
321 # Load and setup classes
325 my @tables = $self->_tables();
326 my @db_classes = $self->_db_classes();
327 my $schema = $self->schema;
329 foreach my $table (@tables) {
330 my $constraint = $self->constraint;
331 my $exclude = $self->exclude;
333 next unless $table =~ /$constraint/;
334 next if defined $exclude && $table =~ /$exclude/;
336 my ($db_schema, $tbl) = split /\./, $table;
337 my $tablename = lc $table;
339 $tablename = $self->drop_db_schema ? $tbl : lc $table;
341 my $lc_tblname = lc $tablename;
343 my $table_moniker = $self->_table2moniker($db_schema, $tbl);
344 my $table_class = $schema . q{::} . $table_moniker;
347 @{"${table_class}::ISA"} = qw/DBIx::Class/;
349 $self->_use ($table_class, @{$self->additional_classes});
350 $self->_inject($table_class, @{$self->additional_base_classes});
351 $table_class->load_components(@{$self->components}, @db_classes, 'Core');
352 $table_class->load_resultset_components(@{$self->resultset_components})
353 if @{$self->resultset_components};
354 $self->_inject($table_class, @{$self->left_base_classes});
356 warn qq/\# Initializing table "$tablename" as "$table_class"\n/
358 $table_class->table($lc_tblname);
360 my ( $cols, $pks ) = $self->_table_info($table);
361 carp("$table has no primary key") unless @$pks;
362 $table_class->add_columns(@$cols);
363 $table_class->set_primary_key(@$pks) if @$pks;
365 warn qq/$table_class->table('$tablename');\n/ if $self->debug;
366 my $columns = join "', '", @$cols;
367 warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
368 my $primaries = join "', '", @$pks;
369 warn qq/$table_class->set_primary_key('$primaries')\n/
370 if $self->debug && @$pks;
372 $table_class->require;
373 if($@ && $@ !~ /^Can't locate /) {
374 croak "Failed to load external class definition"
375 . "for '$table_class': $@";
378 warn qq/# Loaded external class definition for '$table_class'\n/
381 $schema->register_class($table_moniker, $table_class);
382 $self->classes->{$lc_tblname} = $table_class;
383 $self->monikers->{$lc_tblname} = $table_moniker;
389 Returns a sorted list of loaded tables, using the original database table
390 names. Actually generated from the keys of the C<monikers> hash below.
392 my @tables = $schema->loader->tables;
399 return sort keys %{ $self->monikers };
402 # Find and setup relationships
403 sub _load_relationships {
406 my $dbh = $self->schema->storage->dbh;
407 my $quoter = $dbh->get_info(29) || q{"};
408 foreach my $table ( $self->tables ) {
410 my $sth = $dbh->foreign_key_info( '',
411 $self->db_schema, '', '', '', $table );
413 while(my $raw_rel = $sth->fetchrow_hashref) {
414 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
415 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
416 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
417 my $relid = lc $raw_rel->{UK_NAME};
418 $uk_tbl =~ s/$quoter//g;
419 $uk_col =~ s/$quoter//g;
420 $fk_col =~ s/$quoter//g;
421 $relid =~ s/$quoter//g;
422 $rels->{$relid}->{tbl} = $uk_tbl;
423 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
426 foreach my $relid (keys %$rels) {
427 my $reltbl = $rels->{$relid}->{tbl};
428 my $cond = $rels->{$relid}->{cols};
429 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
430 warn qq/\# belongs_to_many failed "$@"\n\n/
431 if $@ && $self->debug;
436 # Make a moniker from a table
438 my ( $self, $db_schema, $table ) = @_;
443 $db_schema = ucfirst lc $db_schema;
444 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
451 if( ref $self->moniker_map eq 'HASH' ) {
452 $moniker = $self->moniker_map->{$table};
454 elsif( ref $self->moniker_map eq 'CODE' ) {
455 $moniker = $self->moniker_map->($table);
458 $moniker ||= join '', map ucfirst, split /[\W_]+/, lc $table;
460 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
465 # Overload in driver class
466 sub _tables { croak "ABSTRACT METHOD" }
468 sub _table_info { croak "ABSTRACT METHOD" }
472 Returns a hashref of loaded table-to-moniker mappings for the original
473 database table names.
475 my $monikers = $schema->loader->monikers;
476 my $foo_tbl_moniker = $monikers->{foo_tbl};
478 my $foo_tbl_moniker = $schema->loader->monikers->{foo_tbl};
479 # $foo_tbl_moniker would look like "FooTbl"
483 Returns a hashref of table-to-classname mappings for the original database
484 table names. You probably shouldn't be using this for any normal or simple
485 usage of your Schema. The usual way to run queries on your tables is via
486 C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
487 returned by C<monikers> above.
489 my $classes = $schema->loader->classes;
490 my $foo_tbl_class = $classes->{foo_tbl};
492 my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
493 # $foo_tbl_class would look like "My::Schema::FooTbl",
494 # assuming the schema class is "My::Schema"
498 L<DBIx::Class::Schema::Loader>