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