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 for any normal or simple
343 usage of your Schema. The usual way to run queries on your tables is via
344 C<$schema-E<gt>resultset('FooTbl')>, where C<FooTbl> is a moniker as
345 returned by C<monikers> above.
347 my $classes = $schema->loader->classes;
348 my $foo_tbl_class = $classes->{foo_tbl};
350 my $foo_tbl_class = $schema->loader->classes->{foo_tbl};
351 # $foo_tbl_class would look like "My::Schema::FooTbl",
352 # assuming the schema class is "My::Schema"
359 return sort keys %{ $self->monikers };
362 # Find and setup relationships
363 sub _load_relationships {
366 my $dbh = $self->schema->storage->dbh;
367 my $quoter = $dbh->get_info(29) || q{"};
368 foreach my $table ( $self->tables ) {
370 my $sth = $dbh->foreign_key_info( '',
371 $self->db_schema, '', '', '', $table );
373 while(my $raw_rel = $sth->fetchrow_hashref) {
374 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
375 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
376 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
377 my $relid = lc $raw_rel->{UK_NAME};
378 $uk_tbl =~ s/$quoter//g;
379 $uk_col =~ s/$quoter//g;
380 $fk_col =~ s/$quoter//g;
381 $relid =~ s/$quoter//g;
382 $rels->{$relid}->{tbl} = $uk_tbl;
383 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
386 foreach my $relid (keys %$rels) {
387 my $reltbl = $rels->{$relid}->{tbl};
388 my $cond = $rels->{$relid}->{cols};
389 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
390 warn qq/\# belongs_to_many failed "$@"\n\n/
391 if $@ && $self->debug;
396 # Make a moniker from a table
398 my ( $self, $db_schema, $table ) = @_;
403 $db_schema = ucfirst lc $db_schema;
404 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
409 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
410 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
415 # Overload in driver class
416 sub _tables { croak "ABSTRACT METHOD" }
418 sub _table_info { croak "ABSTRACT METHOD" }
422 L<DBIx::Class::Schema::Loader>