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;
320 $self->_inject($table_class, 'DBIx::Class::Core');
321 $self->_inject($table_class, @db_classes);
322 $self->_inject($table_class, @{$self->additional_base_classes});
323 $self->_use ($table_class, @{$self->additional_classes});
324 $self->_inject($table_class, @{$self->left_base_classes});
325 $table_class->load_components(@{$self->components});
326 $table_class->load_resultset_components(@{$self->resultset_components})
327 if @{$self->resultset_components};
329 warn qq/\# Initializing table "$tablename" as "$table_class"\n/
331 $table_class->table($lc_tblname);
333 my ( $cols, $pks ) = $self->_table_info($table);
334 carp("$table has no primary key") unless @$pks;
335 $table_class->add_columns(@$cols);
336 $table_class->set_primary_key(@$pks) if @$pks;
338 warn qq/$table_class->table('$tablename');\n/ if $self->debug;
339 my $columns = join "', '", @$cols;
340 warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
341 my $primaries = join "', '", @$pks;
342 warn qq/$table_class->set_primary_key('$primaries')\n/
343 if $self->debug && @$pks;
345 $table_class->require;
346 if($@ && $@ !~ /^Can't locate /) {
347 croak "Failed to load external class definition"
348 . "for '$table_class': $@";
351 warn qq/# Loaded external class definition for '$table_class'\n/
354 $schema->register_class($table_moniker, $table_class);
355 $self->classes->{$lc_tblname} = $table_class;
356 $self->monikers->{$lc_tblname} = $table_moniker;
362 Returns a sorted list of loaded tables, using the original database table
363 names. Actually generated from the keys of the C<monikers> hash below.
365 my @tables = $schema->loader->tables;
372 return sort keys %{ $self->monikers };
375 # Find and setup relationships
376 sub _load_relationships {
379 my $dbh = $self->schema->storage->dbh;
380 my $quoter = $dbh->get_info(29) || q{"};
381 foreach my $table ( $self->tables ) {
383 my $sth = $dbh->foreign_key_info( '',
384 $self->db_schema, '', '', '', $table );
386 while(my $raw_rel = $sth->fetchrow_hashref) {
387 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
388 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
389 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
390 my $relid = lc $raw_rel->{UK_NAME};
391 $uk_tbl =~ s/$quoter//g;
392 $uk_col =~ s/$quoter//g;
393 $fk_col =~ s/$quoter//g;
394 $relid =~ s/$quoter//g;
395 $rels->{$relid}->{tbl} = $uk_tbl;
396 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
399 foreach my $relid (keys %$rels) {
400 my $reltbl = $rels->{$relid}->{tbl};
401 my $cond = $rels->{$relid}->{cols};
402 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
403 warn qq/\# belongs_to_many failed "$@"\n\n/
404 if $@ && $self->debug;
409 # Make a moniker from a table
411 my ( $self, $db_schema, $table ) = @_;
416 $db_schema = ucfirst lc $db_schema;
417 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
422 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
423 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
428 # Overload in driver class
429 sub _tables { croak "ABSTRACT METHOD" }
431 sub _table_info { croak "ABSTRACT METHOD" }
435 Returns a hashref of loaded table-to-moniker mappings for the original
436 database table names.
438 my $monikers = $schema->loader->monikers;
439 my $foo_tbl_moniker = $monikers->{foo_tbl};
441 my $foo_tbl_moniker = $schema->loader->monikers->{foo_tbl};
442 # $foo_tbl_moniker would look like "FooTbl"
446 Returns a hashref of table-to-classname mappings for the original database
447 table names. You probably shouldn't be using this for any normal or simple
448 usage of your Schema. The usual way to run queries on your tables is via
449 C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
450 returned by C<monikers> above.
452 my $classes = $schema->loader->classes;
453 my $foo_tbl_class = $classes->{foo_tbl};
455 my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
456 # $foo_tbl_class would look like "My::Schema::FooTbl",
457 # assuming the schema class is "My::Schema"
461 L<DBIx::Class::Schema::Loader>