1 package DBIx::Class::Schema::Loader::Generic;
8 use Lingua::EN::Inflect;
9 use base qw/Class::Accessor::Fast/;
11 require DBIx::Class::Core;
13 # The first group are all arguments which are may be defaulted within,
14 # The last two (classes, monikers) are generated locally:
16 __PACKAGE__->mk_ro_accessors(qw/
25 additional_base_classes
39 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
43 See L<DBIx::Class::Schema::Loader>
49 Available constructor options are:
51 =head3 additional_base_classes
53 List of additional base classes your table classes will use.
55 =head3 left_base_classes
57 List of additional base classes, that need to be leftmost.
59 =head3 additional_classes
61 List of additional classes which your table classes will use.
65 Only load tables matching regex.
69 Exclude tables matching regex.
73 Enable debug messages.
85 Try to automatically detect/setup has_a and has_many relationships.
89 An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
90 Useful for foreign language column names.
102 Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
103 by L<DBIx::Class::Schema::Loader>.
107 Does the actual schema-construction work, used internally by
108 L<DBIx::Class::Schema::Loader> right after object construction.
112 # ensure that a peice of object data is a valid arrayref, creating
113 # an empty one or encapsulating whatever's there.
114 sub _ensure_arrayref {
119 $self->{$_} = [ $self->{$_} ]
120 unless ref $self->{$_} eq 'ARRAY';
125 my ( $class, %args ) = @_;
127 my $self = { %args };
129 bless $self => $class;
131 $self->{db_schema} ||= '';
132 $self->{constraint} ||= '.*';
133 $self->{inflect} ||= {};
134 $self->_ensure_arrayref(qw/additional_classes
135 additional_base_classes
138 $self->{monikers} = {};
139 $self->{classes} = {};
147 $self->schema->connection($self->dsn, $self->user,
148 $self->password, $self->options);
150 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
153 $self->_load_classes;
154 $self->_load_relationships if $self->relationships;
156 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
158 $self->schema->storage->disconnect;
163 # Overload in your driver class
164 sub _db_classes { croak "ABSTRACT METHOD" }
166 # Inflect a relationship name
167 # XXX (should pluralize, but currently also tends to de-pluralize plurals)
168 sub _inflect_relname {
169 my ($self, $relname) = @_;
171 return $self->inflect->{$relname} if exists $self->inflect->{$relname};
172 return Lingua::EN::Inflect::PL($relname);
175 # Set up a simple relation with just a local col and foreign table
176 sub _make_simple_rel {
177 my ($self, $table, $other, $col) = @_;
179 my $table_class = $self->classes->{$table};
180 my $other_class = $self->classes->{$other};
181 my $table_relname = $self->_inflect_relname(lc $table);
183 warn qq/\# Belongs_to relationship\n/ if $self->debug;
184 warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
186 $table_class->belongs_to( $col => $other_class );
188 warn qq/\# Has_many relationship\n/ if $self->debug;
189 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
193 $other_class->has_many( $table_relname => $table_class, $col);
196 # not a class method, just a helper for cond_rel XXX
197 sub _stringify_hash {
201 join(q{, }, map("$_ => $href->{$_}", keys %$href))
205 # Set up a complex relation based on a hashref condition
207 my ( $self, $table, $other, $cond ) = @_;
209 my $table_class = $self->classes->{$table};
210 my $other_class = $self->classes->{$other};
211 my $table_relname = $self->_inflect_relname(lc $table);
212 my $other_relname = lc $other;
214 # for single-column case, set the relname to the column name,
215 # to make filter accessors work
216 if(scalar keys %$cond == 1) {
217 my ($col) = keys %$cond;
218 $other_relname = $cond->{$col};
221 my $rev_cond = { reverse %$cond };
223 my $cond_printable = _stringify_hash($cond)
225 my $rev_cond_printable = _stringify_hash($rev_cond)
228 warn qq/\# Belongs_to relationship\n/ if $self->debug;
230 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
231 . qq/$cond_printable);\n\n/
234 $table_class->belongs_to( $other_relname => $other_class, $cond);
236 warn qq/\# Has_many relationship\n/ if $self->debug;
238 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
239 . qq/$rev_cond_printable);\n\n/
243 $other_class->has_many( $table_relname => $table_class, $rev_cond);
251 $_->require or croak ($_ . "->require: $@");
252 eval "package $target; use $_;";
253 croak "use $_: $@" if $@;
260 my $schema = $self->schema;
263 $_->require or croak ($_ . "->require: $@");
264 $schema->inject_base($target, $_);
268 # Load and setup classes
272 my @tables = $self->_tables();
273 my @db_classes = $self->_db_classes();
274 my $schema = $self->schema;
276 foreach my $table (@tables) {
277 my $constraint = $self->constraint;
278 my $exclude = $self->exclude;
280 next unless $table =~ /$constraint/;
281 next if defined $exclude && $table =~ /$exclude/;
283 my ($db_schema, $tbl) = split /\./, $table;
284 my $tablename = lc $table;
286 $tablename = $self->drop_db_schema ? $tbl : lc $table;
288 my $lc_tblname = lc $tablename;
290 my $table_moniker = $self->_table2moniker($db_schema, $tbl);
291 my $table_class = $schema . q{::} . $table_moniker;
293 $self->_inject($table_class, 'DBIx::Class::Core');
294 $self->_inject($table_class, @db_classes);
295 $self->_inject($table_class, @{$self->additional_base_classes});
296 $self->_use ($table_class, @{$self->additional_classes});
297 $self->_inject($table_class, @{$self->left_base_classes});
299 warn qq/\# Initializing table "$tablename" as "$table_class"\n/
301 $table_class->table($lc_tblname);
303 my ( $cols, $pks ) = $self->_table_info($table);
304 carp("$table has no primary key") unless @$pks;
305 $table_class->add_columns(@$cols);
306 $table_class->set_primary_key(@$pks) if @$pks;
308 warn qq/$table_class->table('$tablename');\n/ if $self->debug;
309 my $columns = join "', '", @$cols;
310 warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
311 my $primaries = join "', '", @$pks;
312 warn qq/$table_class->set_primary_key('$primaries')\n/
313 if $self->debug && @$pks;
315 $schema->register_class($table_moniker, $table_class);
316 $self->classes->{$lc_tblname} = $table_class;
317 $self->monikers->{$lc_tblname} = $table_moniker;
323 Returns a sorted list of loaded tables, using the original database table
324 names. Actually generated from the keys of the C<monikers> hash below.
326 my @tables = $schema->loader->tables;
330 Returns a hashref of loaded table-to-moniker mappings for the original
331 database table names.
333 my $monikers = $schema->loader->monikers;
334 my $foo_tbl_moniker = $monikers->{foo_tbl};
336 my $foo_tbl_moniker = $schema->loader->monikers->{foo_tbl};
337 # $foo_tbl_moniker would look like "FooTbl"
341 Returns a hashref of table-to-classname mappings for the original database
342 table names. You probably shouldn't be using this, as operating on the
343 original class names is usually a bad idea. This hook is here for people
344 who want to do strange and/or possibly broken things. The usual way to
345 get at things is C<$schema->resultset('FooTbl')>, where C<FooTbl> is a
346 moniker as returned by C<monikers> above.
348 my $classes = $schema->loader->classes;
349 my $foo_tbl_class = $classes->{foo_tbl};
351 my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
352 # $foo_tbl_class would look like "My::Schema::FooTbl",
353 # assuming the schema class is "My::Schema"
360 return sort keys %{ $self->monikers };
363 # Find and setup relationships
364 sub _load_relationships {
367 my $dbh = $self->schema->storage->dbh;
368 my $quoter = $dbh->get_info(29) || q{"};
369 foreach my $table ( $self->tables ) {
371 my $sth = $dbh->foreign_key_info( '',
372 $self->db_schema, '', '', '', $table );
374 while(my $raw_rel = $sth->fetchrow_hashref) {
375 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
376 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
377 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
378 my $relid = lc $raw_rel->{UK_NAME};
379 $uk_tbl =~ s/$quoter//g;
380 $uk_col =~ s/$quoter//g;
381 $fk_col =~ s/$quoter//g;
382 $relid =~ s/$quoter//g;
383 $rels->{$relid}->{tbl} = $uk_tbl;
384 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
387 foreach my $relid (keys %$rels) {
388 my $reltbl = $rels->{$relid}->{tbl};
389 my $cond = $rels->{$relid}->{cols};
390 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
391 warn qq/\# belongs_to_many failed "$@"\n\n/
392 if $@ && $self->debug;
397 # Make a moniker from a table
399 my ( $self, $db_schema, $table ) = @_;
404 $db_schema = ucfirst lc $db_schema;
405 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
410 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
411 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
416 # Overload in driver class
417 sub _tables { croak "ABSTRACT METHOD" }
419 sub _table_info { croak "ABSTRACT METHOD" }
423 L<DBIx::Class::Schema::Loader>