Allow passing an arrayref to SQLT->filename
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / ClassDBI.pm
CommitLineData
f42e7027 1package SQL::Translator::Producer::ClassDBI;
2
f42e7027 3use strict;
f27f9229 4use warnings;
0c04c5a2 5our $DEBUG;
6our $VERSION = '1.59';
41a7b982 7$DEBUG = 1 unless defined $DEBUG;
f42e7027 8
6c45056f 9use SQL::Translator::Schema::Constants;
73892176 10use SQL::Translator::Utils qw(debug header_comment);
71046f4b 11use Data::Dumper;
f42e7027 12
bf4629e7 13my %CDBI_auto_pkgs = (
71046f4b 14 MySQL => 'mysql',
15 PostgreSQL => 'Pg',
16 Oracle => 'Oracle',
bf4629e7 17);
18
f42e7027 19sub produce {
4d1e8cb4 20 my $t = shift;
21 local $DEBUG = $t->debug;
390292d3 22 my $no_comments = $t->no_comments;
23 my $schema = $t->schema;
24 my $args = $t->producer_args;
4d1e8cb4 25 my @create;
26
73892176 27 if ( my $fmt = $args->{'format_pkg_name'} ) {
28 $t->format_package_name( $fmt );
29 }
4d1e8cb4 30
73892176 31 if ( my $fmt = $args->{'format_fk_name'} ) {
32 $t->format_fk_name( $fmt );
33 }
4d1e8cb4 34
bf4629e7 35 my $db_user = $args->{'db_user'} || '';
4330d04e 36 my $db_pass = $args->{'db_password'} || '';
37 my $main_pkg_name = $args->{'package_name'} ||
38 # $args->{'main_pkg_name'} || # keep this? undocumented
41a7b982 39 $t->format_package_name('DBI');
40 my $header = header_comment( __PACKAGE__, "# " );
390292d3 41 my $parser_type = ( split /::/, $t->parser_type )[-1];
41a7b982 42 my $from = $CDBI_auto_pkgs{$parser_type} || '';
ea93df61 43 my $dsn = $args->{'dsn'} || sprintf( 'dbi:%s:_',
44 $CDBI_auto_pkgs{ $parser_type }
45 ? $CDBI_auto_pkgs{ $parser_type } : $parser_type
41a7b982 46 );
71046f4b 47 my $sep = '# ' . '-' x 67;
fe77d758 48
73892176 49
fe77d758 50 #
51 # Identify "link tables" (have only PK and FK fields).
52 #
53 my %linkable;
54 my %linktable;
73892176 55 for my $table ( $schema->get_tables ) {
56 debug("PKG: Table = ", $table->name, "\n");
fe77d758 57 my $is_link = 1;
73892176 58 for my $field ( $table->get_fields ) {
fe77d758 59 unless ( $field->is_primary_key or $field->is_foreign_key ) {
41a7b982 60 $is_link = 0;
fe77d758 61 last;
62 }
63 }
64
65 next unless $is_link;
41a7b982 66
fe77d758 67 foreach my $left ( $table->get_fields ) {
68 next unless $left->is_foreign_key;
41a7b982 69 my $lfk = $left->foreign_key_reference or next;
70 my $lr_table = $schema->get_table( $lfk->reference_table )
71 or next;
72 my $lr_field_name = ( $lfk->reference_fields )[0];
fe77d758 73 my $lr_field = $lr_table->get_field($lr_field_name);
74 next unless $lr_field->is_primary_key;
75
76 foreach my $right ( $table->get_fields ) {
77 next if $left->name eq $right->name;
41a7b982 78
79 my $rfk = $right->foreign_key_reference or next;
fe77d758 80 my $rr_table = $schema->get_table( $rfk->reference_table )
41a7b982 81 or next;
82 my $rr_field_name = ( $rfk->reference_fields )[0];
fe77d758 83 my $rr_field = $rr_table->get_field($rr_field_name);
84 next unless $rr_field->is_primary_key;
41a7b982 85
c703e51d 86 $linkable{ $lr_table->name }{ $rr_table->name } = $table;
87 $linkable{ $rr_table->name }{ $lr_table->name } = $table;
fe77d758 88 $linktable{ $table->name } = $table;
89 }
90 }
91 }
c703e51d 92
6c45056f 93 #
71046f4b 94 # Iterate over all tables
6c45056f 95 #
bf4629e7 96 my ( %packages, $order );
6c45056f 97 for my $table ( $schema->get_tables ) {
98 my $table_name = $table->name or next;
6c45056f 99
4330d04e 100 my $table_pkg_name = join '::', $main_pkg_name, $t->format_package_name($table_name);
73892176 101 $packages{ $table_pkg_name } = {
41a7b982 102 order => ++$order,
103 pkg_name => $table_pkg_name,
104 base => $main_pkg_name,
105 table => $table_name,
bf4629e7 106 };
6c45056f 107
6c45056f 108 #
bf4629e7 109 # Primary key may have a differenct accessor method name
6c45056f 110 #
73892176 111# if ( my $constraint = $table->primary_key ) {
112# my $field = ( $constraint->fields )[0];
113# $packages{ $table_pkg_name }{'_columns_primary'} = $field;
114#
115# if ( my $pk_xform = $t->format_pk_name ) {
116# my $pk_name = $pk_xform->( $table_pkg_name, $field );
117#
118# $packages{$table_pkg_name}{'pk_accessor'} =
119# "#\n# Primary key accessor\n#\n"
120# . "sub $pk_name {\n shift->$field\n}\n\n";
121# }
122# }
d79af833 123
124 my $is_data = 0;
125 foreach my $field ( $table->get_fields ) {
41a7b982 126 if ( !$field->is_foreign_key and !$field->is_primary_key ) {
127 push @{ $packages{$table_pkg_name}{'_columns_essential'} },
128 $field->name;
129 $is_data++;
130 }
131 elsif ( !$field->is_primary_key ) {
132 push @{ $packages{$table_pkg_name}{'_columns_others'} },
133 $field->name;
134 }
d79af833 135 }
136
41a7b982 137 my %linked;
138 if ($is_data) {
139 foreach my $link ( keys %{ $linkable{$table_name} } ) {
140 my $linkmethodname;
141
142 if ( my $fk_xform = $t->format_fk_name ) {
143
144 # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
145 $linkmethodname = $fk_xform->(
146 $linkable{ $table_name }{ $link }->name,
147 ( $schema->get_table( $link )->primary_key->fields )[0]
148 )
149 . 's';
150 }
151 else {
152 # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
153 $linkmethodname =
154 $linkable{ $table_name }{ $link }->name . '_'
155 . ( $schema->get_table( $link )->primary_key->fields )[0]
156 . 's';
157 }
158
159 my @rk_fields = ();
160 my @lk_fields = ();
161 foreach my $field ( $linkable{$table_name}{$link}->get_fields )
162 {
163 next unless $field->is_foreign_key;
164
ea93df61 165 next unless (
41a7b982 166 $field->foreign_key_reference->reference_table eq
167 $table_name
ea93df61 168 ||
169 $field->foreign_key_reference->reference_table eq $link
41a7b982 170 );
171
172 push @lk_fields,
173 ( $field->foreign_key_reference->reference_fields )[0]
174 if $field->foreign_key_reference->reference_table eq
175 $link;
176
177 push @rk_fields, $field->name
178 if $field->foreign_key_reference->reference_table eq
179 $table_name;
180 }
181
182 #
183 # If one possible traversal via link table.
184 #
185 if ( scalar(@rk_fields) == 1 and scalar(@lk_fields) == 1 ) {
186 foreach my $rk_field (@rk_fields) {
187 push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
188 "sub "
189 . $linkmethodname
190 . " { my \$self = shift; "
191 . "return map \$_->"
192 . ( $schema->get_table($link)->primary_key->fields )
193 [0]
194 . ", \$self->"
195 . $linkable{$table_name}{$link}->name . "_"
196 . $rk_field
197 . " }\n\n";
198 }
199
200 #
201 # Else there is more than one way to traverse it.
202 # ack! Let's treat these types of link tables as
203 # a many-to-one (easier)
204 #
205 # NOTE: we need to rethink the link method name,
206 # as the cardinality has shifted on us.
207 #
208 }
209 elsif ( scalar(@rk_fields) == 1 ) {
210 foreach my $rk_field (@rk_fields) {
211 #
212 # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
213 #
214 push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
215 "sub "
216 . $linkable{$table_name}{$link}->name
217 . "s { my \$self = shift; return \$self->"
218 . $linkable{$table_name}{$link}->name . "_"
219 . $rk_field
220 . "(\@_) }\n\n";
221 }
222 }
223 elsif ( scalar(@lk_fields) == 1 ) {
224 #
225 # These will be taken care of on the other end...
226 #
227 }
228 else {
229 #
230 # Many many many. Need multiple iterations here,
231 # data structure revision to handle N FK sources.
232 # This code has not been tested and likely doesn't
233 # work here.
234 #
235 foreach my $rk_field (@rk_fields) {
236 # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
237 push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
238 "sub "
239 . $linkable{$table_name}{$link}->name . "_"
240 . $rk_field
241 . "s { my \$self = shift; return \$self->"
242 . $linkable{$table_name}{$link}->name . "_"
243 . $rk_field
244 . "(\@_) }\n\n";
245 }
246 }
247 }
248 }
d79af833 249
6c45056f 250 #
bf4629e7 251 # Use foreign keys to set up "has_a/has_many" relationships.
6c45056f 252 #
253 foreach my $field ( $table->get_fields ) {
254 if ( $field->is_foreign_key ) {
bf4629e7 255 my $table_name = $table->name;
6c45056f 256 my $field_name = $field->name;
73892176 257# my $fk_method = $t->format_fk_name( $table_name, $field_name );
ea93df61 258 my $fk_method = join('::', $table_pkg_name,
73892176 259 $t->format_fk_name( $table_name, $field_name )
260 );
6c45056f 261 my $fk = $field->foreign_key_reference;
262 my $ref_table = $fk->reference_table;
f7cde540 263 my $ref_pkg = $t->format_package_name($ref_table);
41a7b982 264 my $ref_field = ( $fk->reference_fields )[0];
73892176 265# my $fk_method = join('::',
266# $table_pkg_name, $t->format_fk_name( $ref_table )
267# );
6c45056f 268
41a7b982 269 push @{ $packages{$table_pkg_name}{'has_a'} },
270 "$table_pkg_name->has_a(\n"
271 . " $field_name => '$ref_pkg'\n);\n\n"
272 . "sub $fk_method {\n"
73892176 273 . " return shift->$field_name\n}\n\n"
274 ;
52fbac6a 275
41a7b982 276 # if there weren't M-M relationships via the has_many
277 # being set up here, create nice pluralized method alias
278 # rather for user as alt. to ugly tablename_fieldname name
279 #
73892176 280# if ( !$packages{$ref_pkg}{'has_many'}{$table_name} ) {
281# #
282# # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
283# #
284# push @{ $packages{$ref_pkg}{'has_many'}{$table_name} },
285# "sub ${table_name}s {\n " .
286# "return shift->$table_name\_$field_name\n}\n\n";
287# # else ugly
288# }
289# else {
290# }
41a7b982 291
292 push @{ $packages{$ref_pkg}{'has_many'}{$table_name} },
293 "$ref_pkg->has_many(\n '${table_name}_${field_name}', "
294 . "'$table_pkg_name' => '$field_name'\n);\n\n";
71046f4b 295
fe77d758 296 }
41a7b982 297 }
298 }
6c45056f 299
fe77d758 300 #
301 # Now build up text of package.
302 #
bf4629e7 303 my $base_pkg = sprintf( 'Class::DBI%s', $from ? "::$from" : '' );
4d1e8cb4 304 push @create, join ( "\n",
41a7b982 305 "package $main_pkg_name;\n",
306 $header,
307 "use strict;",
308 "use base '$base_pkg';\n",
309 "$main_pkg_name->set_db('Main', '$dsn', '$db_user', '$db_pass');\n\n",
310 );
311
312 for my $pkg_name (
bf4629e7 313 sort { $packages{ $a }{'order'} <=> $packages{ $b }{'order'} }
314 keys %packages
315 ) {
8b183a02 316 my $pkg = $packages{$pkg_name} or next;
317 next unless $pkg->{'pkg_name'};
bf4629e7 318
4d1e8cb4 319 push @create, join ( "\n",
bf4629e7 320 $sep,
41a7b982 321 "package " . $pkg->{'pkg_name'} . ";",
322 "use base '" . $pkg->{'base'} . "';",
bf4629e7 323 "use Class::DBI::Pager;\n\n",
41a7b982 324 );
325
9c6eb8e3 326 if ( $from ) {
4d1e8cb4 327 push @create, join('',
328 $pkg->{'pkg_name'},
329 "->set_up_table('",
330 $pkg->{'table'},
331 "');\n\n"
332 );
9c6eb8e3 333 }
334 else {
335 my $table = $schema->get_table( $pkg->{'table'} );
336 my @field_names = map { $_->name } $table->get_fields;
ea93df61 337
4d1e8cb4 338 push @create, join("\n",
9c6eb8e3 339 $pkg_name."->table('".$pkg->{'table'}."');\n",
340 $pkg_name."->columns(All => qw/".
341 join(' ', @field_names)."/);\n\n",
342 );
343 }
b789c790 344
4d1e8cb4 345 push @create, "\n";
b789c790 346
bf4629e7 347 if ( my $pk = $pkg->{'pk_accessor'} ) {
4d1e8cb4 348 push @create, $pk;
bf4629e7 349 }
df602cfb 350
bf4629e7 351 if ( my @has_a = @{ $pkg->{'has_a'} || [] } ) {
4d1e8cb4 352 push @create, $_ for @has_a;
bf4629e7 353 }
354
41a7b982 355 foreach my $has_many_key ( keys %{ $pkg->{'has_many'} } ) {
356 if ( my @has_many = @{ $pkg->{'has_many'}{$has_many_key} || [] } ) {
4d1e8cb4 357 push @create, $_ for @has_many;
41a7b982 358 }
359 }
6c45056f 360 }
df602cfb 361
4d1e8cb4 362 push @create, "1;\n";
bf4629e7 363
4d1e8cb4 364 return wantarray
365 ? @create
366 : join('', @create);
f42e7027 367}
368
3691;
370
bf4629e7 371=pod
f42e7027 372
373=head1 NAME
374
bf4629e7 375SQL::Translator::Producer::ClassDBI - create Class::DBI classes from schema
f42e7027 376
377=head1 SYNOPSIS
378
1eee27d3 379Use this producer as you would any other from SQL::Translator. See
380L<SQL::Translator> for details.
f42e7027 381
4d1e8cb4 382This package uses SQL::Translator's formatting methods
1eee27d3 383format_package_name(), format_pk_name(), format_fk_name(), and
384format_table_name() as it creates classes, one per table in the schema
385provided. An additional base class is also created for database connectivity
386configuration. See L<Class::DBI> for details on how this works.
f42e7027 387
6c45056f 388=head1 AUTHORS
f42e7027 389
7c2e6f47 390Allen Day E<lt>allenday@ucla.eduE<gt>,
5f054727 391Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
4d1e8cb4 392Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.