1 package DBIx::Class::Schema::Loader::Generic;
4 use base 'DBIx::Class::Componentised';
6 use Lingua::EN::Inflect;
7 use UNIVERSAL::require;
8 use DBIx::Class::Storage::DBI;
9 require DBIx::Class::Core;
10 require DBIx::Class::Schema;
14 DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
18 See L<DBIx::Class::Schema::Loader>
24 Available constructor options are:
26 =head3 additional_base_classes
28 List of additional base classes your table classes will use.
30 =head3 left_base_classes
32 List of additional base classes, that need to be leftmost.
34 =head3 additional_classes
36 List of additional classes which your table classes will use.
40 Only load tables matching regex.
44 Exclude tables matching regex.
48 Enable debug messages.
56 Namespace under which your table classes will be initialized.
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>.
87 my ( $class, %args ) = @_;
90 *{"$class\::debug"} = sub { 1 };
92 my $additional = $args{additional_classes} || [];
93 $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';
97 my $left_base = $args{left_base_classes} || [];
98 $left_base = [$left_base] unless ref $left_base eq 'ARRAY';
101 [ $args{dsn}, $args{user}, $args{password}, $args{options} ],
102 _namespace => $args{namespace},
103 _additional => $additional,
104 _additional_base => $additional_base,
105 _left_base => $left_base,
106 _constraint => $args{constraint} || '.*',
107 _exclude => $args{exclude},
108 _relationships => $args{relationships},
109 _inflect => $args{inflect},
110 _db_schema => $args{schema},
111 _drop_db_schema => $args{dropschema},
112 _schema_class => "$args{namespace}\::_schema",
116 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/ if $self->debug;
117 $self->_load_classes;
118 $self->_relationships if $self->{_relationships};
119 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/ if $self->debug;
120 $self->{_storage}->dbh->disconnect;
124 # The original table class name during Loader,
125 sub _find_table_class {
126 my ( $self, $table ) = @_;
127 return $self->{TABLE_CLASSES}->{$table};
130 # Returns the moniker for a given table name,
131 # for use in $conn->resultset($moniker)
133 my ( $self, $table ) = @_;
134 return $self->{MONIKERS}->{$table};
139 return $self->{_schema_class}->connect(@_) if(@_);
140 return $self->{_schema_class}->connect(@{$self->{_datasource}});
145 Overload to enable debug messages.
153 Returns a sorted list of tables.
155 my @tables = $loader->tables;
161 return sort keys %{ $self->{MONIKERS} };
164 # Overload in your driver class
165 sub _db_classes { croak "ABSTRACT METHOD" }
167 # Setup has_a and has_many relationships
168 sub _belongs_to_many {
169 my ( $self, $table, $column, $other, $other_column ) = @_;
170 my $table_class = $self->_find_table_class($table);
171 my $other_class = $self->_find_table_class($other);
173 warn qq/\# Belongs_to relationship\n/ if $self->debug;
176 warn qq/$table_class->belongs_to( '$column' => '$other_class',/
177 . qq/ { "foreign.$other_column" => "self.$column" },/
178 . qq/ { accessor => 'filter' });\n\n/
180 $table_class->belongs_to( $column => $other_class,
181 { "foreign.$other_column" => "self.$column" },
182 { accessor => 'filter' }
186 warn qq/$table_class->belongs_to( '$column' => '$other_class' );\n\n/
188 $table_class->belongs_to( $column => $other_class );
191 my ($table_class_base) = $table_class =~ /.*::(.+)/;
192 my $plural = Lingua::EN::Inflect::PL( lc $table_class_base );
193 $plural = $self->{_inflect}->{ lc $table_class_base }
195 and exists $self->{_inflect}->{ lc $table_class_base };
197 warn qq/\# Has_many relationship\n/ if $self->debug;
200 warn qq/$other_class->has_many( '$plural' => '$table_class',/
201 . qq/ { "foreign.$column" => "self.$other_column" } );\n\n/
203 $other_class->has_many( $plural => $table_class,
204 { "foreign.$column" => "self.$other_column" }
208 warn qq/$other_class->has_many( '$plural' => '$table_class',/
209 . qq/'$other_column' );\n\n/
211 $other_class->has_many( $plural => $table_class, $column );
215 # Load and setup classes
219 my $namespace = $self->{_namespace};
220 my $schema_class = $self->{_schema_class};
221 $self->inject_base( $schema_class, 'DBIx::Class::Schema' );
222 $self->{_storage} = $schema_class->storage(DBIx::Class::Storage::DBI->new());
223 $schema_class->storage->connect_info($self->{_datasource});
225 my @tables = $self->_tables();
226 my @db_classes = $self->_db_classes();
227 my $additional = join '', map "use $_;\n", @{ $self->{_additional} };
228 my $additional_base = join '', map "use base '$_';\n",
229 @{ $self->{_additional_base} };
230 my $left_base = join '', map "use base '$_';\n", @{ $self->{_left_base} };
231 my $constraint = $self->{_constraint};
232 my $exclude = $self->{_exclude};
234 foreach my $table (@tables) {
235 next unless $table =~ /$constraint/;
236 next if ( defined $exclude && $table =~ /$exclude/ );
238 my $table = lc $table;
239 my $table_name_db_schema = $table;
240 my $table_name_only = $table_name_db_schema;
241 my ($db_schema, $tbl) = split /\./, $table;
243 $table_name_db_schema = $tbl if $self->{_drop_db_schema};
244 $table_name_only = $tbl;
250 my $subclass = $self->_table2subclass($db_schema, $table_name_only);
251 my $class = $namespace . '::' . $subclass;
253 $self->inject_base( $class, 'DBIx::Class::Core' );
254 $_->require for @db_classes;
255 $self->inject_base( $class, $_ ) for @db_classes;
256 warn qq/\# Initializing table "$table_name_db_schema" as "$class"\n/ if $self->debug;
257 $class->table(lc $table_name_db_schema);
259 my ( $cols, $pks ) = $self->_table_info($table_name_db_schema);
260 carp("$table has no primary key") unless @$pks;
261 $class->add_columns(@$cols);
262 $class->set_primary_key(@$pks) if @$pks;
264 my $code = "package $class;\n$additional_base$additional$left_base";
265 warn qq/$code/ if $self->debug;
266 warn qq/$class->table('$table_name_db_schema');\n/ if $self->debug;
267 my $columns = join "', '", @$cols;
268 warn qq/$class->add_columns('$columns')\n/ if $self->debug;
269 my $primaries = join "', '", @$pks;
270 warn qq/$class->set_primary_key('$primaries')\n/ if $self->debug && @$pks;
272 croak qq/Couldn't load additional classes "$@"/ if $@;
273 unshift @{"$class\::ISA"}, $_ foreach ( @{ $self->{_left_base} } );
275 $schema_class->register_class($subclass, $class);
276 $self->{TABLE_CLASSES}->{$table_name_db_schema} = $class;
277 $self->{MONIKERS}->{$table_name_db_schema} = $subclass;
281 # Find and setup relationships
284 my $dbh = $self->{_storage}->dbh;
285 foreach my $table ( $self->tables ) {
286 my $quoter = $dbh->get_info(29) || q{"};
287 if ( my $sth = $dbh->foreign_key_info( '', '', '', '', '', $table ) ) {
288 for my $res ( @{ $sth->fetchall_arrayref( {} ) } ) {
289 my $column = $res->{FK_COLUMN_NAME};
290 my $other = $res->{UK_TABLE_NAME};
291 my $other_column = $res->{UK_COLUMN_NAME};
292 $column =~ s/$quoter//g;
293 $other =~ s/$quoter//g;
294 $other_column =~ s/$quoter//g;
295 eval { $self->_belongs_to_many( $table, $column, $other,
297 warn qq/\# belongs_to_many failed "$@"\n\n/
298 if $@ && $self->debug;
304 # Make a subclass (dbix moniker) from a table
305 sub _table2subclass {
306 my ( $self, $db_schema, $table ) = @_;
308 my $subclass = join '', map ucfirst, split /[\W_]+/, $table;
310 if($db_schema && !$self->{_drop_db_schema}) {
311 $subclass = (ucfirst lc $db_schema) . '-' . $subclass;
317 # Overload in driver class
318 sub _tables { croak "ABSTRACT METHOD" }
320 sub _table_info { croak "ABSTRACT METHOD" }
324 L<DBIx::Class::Schema::Loader>