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);
234 # Load and setup classes
238 my @tables = $self->_tables();
239 my @db_classes = $self->_db_classes();
240 my $schema = $self->schema;
242 foreach my $table (@tables) {
243 my $constraint = $self->constraint;
244 my $exclude = $self->exclude;
246 next unless $table =~ /$constraint/;
247 next if defined $exclude && $table =~ /$exclude/;
249 my ($db_schema, $tbl) = split /\./, $table;
250 my $tablename = lc $table;
252 $tablename = $self->drop_db_schema ? $tbl : lc $table;
254 my $lc_tblname = lc $tablename;
256 my $table_moniker = $self->_table2moniker($db_schema, $tbl);
257 my $table_class = $schema . q{::} . $table_moniker;
259 # XXX all of this needs require/eval error checking
260 $schema->inject_base( $table_class, 'DBIx::Class::Core' );
261 $_->require for @db_classes;
262 $schema->inject_base( $table_class, $_ ) for @db_classes;
263 $schema->inject_base( $table_class, $_ )
264 for @{$self->additional_base_classes};
265 eval "package $table_class; use $_;"
266 for @{$self->additional_classes};
267 $schema->inject_base( $table_class, $_ )
268 for @{$self->left_base_classes};
270 warn qq/\# Initializing table "$tablename" as "$table_class"\n/
272 $table_class->table($lc_tblname);
274 my ( $cols, $pks ) = $self->_table_info($table);
275 carp("$table has no primary key") unless @$pks;
276 $table_class->add_columns(@$cols);
277 $table_class->set_primary_key(@$pks) if @$pks;
279 warn qq/$table_class->table('$tablename');\n/ if $self->debug;
280 my $columns = join "', '", @$cols;
281 warn qq/$table_class->add_columns('$columns')\n/ if $self->debug;
282 my $primaries = join "', '", @$pks;
283 warn qq/$table_class->set_primary_key('$primaries')\n/
284 if $self->debug && @$pks;
286 $schema->register_class($table_moniker, $table_class);
287 $self->classes->{$lc_tblname} = $table_class;
288 $self->monikers->{$lc_tblname} = $table_moniker;
294 Returns a sorted list of tables.
296 my @tables = $loader->tables;
303 return sort keys %{ $self->monikers };
306 # Find and setup relationships
307 sub _load_relationships {
310 my $dbh = $self->schema->storage->dbh;
311 my $quoter = $dbh->get_info(29) || q{"};
312 foreach my $table ( $self->tables ) {
314 my $sth = $dbh->foreign_key_info( '',
315 $self->db_schema, '', '', '', $table );
317 while(my $raw_rel = $sth->fetchrow_hashref) {
318 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
319 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
320 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
321 my $relid = lc $raw_rel->{UK_NAME};
322 $uk_tbl =~ s/$quoter//g;
323 $uk_col =~ s/$quoter//g;
324 $fk_col =~ s/$quoter//g;
325 $relid =~ s/$quoter//g;
326 $rels->{$relid}->{tbl} = $uk_tbl;
327 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
330 foreach my $relid (keys %$rels) {
331 my $reltbl = $rels->{$relid}->{tbl};
332 my $cond = $rels->{$relid}->{cols};
333 eval { $self->_make_cond_rel( $table, $reltbl, $cond ) };
334 warn qq/\# belongs_to_many failed "$@"\n\n/
335 if $@ && $self->debug;
340 # Make a moniker from a table
342 my ( $self, $db_schema, $table ) = @_;
347 $db_schema = ucfirst lc $db_schema;
348 $db_schema_ns = $db_schema if(!$self->drop_db_schema);
353 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
354 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
359 # Overload in driver class
360 sub _tables { croak "ABSTRACT METHOD" }
362 sub _table_info { croak "ABSTRACT METHOD" }
366 L<DBIx::Class::Schema::Loader>