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_classdata('_loader_data');
14 __PACKAGE__->mk_classdata('_loader_debug' => 0);
18 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
22 See L<DBIx::Class::Schema::Loader>
28 Available constructor options are:
30 =head3 additional_base_classes
32 List of additional base classes your table classes will use.
34 =head3 left_base_classes
36 List of additional base classes, that need to be leftmost.
38 =head3 additional_classes
40 List of additional classes which your table classes will use.
44 Only load tables matching regex.
48 Exclude tables matching regex.
52 Enable debug messages.
64 Try to automatically detect/setup has_a and has_many relationships.
68 An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
69 Useful for foreign language column names.
81 Not intended to be called directly. This is used internally by the
82 C<new()> method in L<DBIx::Class::Schema::Loader>.
86 sub _load_from_connection {
87 my ( $class, %args ) = @_;
89 $class->_loader_debug( $args{debug} ? 1 : 0);
91 my $additional = $args{additional_classes} || [];
92 $additional = [$additional] unless ref $additional eq 'ARRAY';
94 my $additional_base = $args{additional_base_classes} || [];
95 $additional_base = [$additional_base]
96 unless ref $additional_base eq 'ARRAY';
98 my $left_base = $args{left_base_classes} || [];
99 $left_base = [$left_base] unless ref $left_base eq 'ARRAY';
101 $class->_loader_data({
103 [ $args{dsn}, $args{user}, $args{password}, $args{options} ],
104 additional => $additional,
105 additional_base => $additional_base,
106 left_base => $left_base,
107 constraint => $args{constraint} || '.*',
108 exclude => $args{exclude},
109 relationships => $args{relationships},
110 inflect => $args{inflect},
111 db_schema => $args{db_schema} || '',
112 drop_db_schema => $args{drop_db_schema},
117 $class->connection(@{$class->_loader_data->{datasource}});
118 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
119 if $class->_loader_debug;
120 $class->_loader_load_classes;
121 $class->_loader_relationships if $class->_loader_data->{relationships};
122 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
123 if $class->_loader_debug;
124 $class->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later?
129 # The original table class name during Loader,
130 sub _loader_find_table_class {
131 my ( $class, $table ) = @_;
132 return $class->_loader_data->{TABLE_CLASSES}->{$table};
135 # Returns the moniker for a given table name,
136 # for use in $conn->resultset($moniker)
140 Returns the moniker for a given literal table name. Used
141 as $schema->resultset($moniker), etc.
145 my ( $class, $table ) = @_;
146 return $class->_loader_data->{MONIKERS}->{$table};
151 Returns a sorted list of tables.
153 my @tables = $loader->tables;
159 return sort keys %{ $class->_loader_data->{MONIKERS} };
162 # Overload in your driver class
163 sub _loader_db_classes { croak "ABSTRACT METHOD" }
165 # Setup has_a and has_many relationships
166 sub _loader_make_relations {
169 my ( $class, $table, $other, $cond ) = @_;
170 my $table_class = $class->_loader_find_table_class($table);
171 my $other_class = $class->_loader_find_table_class($other);
173 my $table_relname = lc $table;
174 my $other_relname = lc $other;
176 if(my $inflections = $class->_loader_data->{inflect}) {
177 $table_relname = $inflections->{$table_relname}
178 if exists $inflections->{$table_relname};
181 $table_relname = Lingua::EN::Inflect::PL($table_relname);
184 # for single-column case, set the relname to the column name,
185 # to make filter accessors work
186 if(scalar keys %$cond == 1) {
187 my ($col) = keys %$cond;
188 $other_relname = $cond->{$col};
191 my $rev_cond = { reverse %$cond };
193 warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
195 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
198 if $class->_loader_debug;
200 $table_class->belongs_to( $other_relname => $other_class, $cond);
202 warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
204 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
207 if $class->_loader_debug;
209 $other_class->has_many( $table_relname => $table_class, $rev_cond);
212 # Load and setup classes
213 sub _loader_load_classes {
216 my @tables = $class->_loader_tables();
217 my @db_classes = $class->_loader_db_classes();
218 my $additional = join '', map "use $_;\n", @{ $class->_loader_data->{additional} };
219 my $additional_base = join '', map "use base '$_';\n",
220 @{ $class->_loader_data->{additional_base} };
221 my $left_base = join '', map "use base '$_';\n", @{ $class->_loader_data->{left_base} };
222 my $constraint = $class->_loader_data->{constraint};
223 my $exclude = $class->_loader_data->{exclude};
225 foreach my $table (@tables) {
226 next unless $table =~ /$constraint/;
227 next if ( defined $exclude && $table =~ /$exclude/ );
229 my ($db_schema, $tbl) = split /\./, $table;
230 my $tablename = lc $table;
232 $tablename = $class->_loader_data->{drop_db_schema} ? $tbl : lc $table;
235 my $table_moniker = $class->_loader_table2moniker($db_schema, $tbl);
236 my $table_class = "$class\::$table_moniker";
238 $class->inject_base( $table_class, 'DBIx::Class::Core' );
239 $_->require for @db_classes;
240 $class->inject_base( $table_class, $_ ) for @db_classes;
241 warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->_loader_debug;
242 $table_class->table(lc $tablename);
244 my ( $cols, $pks ) = $class->_loader_table_info($table);
245 carp("$table has no primary key") unless @$pks;
246 $table_class->add_columns(@$cols);
247 $table_class->set_primary_key(@$pks) if @$pks;
249 my $code = "package $table_class;\n$additional_base$additional$left_base";
250 warn qq/$code/ if $class->_loader_debug;
251 warn qq/$table_class->table('$tablename');\n/ if $class->_loader_debug;
252 my $columns = join "', '", @$cols;
253 warn qq/$table_class->add_columns('$columns')\n/ if $class->_loader_debug;
254 my $primaries = join "', '", @$pks;
255 warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->_loader_debug && @$pks;
257 croak qq/Couldn't load additional classes "$@"/ if $@;
258 unshift @{"$table_class\::ISA"}, $_ foreach ( @{ $class->_loader_data->{left_base} } );
260 $class->register_class($table_moniker, $table_class);
261 $class->_loader_data->{TABLE_CLASSES}->{lc $tablename} = $table_class;
262 $class->_loader_data->{MONIKERS}->{lc $tablename} = $table_moniker;
266 # Find and setup relationships
267 sub _loader_relationships {
269 my $dbh = $class->storage->dbh;
270 my $quoter = $dbh->get_info(29) || q{"};
271 foreach my $table ( $class->tables ) {
273 my $sth = $dbh->foreign_key_info( '',
274 $class->_loader_data->{db_schema}, '', '', '', $table );
276 while(my $raw_rel = $sth->fetchrow_hashref) {
277 my $uk_tbl = lc $raw_rel->{UK_TABLE_NAME};
278 my $uk_col = lc $raw_rel->{UK_COLUMN_NAME};
279 my $fk_col = lc $raw_rel->{FK_COLUMN_NAME};
280 $uk_tbl =~ s/$quoter//g;
281 $uk_col =~ s/$quoter//g;
282 $fk_col =~ s/$quoter//g;
283 $rels->{$uk_tbl}->{$uk_col} = $fk_col;
286 foreach my $reltbl (keys %$rels) {
287 my $cond = $rels->{$reltbl};
288 eval { $class->_loader_make_relations( $table, $reltbl, $cond ) };
289 warn qq/\# belongs_to_many failed "$@"\n\n/
290 if $@ && $class->_loader_debug;
295 # Make a moniker from a table
296 sub _loader_table2moniker {
297 my ( $class, $db_schema, $table ) = @_;
302 $db_schema = ucfirst lc $db_schema;
303 $db_schema_ns = $db_schema if(!$class->_loader_data->{drop_db_schema});
308 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
309 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
314 # Overload in driver class
315 sub _loader_tables { croak "ABSTRACT METHOD" }
317 sub _loader_table_info { croak "ABSTRACT METHOD" }
321 L<DBIx::Class::Schema::Loader>