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 # Setup has_a and has_many relationships
178 sub _loader_make_relations {
180 my ( $class, $table, $other, $cond ) = @_;
181 my $table_class = $class->_loader_find_table_class($table);
182 my $other_class = $class->_loader_find_table_class($other);
184 my $table_relname = lc $table;
185 my $other_relname = lc $other;
187 if(my $inflections = $class->_loader_inflect) {
188 $table_relname = $inflections->{$table_relname}
189 if exists $inflections->{$table_relname};
192 $table_relname = Lingua::EN::Inflect::PL($table_relname);
195 if(ref($cond) eq 'HASH') {
196 # for single-column case, set the relname to the column name,
197 # to make filter accessors work
198 if(scalar keys %$cond == 1) {
199 my ($col) = keys %$cond;
200 $other_relname = $cond->{$col};
203 my $rev_cond = { reverse %$cond };
205 my $cond_printable = _loader_stringify_hash($cond)
206 if $class->_loader_debug;
207 my $rev_cond_printable = _loader_stringify_hash($rev_cond)
208 if $class->_loader_debug;
210 warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
212 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
213 . qq/$cond_printable);\n\n/
214 if $class->_loader_debug;
216 $table_class->belongs_to( $other_relname => $other_class, $cond);
218 warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
220 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
221 . qq/$rev_cond_printable);\n\n/
223 if $class->_loader_debug;
225 $other_class->has_many( $table_relname => $table_class, $rev_cond);
227 else { # implicit stuff, just a col name
228 warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
229 warn qq/$table_class->belongs_to( '$cond' => '$other_class' );\n\n/
230 if $class->_loader_debug;
231 $table_class->belongs_to( $cond => $other_class );
233 warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
234 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
236 if $class->_loader_debug;
238 $other_class->has_many( $table_relname => $table_class, $cond);
242 # Load and setup classes
243 sub _loader_load_classes {
244 my ($class, %args) = @_;
246 my $additional = join '',
247 map "use $_;\n", @{$args{additional}};
249 my @tables = $class->_loader_tables();
250 my @db_classes = $class->_loader_db_classes();
252 foreach my $table (@tables) {
253 next unless $table =~ /$args{constraint}/;
254 next if defined $args{exclude} && $table =~ /$args{exclude}/;
256 my ($db_schema, $tbl) = split /\./, $table;
257 my $tablename = lc $table;
259 $tablename = $class->_loader_drop_db_schema ? $tbl : lc $table;
261 my $lc_tblname = lc $tablename;
263 my $table_moniker = $class->_loader_table2moniker($db_schema, $tbl);
264 my $table_class = "$class\::$table_moniker";
266 # XXX all of this needs require/eval error checking
267 $class->inject_base( $table_class, 'DBIx::Class::Core' );
268 $_->require for @db_classes;
269 $class->inject_base( $table_class, $_ ) for @db_classes;
270 $class->inject_base( $table_class, $_ ) for @{$args{additional_base}};
271 eval "package $table_class;$_;" for @{$args{additional}};
272 $class->inject_base( $table_class, $_ ) for @{$args{left_base}};
274 warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->_loader_debug;
275 $table_class->table($lc_tblname);
277 my ( $cols, $pks ) = $class->_loader_table_info($table);
278 carp("$table has no primary key") unless @$pks;
279 $table_class->add_columns(@$cols);
280 $table_class->set_primary_key(@$pks) if @$pks;
282 warn qq/$table_class->table('$tablename');\n/ if $class->_loader_debug;
283 my $columns = join "', '", @$cols;
284 warn qq/$table_class->add_columns('$columns')\n/ if $class->_loader_debug;
285 my $primaries = join "', '", @$pks;
286 warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->_loader_debug && @$pks;
288 $class->register_class($table_moniker, $table_class);
289 $class->_loader_classes->{$lc_tblname} = $table_class;
290 $class->_loader_monikers->{$lc_tblname} = $table_moniker;
294 # Find and setup relationships
295 sub _loader_relationships {
297 my $dbh = $class->storage->dbh;
298 my $quoter = $dbh->get_info(29) || q{"};
299 foreach my $table ( $class->tables ) {
301 my $sth = $dbh->foreign_key_info( '',
302 $class->_loader_db_schema, '', '', '', $table );
304 while(my $raw_rel = $sth->fetchrow_hashref) {
305 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
306 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
307 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
308 my $relid = lc $raw_rel->{UK_NAME};
309 $uk_tbl =~ s/$quoter//g;
310 $uk_col =~ s/$quoter//g;
311 $fk_col =~ s/$quoter//g;
312 $relid =~ s/$quoter//g;
313 $rels->{$relid}->{tbl} = $uk_tbl;
314 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
317 foreach my $relid (keys %$rels) {
318 my $reltbl = $rels->{$relid}->{tbl};
319 my $cond = $rels->{$relid}->{cols};
320 eval { $class->_loader_make_relations( $table, $reltbl, $cond ) };
321 warn qq/\# belongs_to_many failed "$@"\n\n/
322 if $@ && $class->_loader_debug;
327 # Make a moniker from a table
328 sub _loader_table2moniker {
329 my ( $class, $db_schema, $table ) = @_;
334 $db_schema = ucfirst lc $db_schema;
335 $db_schema_ns = $db_schema if(!$class->_loader_drop_db_schema);
340 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
341 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
346 # Overload in driver class
347 sub _loader_tables { croak "ABSTRACT METHOD" }
349 sub _loader_table_info { croak "ABSTRACT METHOD" }
353 L<DBIx::Class::Schema::Loader>