1 package DBIx::Class::Schema::Loader::Generic;
5 use base qw/Class::Accessor::Fast/;
8 use Lingua::EN::Inflect;
9 require DBIx::Class::Core;
11 # The first group are all arguments which are may be defaulted within,
12 # The last two (classes, monikers) are generated locally:
14 __PACKAGE__->mk_ro_accessors(qw/
23 additional_base_classes
39 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
43 See L<DBIx::Class::Schema::Loader>
47 This is the base class for the vendor-specific C<DBIx::Class::Schema::*>
48 classes, and implements the common functionality between them.
52 Available constructor options are:
54 =head2 additional_base_classes
56 List of additional base classes your table classes will use.
58 =head2 left_base_classes
60 List of additional base classes, that need to be leftmost.
62 =head2 additional_classes
64 List of additional classes which your table classes will use.
68 List of additional components to be loaded into your table classes.
69 A good example would be C<ResultSetManager>.
71 =head2 resultset_components
73 List of additional resultset components to be loaded into your table
74 classes. A good example would be C<AlwaysRS>. Component
75 C<ResultSetManager> will be automatically added to the above
76 C<components> list if this option is set.
80 Only load tables matching regex.
84 Exclude tables matching regex.
88 Enable debug messages.
100 Try to automatically detect/setup has_a and has_many relationships.
104 An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
105 Useful for foreign language column names.
115 # ensure that a peice of object data is a valid arrayref, creating
116 # an empty one or encapsulating whatever's there.
117 sub _ensure_arrayref {
122 $self->{$_} = [ $self->{$_} ]
123 unless ref $self->{$_} eq 'ARRAY';
129 Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
130 by L<DBIx::Class::Schema::Loader>.
135 my ( $class, %args ) = @_;
137 my $self = { %args };
139 bless $self => $class;
141 $self->{db_schema} ||= '';
142 $self->{constraint} ||= '.*';
143 $self->{inflect} ||= {};
144 $self->_ensure_arrayref(qw/additional_classes
145 additional_base_classes
148 resultset_components/);
150 push(@{$self->{components}}, 'ResultSetManager')
151 if @{$self->{resultset_components}};
153 $self->{monikers} = {};
154 $self->{classes} = {};
161 Does the actual schema-construction work, used internally by
162 L<DBIx::Class::Schema::Loader> right after object construction.
169 $self->schema->connection($self->dsn, $self->user,
170 $self->password, $self->options);
172 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
175 $self->_load_classes;
176 $self->_load_relationships if $self->relationships;
178 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
180 $self->schema->storage->disconnect;
185 # Overload in your driver class
186 sub _db_classes { croak "ABSTRACT METHOD" }
188 # Inflect a relationship name
189 # XXX (should pluralize, but currently also tends to de-pluralize plurals)
190 sub _inflect_relname {
191 my ($self, $relname) = @_;
193 return $self->inflect->{$relname} if exists $self->inflect->{$relname};
194 return Lingua::EN::Inflect::PL($relname);
197 # Set up a simple relation with just a local col and foreign table
198 sub _make_simple_rel {
199 my ($self, $table, $other, $col) = @_;
201 my $table_class = $self->classes->{$table};
202 my $other_class = $self->classes->{$other};
203 my $table_relname = $self->_inflect_relname(lc $table);
205 warn qq/\# Belongs_to relationship\n/ if $self->debug;
206 warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
208 $table_class->belongs_to( $col => $other_class );
210 warn qq/\# Has_many relationship\n/ if $self->debug;
211 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
215 $other_class->has_many( $table_relname => $table_class, $col);
218 # not a class method, just a helper for cond_rel XXX
219 sub _stringify_hash {
223 join(q{, }, map("$_ => $href->{$_}", keys %$href))
227 # Set up a complex relation based on a hashref condition
229 my ( $self, $table, $other, $cond ) = @_;
231 my $table_class = $self->classes->{$table};
232 my $other_class = $self->classes->{$other};
233 my $table_relname = $self->_inflect_relname(lc $table);
234 my $other_relname = lc $other;
236 # for single-column case, set the relname to the column name,
237 # to make filter accessors work
238 if(scalar keys %$cond == 1) {
239 my ($col) = keys %$cond;
240 $other_relname = $cond->{$col};
243 my $rev_cond = { reverse %$cond };
245 for (keys %$rev_cond) {
246 $rev_cond->{"foreign.$_"} = "self.".$rev_cond->{$_};
247 delete $rev_cond->{$_};
250 my $cond_printable = _stringify_hash($cond)
252 my $rev_cond_printable = _stringify_hash($rev_cond)
255 warn qq/\# Belongs_to relationship\n/ if $self->debug;
257 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
258 . qq/$cond_printable);\n\n/
261 $table_class->belongs_to( $other_relname => $other_class, $cond);
263 warn qq/\# Has_many relationship\n/ if $self->debug;
265 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
266 . qq/$rev_cond_printable);\n\n/
270 $other_class->has_many( $table_relname => $table_class, $rev_cond);
278 $_->require or croak ($_ . "->require: $@");
279 eval "package $target; use $_;";
280 croak "use $_: $@" if $@;
287 my $schema = $self->schema;
290 $_->require or croak ($_ . "->require: $@");
291 $schema->inject_base($target, $_);
295 # Load and setup classes
299 my @tables = $self->_tables();
300 my @db_classes = $self->_db_classes();
301 my $schema = $self->schema;
303 foreach my $table (@tables) {
304 my $constraint = $self->constraint;
305 my $exclude = $self->exclude;
307 next unless $table =~ /$constraint/;
308 next if defined $exclude && $table =~ /$exclude/;
310 my ($db_schema, $tbl) = split /\./, $table;
311 my $tablename = lc $table;
313 $tablename = $self->drop_db_schema ? $tbl : lc $table;
315 my $lc_tblname = lc $tablename;
317 my $table_moniker = $self->_table2moniker($db_schema, $tbl);
318 my $table_class = $schema . q{::} . $table_moniker;
321 @{"${table_class}::ISA"} = ($schema);
323 $self->_use ($table_class, @{$self->additional_classes});
324 $self->_inject($table_class, @{$self->additional_base_classes});
325 $table_class->load_components(@{$self->components}, @db_classes, 'Core');
326 $table_class->load_resultset_components(@{$self->resultset_components})
327 if @{$self->resultset_components};
328 $self->_inject($table_class, @{$self->left_base_classes});
330 warn qq/\# Initializing table "$tablename" as "$table_class"\n/
332 $table_class->table($lc_tblname);
334 my ( $cols, $pks ) = $self->_table_info($table);
335 carp("$table has no primary key") unless @$pks;
336 $table_class->add_columns(@$cols);
337 $table_class->set_primary_key(@$pks) if @$pks;
339 warn qq/$table_class->table('$tablename');\n/ if $self->debug;
340 my $columns = join "', '", @$cols;
341 warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
342 my $primaries = join "', '", @$pks;
343 warn qq/$table_class->set_primary_key('$primaries')\n/
344 if $self->debug && @$pks;
346 $table_class->require;
347 if($@ && $@ !~ /^Can't locate /) {
348 croak "Failed to load external class definition"
349 . "for '$table_class': $@";
352 warn qq/# Loaded external class definition for '$table_class'\n/
355 $schema->register_class($table_moniker, $table_class);
356 $self->classes->{$lc_tblname} = $table_class;
357 $self->monikers->{$lc_tblname} = $table_moniker;
363 Returns a sorted list of loaded tables, using the original database table
364 names. Actually generated from the keys of the C<monikers> hash below.
366 my @tables = $schema->loader->tables;
373 return sort keys %{ $self->monikers };
376 # Find and setup relationships
377 sub _load_relationships {
380 my $dbh = $self->schema->storage->dbh;
381 my $quoter = $dbh->get_info(29) || q{"};
382 foreach my $table ( $self->tables ) {
384 my $sth = $dbh->foreign_key_info( '',
385 $self->db_schema, '', '', '', $table );
387 while(my $raw_rel = $sth->fetchrow_hashref) {
388 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
389 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
390 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
391 my $relid = lc $raw_rel->{UK_NAME};
392 $uk_tbl =~ s/$quoter//g;
393 $uk_col =~ s/$quoter//g;
394 $fk_col =~ s/$quoter//g;
395 $relid =~ s/$quoter//g;
396 $rels->{$relid}->{tbl} = $uk_tbl;
397 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
400 foreach my $relid (keys %$rels) {
401 my $reltbl = $rels->{$relid}->{tbl};
402 my $cond = $rels->{$relid}->{cols};
403 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
404 warn qq/\# belongs_to_many failed "$@"\n\n/
405 if $@ && $self->debug;
410 # Make a moniker from a table
412 my ( $self, $db_schema, $table ) = @_;
417 $db_schema = ucfirst lc $db_schema;
418 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
423 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
424 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
429 # Overload in driver class
430 sub _tables { croak "ABSTRACT METHOD" }
432 sub _table_info { croak "ABSTRACT METHOD" }
436 Returns a hashref of loaded table-to-moniker mappings for the original
437 database table names.
439 my $monikers = $schema->loader->monikers;
440 my $foo_tbl_moniker = $monikers->{foo_tbl};
442 my $foo_tbl_moniker = $schema->loader->monikers->{foo_tbl};
443 # $foo_tbl_moniker would look like "FooTbl"
447 Returns a hashref of table-to-classname mappings for the original database
448 table names. You probably shouldn't be using this for any normal or simple
449 usage of your Schema. The usual way to run queries on your tables is via
450 C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
451 returned by C<monikers> above.
453 my $classes = $schema->loader->classes;
454 my $foo_tbl_class = $classes->{foo_tbl};
456 my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
457 # $foo_tbl_class would look like "My::Schema::FooTbl",
458 # assuming the schema class is "My::Schema"
462 L<DBIx::Class::Schema::Loader>