db2 does not allow keys that are nullable
[dbsrgits/DBIx-Class-Schema-Loader.git] / lib / DBIx / Class / Schema / Loader / Generic.pm
CommitLineData
18fca96a 1package DBIx::Class::Schema::Loader::Generic;
a78e3fed 2
3use strict;
a4a19f3c 4use warnings;
5
6use base qw/DBIx::Class::Schema/;
7
a78e3fed 8use Carp;
9use Lingua::EN::Inflect;
a4a19f3c 10
a78e3fed 11require DBIx::Class::Core;
a4a19f3c 12
e26a4023 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' => {} );
66742793 18__PACKAGE__->mk_classaccessor('_loader_debug' => 0);
a4a19f3c 19
a78e3fed 20=head1 NAME
21
18fca96a 22DBIx::Class::Schema::Loader::Generic - Generic DBIx::Class::Schema::Loader Implementation.
a78e3fed 23
24=head1 SYNOPSIS
25
18fca96a 26See L<DBIx::Class::Schema::Loader>
a78e3fed 27
28=head1 DESCRIPTION
29
30=head2 OPTIONS
31
32Available constructor options are:
33
34=head3 additional_base_classes
35
36List of additional base classes your table classes will use.
37
38=head3 left_base_classes
39
40List of additional base classes, that need to be leftmost.
41
42=head3 additional_classes
43
44List of additional classes which your table classes will use.
45
46=head3 constraint
47
48Only load tables matching regex.
49
50=head3 exclude
51
52Exclude tables matching regex.
53
54=head3 debug
55
56Enable debug messages.
57
58=head3 dsn
59
60DBI Data Source Name.
61
a78e3fed 62=head3 password
63
64Password.
65
66=head3 relationships
67
68Try to automatically detect/setup has_a and has_many relationships.
69
70=head3 inflect
71
72An hashref, which contains exceptions to Lingua::EN::Inflect::PL().
73Useful for foreign language column names.
74
75=head3 user
76
77Username.
78
79=head2 METHODS
80
81=cut
82
83=head3 new
84
85Not intended to be called directly. This is used internally by the
18fca96a 86C<new()> method in L<DBIx::Class::Schema::Loader>.
a78e3fed 87
88=cut
89
a4a19f3c 90sub _load_from_connection {
a78e3fed 91 my ( $class, %args ) = @_;
3385ac62 92
e26a4023 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});
3385ac62 97
a78e3fed 98 my $additional = $args{additional_classes} || [];
99 $additional = [$additional] unless ref $additional eq 'ARRAY';
3385ac62 100
a78e3fed 101 my $additional_base = $args{additional_base_classes} || [];
102 $additional_base = [$additional_base]
103 unless ref $additional_base eq 'ARRAY';
3385ac62 104
a78e3fed 105 my $left_base = $args{left_base_classes} || [];
106 $left_base = [$left_base] unless ref $left_base eq 'ARRAY';
3385ac62 107
e26a4023 108 my %load_classes_args = (
3385ac62 109 additional => $additional,
110 additional_base => $additional_base,
111 left_base => $left_base,
112 constraint => $args{constraint} || '.*',
113 exclude => $args{exclude},
e26a4023 114 );
115
116 $class->connection($args{dsn}, $args{user},
117 $args{password}, $args{options});
118
3385ac62 119 warn qq/\### START DBIx::Class::Schema::Loader dump ###\n/
120 if $class->_loader_debug;
e26a4023 121
122 $class->_loader_load_classes(%load_classes_args);
66742793 123 $class->_loader_relationships if $args{relationships};
e26a4023 124
3385ac62 125 warn qq/\### END DBIx::Class::Schema::Loader dump ###\n/
126 if $class->_loader_debug;
a4a19f3c 127 $class->storage->dbh->disconnect; # XXX this should be ->storage->disconnect later?
128
129 1;
a78e3fed 130}
131
af6c2665 132# The original table class name during Loader,
3385ac62 133sub _loader_find_table_class {
a4a19f3c 134 my ( $class, $table ) = @_;
e26a4023 135 return $class->_loader_classes->{$table};
a78e3fed 136}
137
af6c2665 138# Returns the moniker for a given table name,
139# for use in $conn->resultset($moniker)
fbd83464 140
141=head3 moniker
142
143Returns the moniker for a given literal table name. Used
144as $schema->resultset($moniker), etc.
145
146=cut
af6c2665 147sub moniker {
a4a19f3c 148 my ( $class, $table ) = @_;
e26a4023 149 return $class->_loader_monikers->{$table};
a78e3fed 150}
151
a78e3fed 152=head3 tables
153
154Returns a sorted list of tables.
155
156 my @tables = $loader->tables;
157
158=cut
159
160sub tables {
a4a19f3c 161 my $class = shift;
e26a4023 162 return sort keys %{ $class->_loader_monikers };
a78e3fed 163}
164
165# Overload in your driver class
3385ac62 166sub _loader_db_classes { croak "ABSTRACT METHOD" }
a78e3fed 167
66742793 168# not a class method.
169sub _loader_stringify_hash {
170 my $href = shift;
171
172 return '{ ' .
173 join(q{, }, map("$_ => $href->{$_}", keys %$href))
174 . ' }';
175}
176
a78e3fed 177# Setup has_a and has_many relationships
3385ac62 178sub _loader_make_relations {
708c0939 179
180 my ( $class, $table, $other, $cond ) = @_;
3385ac62 181 my $table_class = $class->_loader_find_table_class($table);
182 my $other_class = $class->_loader_find_table_class($other);
a78e3fed 183
708c0939 184 my $table_relname = lc $table;
185 my $other_relname = lc $other;
a78e3fed 186
e26a4023 187 if(my $inflections = $class->_loader_inflect) {
708c0939 188 $table_relname = $inflections->{$table_relname}
189 if exists $inflections->{$table_relname};
a78e3fed 190 }
191 else {
708c0939 192 $table_relname = Lingua::EN::Inflect::PL($table_relname);
193 }
194
4ce22656 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};
201 }
a78e3fed 202
4ce22656 203 my $rev_cond = { reverse %$cond };
708c0939 204
4ce22656 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;
66742793 209
4ce22656 210 warn qq/\# Belongs_to relationship\n/ if $class->_loader_debug;
708c0939 211
4ce22656 212 warn qq/$table_class->belongs_to( '$other_relname' => '$other_class',/
213 . qq/$cond_printable);\n\n/
214 if $class->_loader_debug;
708c0939 215
4ce22656 216 $table_class->belongs_to( $other_relname => $other_class, $cond);
a78e3fed 217
4ce22656 218 warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
a78e3fed 219
4ce22656 220 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
221 . qq/$rev_cond_printable);\n\n/
222 . qq/);\n\n/
223 if $class->_loader_debug;
708c0939 224
4ce22656 225 $other_class->has_many( $table_relname => $table_class, $rev_cond);
226 }
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 );
232
233 warn qq/\# Has_many relationship\n/ if $class->_loader_debug;
234 warn qq/$other_class->has_many( '$table_relname' => '$table_class',/
235 . qq/$cond);\n\n/
236 if $class->_loader_debug;
237
238 $other_class->has_many( $table_relname => $table_class, $cond);
239 }
a78e3fed 240}
241
242# Load and setup classes
3385ac62 243sub _loader_load_classes {
e26a4023 244 my ($class, %args) = @_;
245
246 my $additional = join '',
247 map "use $_;\n", @{$args{additional}};
af6c2665 248
3385ac62 249 my @tables = $class->_loader_tables();
250 my @db_classes = $class->_loader_db_classes();
a78e3fed 251
a78e3fed 252 foreach my $table (@tables) {
e26a4023 253 next unless $table =~ /$args{constraint}/;
254 next if defined $args{exclude} && $table =~ /$args{exclude}/;
af6c2665 255
af6c2665 256 my ($db_schema, $tbl) = split /\./, $table;
af96f52e 257 my $tablename = lc $table;
a78e3fed 258 if($tbl) {
e26a4023 259 $tablename = $class->_loader_drop_db_schema ? $tbl : lc $table;
af6c2665 260 }
e26a4023 261 my $lc_tblname = lc $tablename;
af6c2665 262
3385ac62 263 my $table_moniker = $class->_loader_table2moniker($db_schema, $tbl);
65644119 264 my $table_class = "$class\::$table_moniker";
af6c2665 265
e26a4023 266 # XXX all of this needs require/eval error checking
a4a19f3c 267 $class->inject_base( $table_class, 'DBIx::Class::Core' );
a78e3fed 268 $_->require for @db_classes;
a4a19f3c 269 $class->inject_base( $table_class, $_ ) for @db_classes;
e26a4023 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}};
273
3385ac62 274 warn qq/\# Initializing table "$tablename" as "$table_class"\n/ if $class->_loader_debug;
e26a4023 275 $table_class->table($lc_tblname);
af6c2665 276
3385ac62 277 my ( $cols, $pks ) = $class->_loader_table_info($table);
a78e3fed 278 carp("$table has no primary key") unless @$pks;
a4a19f3c 279 $table_class->add_columns(@$cols);
280 $table_class->set_primary_key(@$pks) if @$pks;
af6c2665 281
3385ac62 282 warn qq/$table_class->table('$tablename');\n/ if $class->_loader_debug;
a78e3fed 283 my $columns = join "', '", @$cols;
3385ac62 284 warn qq/$table_class->add_columns('$columns')\n/ if $class->_loader_debug;
a78e3fed 285 my $primaries = join "', '", @$pks;
3385ac62 286 warn qq/$table_class->set_primary_key('$primaries')\n/ if $class->_loader_debug && @$pks;
af6c2665 287
65644119 288 $class->register_class($table_moniker, $table_class);
e26a4023 289 $class->_loader_classes->{$lc_tblname} = $table_class;
290 $class->_loader_monikers->{$lc_tblname} = $table_moniker;
a78e3fed 291 }
292}
293
294# Find and setup relationships
3385ac62 295sub _loader_relationships {
a4a19f3c 296 my $class = shift;
297 my $dbh = $class->storage->dbh;
708c0939 298 my $quoter = $dbh->get_info(29) || q{"};
a4a19f3c 299 foreach my $table ( $class->tables ) {
708c0939 300 my $rels = {};
301 my $sth = $dbh->foreign_key_info( '',
e26a4023 302 $class->_loader_db_schema, '', '', '', $table );
708c0939 303 next if !$sth;
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};
4ce22656 308 my $relid = lc $raw_rel->{UK_NAME};
708c0939 309 $uk_tbl =~ s/$quoter//g;
310 $uk_col =~ s/$quoter//g;
311 $fk_col =~ s/$quoter//g;
4ce22656 312 $relid =~ s/$quoter//g;
313 $rels->{$relid}->{tbl} = $uk_tbl;
314 $rels->{$relid}->{cols}->{$uk_col} = $fk_col;
708c0939 315 }
316
4ce22656 317 foreach my $relid (keys %$rels) {
318 my $reltbl = $rels->{$relid}->{tbl};
319 my $cond = $rels->{$relid}->{cols};
3385ac62 320 eval { $class->_loader_make_relations( $table, $reltbl, $cond ) };
708c0939 321 warn qq/\# belongs_to_many failed "$@"\n\n/
3385ac62 322 if $@ && $class->_loader_debug;
a78e3fed 323 }
324 }
325}
326
65644119 327# Make a moniker from a table
3385ac62 328sub _loader_table2moniker {
a4a19f3c 329 my ( $class, $db_schema, $table ) = @_;
af6c2665 330
af96f52e 331 my $db_schema_ns;
af6c2665 332
af96f52e 333 if($table) {
334 $db_schema = ucfirst lc $db_schema;
e26a4023 335 $db_schema_ns = $db_schema if(!$class->_loader_drop_db_schema);
af96f52e 336 } else {
337 $table = $db_schema;
a78e3fed 338 }
af6c2665 339
65644119 340 my $moniker = join '', map ucfirst, split /[\W_]+/, lc $table;
341 $moniker = $db_schema_ns ? $db_schema_ns . $moniker : $moniker;
af96f52e 342
65644119 343 return $moniker;
a78e3fed 344}
345
346# Overload in driver class
3385ac62 347sub _loader_tables { croak "ABSTRACT METHOD" }
a78e3fed 348
3385ac62 349sub _loader_table_info { croak "ABSTRACT METHOD" }
a78e3fed 350
351=head1 SEE ALSO
352
18fca96a 353L<DBIx::Class::Schema::Loader>
a78e3fed 354
355=cut
356
3571;