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
37 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
41 See L<DBIx::Class::Schema::Loader>
45 This is the base class for the vendor-specific C<DBIx::Class::Schema::*>
46 classes, and implements the common functionality between them.
50 Available constructor options are:
52 =head2 additional_base_classes
54 List of additional base classes your table classes will use.
56 =head2 left_base_classes
58 List of additional base classes, that need to be leftmost.
60 =head2 additional_classes
62 List of additional classes which your table classes will use.
66 Only load tables matching regex.
70 Exclude tables matching regex.
74 Enable debug messages.
86 Try to automatically detect/setup has_a and has_many relationships.
90 An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
91 Useful for foreign language column names.
101 # ensure that a peice of object data is a valid arrayref, creating
102 # an empty one or encapsulating whatever's there.
103 sub _ensure_arrayref {
108 $self->{$_} = [ $self->{$_} ]
109 unless ref $self->{$_} eq 'ARRAY';
115 Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
116 by L<DBIx::Class::Schema::Loader>.
121 my ( $class, %args ) = @_;
123 my $self = { %args };
125 bless $self => $class;
127 $self->{db_schema} ||= '';
128 $self->{constraint} ||= '.*';
129 $self->{inflect} ||= {};
130 $self->_ensure_arrayref(qw/additional_classes
131 additional_base_classes
134 $self->{monikers} = {};
135 $self->{classes} = {};
142 Does the actual schema-construction work, used internally by
143 L<DBIx::Class::Schema::Loader> right after object construction.
150 $self->schema->connection($self->dsn, $self->user,
151 $self->password, $self->options);
153 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
156 $self->_load_classes;
157 $self->_load_relationships if $self->relationships;
159 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
161 $self->schema->storage->disconnect;
166 # Overload in your driver class
167 sub _db_classes { croak "ABSTRACT METHOD" }
169 # Inflect a relationship name
170 # XXX (should pluralize, but currently also tends to de-pluralize plurals)
171 sub _inflect_relname {
172 my ($self, $relname) = @_;
174 return $self->inflect->{$relname} if exists $self->inflect->{$relname};
175 return Lingua::EN::Inflect::PL($relname);
178 # Set up a simple relation with just a local col and foreign table
179 sub _make_simple_rel {
180 my ($self, $table, $other, $col) = @_;
182 my $table_class = $self->classes->{$table};
183 my $other_class = $self->classes->{$other};
184 my $table_relname = $self->_inflect_relname(lc $table);
186 warn qq/\# Belongs_to relationship\n/ if $self->debug;
187 warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
189 $table_class->belongs_to( $col => $other_class );
191 warn qq/\# Has_many relationship\n/ if $self->debug;
192 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
196 $other_class->has_many( $table_relname => $table_class, $col);
199 # not a class method, just a helper for cond_rel XXX
200 sub _stringify_hash {
204 join(q{, }, map("$_ => $href->{$_}", keys %$href))
208 # Set up a complex relation based on a hashref condition
210 my ( $self, $table, $other, $cond ) = @_;
212 my $table_class = $self->classes->{$table};
213 my $other_class = $self->classes->{$other};
214 my $table_relname = $self->_inflect_relname(lc $table);
215 my $other_relname = lc $other;
217 # for single-column case, set the relname to the column name,
218 # to make filter accessors work
219 if(scalar keys %$cond == 1) {
220 my ($col) = keys %$cond;
221 $other_relname = $cond->{$col};
224 my $rev_cond = { reverse %$cond };
226 for (keys %$rev_cond) {
227 $rev_cond->{"foreign.$_"} = "self.".$rev_cond->{$_};
228 delete $rev_cond->{$_};
231 my $cond_printable = _stringify_hash($cond)
233 my $rev_cond_printable = _stringify_hash($rev_cond)
236 warn qq/\# Belongs_to relationship\n/ if $self->debug;
238 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
239 . qq/$cond_printable);\n\n/
242 $table_class->belongs_to( $other_relname => $other_class, $cond);
244 warn qq/\# Has_many relationship\n/ if $self->debug;
246 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
247 . qq/$rev_cond_printable);\n\n/
251 $other_class->has_many( $table_relname => $table_class, $rev_cond);
259 $_->require or croak ($_ . "->require: $@");
260 eval "package $target; use $_;";
261 croak "use $_: $@" if $@;
268 my $schema = $self->schema;
271 $_->require or croak ($_ . "->require: $@");
272 $schema->inject_base($target, $_);
276 # Load and setup classes
280 my @tables = $self->_tables();
281 my @db_classes = $self->_db_classes();
282 my $schema = $self->schema;
284 foreach my $table (@tables) {
285 my $constraint = $self->constraint;
286 my $exclude = $self->exclude;
288 next unless $table =~ /$constraint/;
289 next if defined $exclude && $table =~ /$exclude/;
291 my ($db_schema, $tbl) = split /\./, $table;
292 my $tablename = lc $table;
294 $tablename = $self->drop_db_schema ? $tbl : lc $table;
296 my $lc_tblname = lc $tablename;
298 my $table_moniker = $self->_table2moniker($db_schema, $tbl);
299 my $table_class = $schema . q{::} . $table_moniker;
301 $self->_inject($table_class, 'DBIx::Class::Core');
302 $self->_inject($table_class, @db_classes);
303 $self->_inject($table_class, @{$self->additional_base_classes});
304 $self->_use ($table_class, @{$self->additional_classes});
305 $self->_inject($table_class, @{$self->left_base_classes});
307 warn qq/\# Initializing table "$tablename" as "$table_class"\n/
309 $table_class->table($lc_tblname);
311 my ( $cols, $pks ) = $self->_table_info($table);
312 carp("$table has no primary key") unless @$pks;
313 $table_class->add_columns(@$cols);
314 $table_class->set_primary_key(@$pks) if @$pks;
316 warn qq/$table_class->table('$tablename');\n/ if $self->debug;
317 my $columns = join "', '", @$cols;
318 warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
319 my $primaries = join "', '", @$pks;
320 warn qq/$table_class->set_primary_key('$primaries')\n/
321 if $self->debug && @$pks;
323 $schema->register_class($table_moniker, $table_class);
324 $self->classes->{$lc_tblname} = $table_class;
325 $self->monikers->{$lc_tblname} = $table_moniker;
331 Returns a sorted list of loaded tables, using the original database table
332 names. Actually generated from the keys of the C<monikers> hash below.
334 my @tables = $schema->loader->tables;
341 return sort keys %{ $self->monikers };
344 # Find and setup relationships
345 sub _load_relationships {
348 my $dbh = $self->schema->storage->dbh;
349 my $quoter = $dbh->get_info(29) || q{"};
350 foreach my $table ( $self->tables ) {
352 my $sth = $dbh->foreign_key_info( '',
353 $self->db_schema, '', '', '', $table );
355 while(my $raw_rel = $sth->fetchrow_hashref) {
356 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
357 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
358 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
359 my $relid = lc $raw_rel->{UK_NAME};
360 $uk_tbl =~ s/$quoter//g;
361 $uk_col =~ s/$quoter//g;
362 $fk_col =~ s/$quoter//g;
363 $relid =~ s/$quoter//g;
364 $rels->{$relid}->{tbl} = $uk_tbl;
365 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
368 foreach my $relid (keys %$rels) {
369 my $reltbl = $rels->{$relid}->{tbl};
370 my $cond = $rels->{$relid}->{cols};
371 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
372 warn qq/\# belongs_to_many failed "$@"\n\n/
373 if $@ && $self->debug;
378 # Make a moniker from a table
380 my ( $self, $db_schema, $table ) = @_;
385 $db_schema = ucfirst lc $db_schema;
386 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
391 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
392 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
397 # Overload in driver class
398 sub _tables { croak "ABSTRACT METHOD" }
400 sub _table_info { croak "ABSTRACT METHOD" }
404 Returns a hashref of loaded table-to-moniker mappings for the original
405 database table names.
407 my $monikers = $schema->loader->monikers;
408 my $foo_tbl_moniker = $monikers->{foo_tbl};
410 my $foo_tbl_moniker = $schema->loader->monikers->{foo_tbl};
411 # $foo_tbl_moniker would look like "FooTbl"
415 Returns a hashref of table-to-classname mappings for the original database
416 table names. You probably shouldn't be using this for any normal or simple
417 usage of your Schema. The usual way to run queries on your tables is via
418 C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
419 returned by C<monikers> above.
421 my $classes = $schema->loader->classes;
422 my $foo_tbl_class = $classes->{foo_tbl};
424 my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
425 # $foo_tbl_class would look like "My::Schema::FooTbl",
426 # assuming the schema class is "My::Schema"
430 L<DBIx::Class::Schema::Loader>