1 package DBIx::Class::Schema::Loader::Generic;
7 use Lingua::EN::Inflect;
8 use base qw/Class::Accessor::Fast/;
10 require DBIx::Class::Core;
12 # The first group are all arguments which are may be defaulted within,
13 # The last two (classes, monikers) are generated locally:
15 __PACKAGE__->mk_ro_accessors(qw/
24 additional_base_classes
38 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
42 See L<DBIx::Class::Schema::Loader>
48 Available constructor options are:
50 =head3 additional_base_classes
52 List of additional base classes your table classes will use.
54 =head3 left_base_classes
56 List of additional base classes, that need to be leftmost.
58 =head3 additional_classes
60 List of additional classes which your table classes will use.
64 Only load tables matching regex.
68 Exclude tables matching regex.
72 Enable debug messages.
84 Try to automatically detect/setup has_a and has_many relationships.
88 An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
89 Useful for foreign language column names.
101 Constructor for L<DBIx::Class::Schema::Loader::Generic>, used internally
102 by L<DBIx::Class::Schema::Loader>.
106 # ensure that a peice of object data is a valid arrayref, creating
107 # an empty one or encapsulating whatever's there.
108 sub _ensure_arrayref {
113 $self->{$_} = [ $self->{$_} ]
114 unless ref $self->{$_} eq 'ARRAY';
119 my ( $class, %args ) = @_;
121 my $self = { %args };
123 bless $self => $class;
125 $self->{db_schema} ||= '';
126 $self->{constraint} ||= '.*';
127 $self->{inflect} ||= {};
128 $self->_ensure_arrayref(qw/additional_classes
129 additional_base_classes
132 $self->{monikers} = {};
133 $self->{classes} = {};
135 $self->schema->connection($self->dsn, $self->user,
136 $self->password, $self->options);
138 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
141 $self->_load_classes;
142 $self->_load_relationships if $self->relationships;
144 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
146 $self->schema->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later?
151 # Overload in your driver class
152 sub _db_classes { croak "ABSTRACT METHOD" }
154 # Inflect a relationship name
155 # XXX (should pluralize, but currently also tends to de-pluralize plurals)
156 sub _inflect_relname {
157 my ($self, $relname) = @_;
159 return $self->inflect->{$relname} if exists $self->inflect->{$relname};
160 return Lingua::EN::Inflect::PL($relname);
163 # Set up a simple relation with just a local col and foreign table
164 sub _make_simple_rel {
165 my ($self, $table, $other, $col) = @_;
167 my $table_class = $self->classes->{$table};
168 my $other_class = $self->classes->{$other};
169 my $table_relname = $self->_inflect_relname(lc $table);
171 warn qq/\# Belongs_to relationship\n/ if $self->debug;
172 warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
174 $table_class->belongs_to( $col => $other_class );
176 warn qq/\# Has_many relationship\n/ if $self->debug;
177 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
181 $other_class->has_many( $table_relname => $table_class, $col);
184 # not a class method, just a helper for cond_rel XXX
185 sub _stringify_hash {
189 join(q{, }, map("$_ => $href->{$_}", keys %$href))
193 # Set up a complex relation based on a hashref condition
195 my ( $self, $table, $other, $cond ) = @_;
197 my $table_class = $self->classes->{$table};
198 my $other_class = $self->classes->{$other};
199 my $table_relname = $self->_inflect_relname(lc $table);
200 my $other_relname = lc $other;
202 # for single-column case, set the relname to the column name,
203 # to make filter accessors work
204 if(scalar keys %$cond == 1) {
205 my ($col) = keys %$cond;
206 $other_relname = $cond->{$col};
209 my $rev_cond = { reverse %$cond };
211 my $cond_printable = _stringify_hash($cond)
213 my $rev_cond_printable = _stringify_hash($rev_cond)
216 warn qq/\# Belongs_to relationship\n/ if $self->debug;
218 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
219 . qq/$cond_printable);\n\n/
222 $table_class->belongs_to( $other_relname => $other_class, $cond);
224 warn qq/\# Has_many relationship\n/ if $self->debug;
226 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
227 . qq/$rev_cond_printable);\n\n/
231 $other_class->has_many( $table_relname => $table_class, $rev_cond);
239 $_->require or croak ($_ . "->require: $@");
240 eval "package $target; use $_;";
241 croak "use $_: $@" if $@;
248 my $schema = $self->schema;
251 $_->require or croak ($_ . "->require: $@");
252 $schema->inject_base($target, $_);
256 # Load and setup classes
260 my @tables = $self->_tables();
261 my @db_classes = $self->_db_classes();
262 my $schema = $self->schema;
264 foreach my $table (@tables) {
265 my $constraint = $self->constraint;
266 my $exclude = $self->exclude;
268 next unless $table =~ /$constraint/;
269 next if defined $exclude && $table =~ /$exclude/;
271 my ($db_schema, $tbl) = split /\./, $table;
272 my $tablename = lc $table;
274 $tablename = $self->drop_db_schema ? $tbl : lc $table;
276 my $lc_tblname = lc $tablename;
278 my $table_moniker = $self->_table2moniker($db_schema, $tbl);
279 my $table_class = $schema . q{::} . $table_moniker;
281 $self->_inject($table_class, 'DBIx::Class::Core');
282 $self->_inject($table_class, @db_classes);
283 $self->_inject($table_class, @{$self->additional_base_classes});
284 $self->_use ($table_class, @{$self->additional_classes});
285 $self->_inject($table_class, @{$self->left_base_classes});
287 warn qq/\# Initializing table "$tablename" as "$table_class"\n/
289 $table_class->table($lc_tblname);
291 my ( $cols, $pks ) = $self->_table_info($table);
292 carp("$table has no primary key") unless @$pks;
293 $table_class->add_columns(@$cols);
294 $table_class->set_primary_key(@$pks) if @$pks;
296 warn qq/$table_class->table('$tablename');\n/ if $self->debug;
297 my $columns = join "', '", @$cols;
298 warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
299 my $primaries = join "', '", @$pks;
300 warn qq/$table_class->set_primary_key('$primaries')\n/
301 if $self->debug && @$pks;
303 $schema->register_class($table_moniker, $table_class);
304 $self->classes->{$lc_tblname} = $table_class;
305 $self->monikers->{$lc_tblname} = $table_moniker;
311 Returns a sorted list of tables.
313 my @tables = $loader->tables;
320 return sort keys %{ $self->monikers };
323 # Find and setup relationships
324 sub _load_relationships {
327 my $dbh = $self->schema->storage->dbh;
328 my $quoter = $dbh->get_info(29) || q{"};
329 foreach my $table ( $self->tables ) {
331 my $sth = $dbh->foreign_key_info( '',
332 $self->db_schema, '', '', '', $table );
334 while(my $raw_rel = $sth->fetchrow_hashref) {
335 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
336 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
337 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
338 my $relid = lc $raw_rel->{UK_NAME};
339 $uk_tbl =~ s/$quoter//g;
340 $uk_col =~ s/$quoter//g;
341 $fk_col =~ s/$quoter//g;
342 $relid =~ s/$quoter//g;
343 $rels->{$relid}->{tbl} = $uk_tbl;
344 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
347 foreach my $relid (keys %$rels) {
348 my $reltbl = $rels->{$relid}->{tbl};
349 my $cond = $rels->{$relid}->{cols};
350 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
351 warn qq/\# belongs_to_many failed "$@"\n\n/
352 if $@ && $self->debug;
357 # Make a moniker from a table
359 my ( $self, $db_schema, $table ) = @_;
364 $db_schema = ucfirst lc $db_schema;
365 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
370 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
371 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
376 # Overload in driver class
377 sub _tables { croak "ABSTRACT METHOD" }
379 sub _table_info { croak "ABSTRACT METHOD" }
383 L<DBIx::Class::Schema::Loader>