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');
17 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
21 See L<DBIx::Class::Schema::Loader>
27 Available constructor options are:
29 =head3 additional_base_classes
31 List of additional base classes your table classes will use.
33 =head3 left_base_classes
35 List of additional base classes, that need to be leftmost.
37 =head3 additional_classes
39 List of additional classes which your table classes will use.
43 Only load tables matching regex.
47 Exclude tables matching regex.
51 Enable debug messages.
59 Namespace under which your table classes will be initialized.
67 Try to automatically detect/setup has_a and has_many relationships.
71 An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
72 Useful for foreign language column names.
84 Not intended to be called directly. This is used internally by the
85 C<new()> method in L<DBIx::Class::Schema::Loader>.
89 sub _load_from_connection {
90 my ( $class, %args ) = @_;
93 *{"$class\::debug_loader"} = sub { 1 };
95 my $additional = $args{additional_classes} || [];
96 $additional = [$additional] unless ref $additional eq 'ARRAY';
97 my $additional_base = $args{additional_base_classes} || [];
98 $additional_base = [$additional_base]
99 unless ref $additional_base eq 'ARRAY';
100 my $left_base = $args{left_base_classes} || [];
101 $left_base = [$left_base] unless ref $left_base eq 'ARRAY';
102 $class->loader_data({
104 [ $args{dsn}, $args{user}, $args{password}, $args{options} ],
105 _namespace => $args{namespace},
106 _additional => $additional,
107 _additional_base => $additional_base,
108 _left_base => $left_base,
109 _constraint => $args{constraint} || '.*',
110 _exclude => $args{exclude},
111 _relationships => $args{relationships},
112 _inflect => $args{inflect},
113 _db_schema => $args{db_schema} || '',
114 _drop_db_schema => $args{drop_db_schema},
119 $class->connection(@{$class->loader_data->{_datasource}});
120 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/ if $class->debug_loader;
121 $class->_load_classes;
122 $class->_relationships if $class->loader_data->{_relationships};
123 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/ if $class->debug_loader;
124 $class->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later?
129 # The original table class name during Loader,
130 sub _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 Overload to enable Loader debug messages.
155 sub debug_loader { 0 }
159 Returns a sorted list of tables.
161 my @tables = $loader->tables;
167 return sort keys %{ $class->loader_data->{MONIKERS} };
170 # Overload in your driver class
171 sub _db_classes { croak "ABSTRACT METHOD" }
173 # Setup has_a and has_many relationships
174 sub _belongs_to_many {
175 my ( $class, $table, $column, $other, $other_column ) = @_;
176 my $table_class = $class->_find_table_class($table);
177 my $other_class = $class->_find_table_class($other);
179 warn qq/\# Belongs_to relationship\n/ if $class->debug_loader;
182 warn qq/$table_class->belongs_to( '$column' => '$other_class',/
183 . qq/ { "foreign.$other_column" => "self.$column" },/
184 . qq/ { accessor => 'filter' });\n\n/
185 if $class->debug_loader;
186 $table_class->belongs_to( $column => $other_class,
187 { "foreign.$other_column" => "self.$column" },
188 { accessor => 'filter' }
192 warn qq/$table_class->belongs_to( '$column' => '$other_class' );\n\n/
193 if $class->debug_loader;
194 $table_class->belongs_to( $column => $other_class );
197 my ($table_class_base) = $table_class =~ /.*::(.+)/;
198 my $plural = Lingua::EN::Inflect::PL( lc $table_class_base );
199 $plural = $class->loader_data->{_inflect}->{ lc $table_class_base }
200 if $class->loader_data->{_inflect}
201 and exists $class->loader_data->{_inflect}->{ lc $table_class_base };
203 warn qq/\# Has_many relationship\n/ if $class->debug_loader;
206 warn qq/$other_class->has_many( '$plural' => '$table_class',/
207 . qq/ { "foreign.$column" => "self.$other_column" } );\n\n/
208 if $class->debug_loader;
209 $other_class->has_many( $plural => $table_class,
210 { "foreign.$column" => "self.$other_column" }
214 warn qq/$other_class->has_many( '$plural' => '$table_class',/
215 . qq/'$other_column' );\n\n/
216 if $class->debug_loader;
217 $other_class->has_many( $plural => $table_class, $column );
221 # Load and setup classes
225 my $namespace = $class->loader_data->{_namespace};
227 my @tables = $class->_tables();
228 my @db_classes = $class->_db_classes();
229 my $additional = join '', map "use $_;\n", @{ $class->loader_data->{_additional} };
230 my $additional_base = join '', map "use base '$_';\n",
231 @{ $class->loader_data->{_additional_base} };
232 my $left_base = join '', map "use base '$_';\n", @{ $class->loader_data->{_left_base} };
233 my $constraint = $class->loader_data->{_constraint};
234 my $exclude = $class->loader_data->{_exclude};
236 foreach my $table (@tables) {
237 next unless $table =~ /$constraint/;
238 next if ( defined $exclude && $table =~ /$exclude/ );
240 my ($db_schema, $tbl) = split /\./, $table;
241 my $tablename = lc $table;
243 $tablename = $class->loader_data->{_drop_db_schema} ? $tbl : lc $table;
246 my $table_subclass = $class->_table2subclass($db_schema, $tbl);
247 my $table_class = "$namespace\::$table_subclass";
249 $class->inject_base( $table_class, 'DBIx::Class::Core' );
250 $_->require for @db_classes;
251 $class->inject_base( $table_class, $_ ) for @db_classes;
252 warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->debug_loader;
253 $table_class->table(lc $tablename);
255 my ( $cols, $pks ) = $class->_table_info($table);
256 carp("$table has no primary key") unless @$pks;
257 $table_class->add_columns(@$cols);
258 $table_class->set_primary_key(@$pks) if @$pks;
260 my $code = "package $table_class;\n$additional_base$additional$left_base";
261 warn qq/$code/ if $class->debug_loader;
262 warn qq/$table_class->table('$tablename');\n/ if $class->debug_loader;
263 my $columns = join "', '", @$cols;
264 warn qq/$table_class->add_columns('$columns')\n/ if $class->debug_loader;
265 my $primaries = join "', '", @$pks;
266 warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->debug_loader && @$pks;
268 croak qq/Couldn't load additional classes "$@"/ if $@;
269 unshift @{"$table_class\::ISA"}, $_ foreach ( @{ $class->loader_data->{_left_base} } );
271 $class->register_class($table_subclass, $table_class);
272 $class->loader_data->{TABLE_CLASSES}->{lc $tablename} = $table_class;
273 $class->loader_data->{MONIKERS}->{lc $tablename} = $table_subclass;
277 # Find and setup relationships
280 my $dbh = $class->storage->dbh;
281 foreach my $table ( $class->tables ) {
282 my $quoter = $dbh->get_info(29) || q{"};
283 if ( my $sth = $dbh->foreign_key_info( '', $class->loader_data->{_db_schema}, '', '', '', $table ) ) {
284 for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) {
285 my $column = lc $res->{FK_COLUMN_NAME};
286 my $other = lc $res->{UK_TABLE_NAME};
287 my $other_column = lc $res->{UK_COLUMN_NAME};
288 $column =~ s/$quoter//g;
289 $other =~ s/$quoter//g;
290 $other_column =~ s/$quoter//g;
291 eval { $class->_belongs_to_many( $table, $column, $other,
293 warn qq/\# belongs_to_many failed "$@"\n\n/
294 if $@ && $class->debug_loader;
300 # Make a subclass (dbix moniker) from a table
301 sub _table2subclass {
302 my ( $class, $db_schema, $table ) = @_;
307 $db_schema = ucfirst lc $db_schema;
308 $db_schema_ns = "::$db_schema" if(!$class->loader_data->{_drop_db_schema});
313 my $subclass = join '', map ucfirst, split /[\W_]+/, lc $table;
314 $subclass = $db_schema_ns ? "$db_schema_ns\::" . $subclass : $subclass;
319 # Overload in driver class
320 sub _tables { croak "ABSTRACT METHOD" }
322 sub _table_info { croak "ABSTRACT METHOD" }
326 L<DBIx::Class::Schema::Loader>