1package SQL::Translator::Producer::ClassDBI; 2 3use strict; 4use warnings; 5our $DEBUG; 6our $VERSION = '1.62'; 7$DEBUG = 1 unless defined $DEBUG; 8 9use SQL::Translator::Schema::Constants; 10use SQL::Translator::Utils qw(debug header_comment); 11use Data::Dumper; 12 13my %CDBI_auto_pkgs = ( 14 MySQL => 'mysql', 15 PostgreSQL => 'Pg', 16 Oracle => 'Oracle', 17); 18 19sub produce { 20 my $t = shift; 21 local $DEBUG = $t->debug; 22 my $no_comments = $t->no_comments; 23 my $schema = $t->schema; 24 my $args = $t->producer_args; 25 my @create; 26 27 if ( my $fmt = $args->{'format_pkg_name'} ) { 28 $t->format_package_name( $fmt ); 29 } 30 31 if ( my $fmt = $args->{'format_fk_name'} ) { 32 $t->format_fk_name( $fmt ); 33 } 34 35 my $db_user = $args->{'db_user'} || ''; 36 my $db_pass = $args->{'db_password'} || ''; 37 my $main_pkg_name = $args->{'package_name'} || 38 # $args->{'main_pkg_name'} || # keep this? undocumented 39 $t->format_package_name('DBI'); 40 my $header = header_comment( __PACKAGE__, "# " ); 41 my $parser_type = ( split /::/, $t->parser_type )[-1]; 42 my $from = $CDBI_auto_pkgs{$parser_type} || ''; 43 my $dsn = $args->{'dsn'} || sprintf( 'dbi:%s:_', 44 $CDBI_auto_pkgs{ $parser_type } 45 ? $CDBI_auto_pkgs{ $parser_type } : $parser_type 46 ); 47 my $sep = '# ' . '-' x 67; 48 49 50 # 51 # Identify "link tables" (have only PK and FK fields). 52 # 53 my %linkable; 54 my %linktable; 55 for my $table ( $schema->get_tables ) { 56 debug("PKG: Table = ", $table->name, "\n"); 57 my $is_link = 1; 58 for my $field ( $table->get_fields ) { 59 unless ( $field->is_primary_key or $field->is_foreign_key ) { 60 $is_link = 0; 61 last; 62 } 63 } 64 65 next unless $is_link; 66 67 foreach my $left ( $table->get_fields ) { 68 next unless $left->is_foreign_key; 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]; 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; 78 79 my $rfk = $right->foreign_key_reference or next; 80 my $rr_table = $schema->get_table( $rfk->reference_table ) 81 or next; 82 my $rr_field_name = ( $rfk->reference_fields )[0]; 83 my $rr_field = $rr_table->get_field($rr_field_name); 84 next unless $rr_field->is_primary_key; 85 86 $linkable{ $lr_table->name }{ $rr_table->name } = $table; 87 $linkable{ $rr_table->name }{ $lr_table->name } = $table; 88 $linktable{ $table->name } = $table; 89 } 90 } 91 } 92 93 # 94 # Iterate over all tables 95 # 96 my ( %packages, $order ); 97 for my $table ( $schema->get_tables ) { 98 my $table_name = $table->name or next; 99 100 my $table_pkg_name = join '::', $main_pkg_name, $t->format_package_name($table_name); 101 $packages{ $table_pkg_name } = { 102 order => ++$order, 103 pkg_name => $table_pkg_name, 104 base => $main_pkg_name, 105 table => $table_name, 106 }; 107 108 # 109 # Primary key may have a different accessor method name 110 # 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# } 123 124 my $is_data = 0; 125 foreach my $field ( $table->get_fields ) { 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 } 135 } 136 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 165 next unless ( 166 $field->foreign_key_reference->reference_table eq 167 $table_name 168 || 169 $field->foreign_key_reference->reference_table eq $link 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 } 249 250 # 251 # Use foreign keys to set up "has_a/has_many" relationships. 252 # 253 foreach my $field ( $table->get_fields ) { 254 if ( $field->is_foreign_key ) { 255 my $table_name = $table->name; 256 my $field_name = $field->name; 257# my $fk_method = $t->format_fk_name( $table_name, $field_name ); 258 my $fk_method = join('::', $table_pkg_name, 259 $t->format_fk_name( $table_name, $field_name ) 260 ); 261 my $fk = $field->foreign_key_reference; 262 my $ref_table = $fk->reference_table; 263 my $ref_pkg = $t->format_package_name($ref_table); 264 my $ref_field = ( $fk->reference_fields )[0]; 265# my $fk_method = join('::', 266# $table_pkg_name, $t->format_fk_name( $ref_table ) 267# ); 268 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" 273 . " return shift->$field_name\n}\n\n" 274 ; 275 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 # 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# } 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"; 295 296 } 297 } 298 } 299 300 # 301 # Now build up text of package. 302 # 303 my $base_pkg = sprintf( 'Class::DBI%s', $from ? "::$from" : '' ); 304 push @create, join ( "\n", 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 ( 313 sort { $packages{ $a }{'order'} <=> $packages{ $b }{'order'} } 314 keys %packages 315 ) { 316 my $pkg = $packages{$pkg_name} or next; 317 next unless $pkg->{'pkg_name'}; 318 319 push @create, join ( "\n", 320 $sep, 321 "package " . $pkg->{'pkg_name'} . ";", 322 "use base '" . $pkg->{'base'} . "';", 323 "use Class::DBI::Pager;\n\n", 324 ); 325 326 if ( $from ) { 327 push @create, join('', 328 $pkg->{'pkg_name'}, 329 "->set_up_table('", 330 $pkg->{'table'}, 331 "');\n\n" 332 ); 333 } 334 else { 335 my $table = $schema->get_table( $pkg->{'table'} ); 336 my @field_names = map { $_->name } $table->get_fields; 337 338 push @create, join("\n", 339 $pkg_name."->table('".$pkg->{'table'}."');\n", 340 $pkg_name."->columns(All => qw/". 341 join(' ', @field_names)."/);\n\n", 342 ); 343 } 344 345 push @create, "\n"; 346 347 if ( my $pk = $pkg->{'pk_accessor'} ) { 348 push @create, $pk; 349 } 350 351 if ( my @has_a = @{ $pkg->{'has_a'} || [] } ) { 352 push @create, $_ for @has_a; 353 } 354 355 foreach my $has_many_key ( keys %{ $pkg->{'has_many'} } ) { 356 if ( my @has_many = @{ $pkg->{'has_many'}{$has_many_key} || [] } ) { 357 push @create, $_ for @has_many; 358 } 359 } 360 } 361 362 push @create, "1;\n"; 363 364 return wantarray 365 ? @create 366 : join('', @create); 367} 368 3691; 370 371=pod 372 373=head1 NAME 374 375SQL::Translator::Producer::ClassDBI - create Class::DBI classes from schema 376 377=head1 SYNOPSIS 378 379Use this producer as you would any other from SQL::Translator. See 380L<SQL::Translator> for details. 381 382This package uses SQL::Translator's formatting methods 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. 387 388=head1 AUTHORS 389 390Allen Day E<lt>allenday@ucla.eduE<gt>, 391Ying Zhang E<lt>zyolive@yahoo.comE<gt>, 392Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>. 393