1 package DBIx::Class::Schema::Loader::Generic;
6 use base qw/DBIx::Class::Schema/;
9 use Lingua::EN::Inflect;
11 require DBIx::Class::Core;
13 __PACKAGE__->mk_classaccessor('_loader_inflect');
14 __PACKAGE__->mk_classaccessor('_loader_db_schema');
15 __PACKAGE__->mk_classaccessor('_loader_drop_db_schema');
16 __PACKAGE__->mk_classaccessor('_loader_classes' => {} );
17 __PACKAGE__->mk_classaccessor('_loader_monikers' => {} );
18 __PACKAGE__->mk_classaccessor('_loader_debug' => 0);
22 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
26 See L<DBIx::Class::Schema::Loader>
32 Available constructor options are:
34 =head3 additional_base_classes
36 List of additional base classes your table classes will use.
38 =head3 left_base_classes
40 List of additional base classes, that need to be leftmost.
42 =head3 additional_classes
44 List of additional classes which your table classes will use.
48 Only load tables matching regex.
52 Exclude tables matching regex.
56 Enable debug messages.
68 Try to automatically detect/setup has_a and has_many relationships.
72 An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
73 Useful for foreign language column names.
85 Not intended to be called directly. This is used internally by the
86 C<new()> method in L<DBIx::Class::Schema::Loader>.
90 sub _load_from_connection {
91 my ( $class, %args ) = @_;
93 $class->_loader_debug(1) if $args{debug};
94 $class->_loader_inflect($args{inflect});
95 $class->_loader_db_schema($args{db_schema} || '');
96 $class->_loader_drop_db_schema($args{drop_db_schema});
98 my $additional = $args{additional_classes} || [];
99 $additional = [$additional] unless ref $additional eq 'ARRAY';
101 my $additional_base = $args{additional_base_classes} || [];
102 $additional_base = [$additional_base]
103 unless ref $additional_base eq 'ARRAY';
105 my $left_base = $args{left_base_classes} || [];
106 $left_base = [$left_base] unless ref $left_base eq 'ARRAY';
108 my %load_classes_args = (
109 additional => $additional,
110 additional_base => $additional_base,
111 left_base => $left_base,
112 constraint => $args{constraint} || '.*',
113 exclude => $args{exclude},
116 $class->connection($args{dsn}, $args{user},
117 $args{password}, $args{options});
119 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
120 if $class->_loader_debug;
122 $class->_loader_load_classes(%load_classes_args);
123 $class->_loader_relationships if $args{relationships};
125 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
126 if $class->_loader_debug;
127 $class->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later?
132 # The original table class name during Loader,
133 sub _loader_find_table_class {
134 my ( $class, $table ) = @_;
135 return $class->_loader_classes->{$table};
138 # Returns the moniker for a given table name,
139 # for use in $conn->resultset($moniker)
143 Returns the moniker for a given literal table name. Used
144 as $schema->resultset($moniker), etc.
148 my ( $class, $table ) = @_;
149 return $class->_loader_monikers->{$table};
154 Returns a sorted list of tables.
156 my @tables = $loader->tables;
162 return sort keys %{ $class->_loader_monikers };
165 # Overload in your driver class
166 sub _loader_db_classes { croak "ABSTRACT METHOD" }
168 # not a class method.
169 sub _loader_stringify_hash {
173 join(q{, }, map("$_ => $href->{$_}", keys %$href))
177 # Inflect a relationship name
178 # XXX (should pluralize, but currently also tends to de-pluralize plurals)
179 sub _loader_inflect_relname {
180 my ($class, $relname) = @_;
182 if(my $inflections = $class->_loader_inflect) {
183 $relname = $inflections->{$relname}
184 if exists $inflections->{$relname};
187 $relname = Lingua::EN::Inflect::PL($relname);
193 # Set up a simple relation with just a local col and foreign table
194 sub _loader_make_simple_rel {
195 my ($class, $table, $other, $col) = @_;
197 my $table_class = $class->_loader_find_table_class($table);
198 my $other_class = $class->_loader_find_table_class($other);
199 my $table_relname = $class->_loader_inflect_relname(lc $table);
201 warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
202 warn qq/$table_class->belongs_to( '$col' => '$other_class' );\n\n/
203 if $class->_loader_debug;
204 $table_class->belongs_to( $col => $other_class );
206 warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
207 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
209 if $class->_loader_debug;
211 $other_class->has_many( $table_relname => $table_class, $col);
214 # Set up a complex relation based on a hashref condition
215 sub _loader_make_cond_rel {
216 my ( $class, $table, $other, $cond ) = @_;
218 my $table_class = $class->_loader_find_table_class($table);
219 my $other_class = $class->_loader_find_table_class($other);
220 my $table_relname = $class->_loader_inflect_relname(lc $table);
221 my $other_relname = lc $other;
223 # for single-column case, set the relname to the column name,
224 # to make filter accessors work
225 if(scalar keys %$cond == 1) {
226 my ($col) = keys %$cond;
227 $other_relname = $cond->{$col};
230 my $rev_cond = { reverse %$cond };
232 my $cond_printable = _loader_stringify_hash($cond)
233 if $class->_loader_debug;
234 my $rev_cond_printable = _loader_stringify_hash($rev_cond)
235 if $class->_loader_debug;
237 warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
239 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
240 . qq/$cond_printable);\n\n/
241 if $class->_loader_debug;
243 $table_class->belongs_to( $other_relname => $other_class, $cond);
245 warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
247 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
248 . qq/$rev_cond_printable);\n\n/
250 if $class->_loader_debug;
252 $other_class->has_many( $table_relname => $table_class, $rev_cond);
255 # Load and setup classes
256 sub _loader_load_classes {
257 my ($class, %args) = @_;
259 my $additional = join '',
260 map "use $_;\n", @{$args{additional}};
262 my @tables = $class->_loader_tables();
263 my @db_classes = $class->_loader_db_classes();
265 foreach my $table (@tables) {
266 next unless $table =~ /$args{constraint}/;
267 next if defined $args{exclude} && $table =~ /$args{exclude}/;
269 my ($db_schema, $tbl) = split /\./, $table;
270 my $tablename = lc $table;
272 $tablename = $class->_loader_drop_db_schema ? $tbl : lc $table;
274 my $lc_tblname = lc $tablename;
276 my $table_moniker = $class->_loader_table2moniker($db_schema, $tbl);
277 my $table_class = "$class\::$table_moniker";
279 # XXX all of this needs require/eval error checking
280 $class->inject_base( $table_class, 'DBIx::Class::Core' );
281 $_->require for @db_classes;
282 $class->inject_base( $table_class, $_ ) for @db_classes;
283 $class->inject_base( $table_class, $_ ) for @{$args{additional_base}};
284 eval "package $table_class;$_;" for @{$args{additional}};
285 $class->inject_base( $table_class, $_ ) for @{$args{left_base}};
287 warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->_loader_debug;
288 $table_class->table($lc_tblname);
290 my ( $cols, $pks ) = $class->_loader_table_info($table);
291 carp("$table has no primary key") unless @$pks;
292 $table_class->add_columns(@$cols);
293 $table_class->set_primary_key(@$pks) if @$pks;
295 warn qq/$table_class->table('$tablename');\n/ if $class->_loader_debug;
296 my $columns = join "', '", @$cols;
297 warn qq/$table_class->add_columns('$columns')\n/ if $class->_loader_debug;
298 my $primaries = join "', '", @$pks;
299 warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->_loader_debug && @$pks;
301 $class->register_class($table_moniker, $table_class);
302 $class->_loader_classes->{$lc_tblname} = $table_class;
303 $class->_loader_monikers->{$lc_tblname} = $table_moniker;
307 # Find and setup relationships
308 sub _loader_relationships {
310 my $dbh = $class->storage->dbh;
311 my $quoter = $dbh->get_info(29) || q{"};
312 foreach my $table ( $class->tables ) {
314 my $sth = $dbh->foreign_key_info( '',
315 $class->_loader_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 { $class->_loader_make_cond_rel( $table, $reltbl, $cond ) };
334 warn qq/\# belongs_to_many failed "$@"\n\n/
335 if $@ && $class->_loader_debug;
340 # Make a moniker from a table
341 sub _loader_table2moniker {
342 my ( $class, $db_schema, $table ) = @_;
347 $db_schema = ucfirst lc $db_schema;
348 $db_schema_ns = $db_schema if(!$class->_loader_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 _loader_tables { croak "ABSTRACT METHOD" }
362 sub _loader_table_info { croak "ABSTRACT METHOD" }
366 L<DBIx::Class::Schema::Loader>