X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FClassDBI.pm;h=4bc42da7429b6e14c1cfdc1203be4e3d6da24ce0;hb=df399712c8e458cbd2bf0389cb17666ce499dedd;hp=df68e7014c16adb00597ad2517ebe07f2d382ec1;hpb=7813f0039f851dd26ad69fff8bf5706bea5f49eb;p=dbsrgits%2FSQL-Translator.git

diff --git a/lib/SQL/Translator/Producer/ClassDBI.pm b/lib/SQL/Translator/Producer/ClassDBI.pm
old mode 100755
new mode 100644
index df68e70..4bc42da
--- a/lib/SQL/Translator/Producer/ClassDBI.pm
+++ b/lib/SQL/Translator/Producer/ClassDBI.pm
@@ -1,223 +1,384 @@
 package SQL::Translator::Producer::ClassDBI;
 
-# -------------------------------------------------------------------
-# $Id: ClassDBI.pm,v 1.11 2003-06-09 05:38:11 allenday Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2003 Ying Zhang <zyolive@yahoo.com>,
-#                    Allen Day <allenday@ucla.edu>,
-#
-# This program is free software; you can redistribute it and/or
-# modify it under the terms of the GNU General Public License as
-# published by the Free Software Foundation; version 2.
-#
-# This program is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
-# 02111-1307  USA
-# -------------------------------------------------------------------
-
 use strict;
 use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/;
-$DEBUG   = 1 unless defined $DEBUG;
+$VERSION = '1.59';
+$DEBUG = 1 unless defined $DEBUG;
 
 use SQL::Translator::Schema::Constants;
-use SQL::Translator::Utils qw(header_comment);
+use SQL::Translator::Utils qw(debug header_comment);
 use Data::Dumper;
 
+my %CDBI_auto_pkgs = (
+    MySQL      => 'mysql',
+    PostgreSQL => 'Pg',
+    Oracle     => 'Oracle',
+);
+
 sub produce {
-    my ($translator, $data) = @_;
-    local $DEBUG            = $translator->debug;
-    my $no_comments         = $translator->no_comments;
-    my $schema              = $translator->schema;
-	
-    my $create; 
-    $create .= header_comment(__PACKAGE__, "# ") unless ($no_comments);
-	
-    $create .= "package " . $translator->format_package_name('DBI'). ";\n\n";
-	
-    $create .= "my \$USER = '';\n";
-    $create .= "my \$PASS = '';\n\n";
-	
-    my $from = _from($translator->parser_type());
-	
-    $create .= "use base 'Class::DBI::$from';\n\n" .
-        $translator->format_package_name('DBI') . 
-        "->set_db('Main', 'dbi:$from:_', \$USER, \$PASS);\n\n";
-	
+    my $t             = shift;
+    local $DEBUG      = $t->debug;
+    my $no_comments   = $t->no_comments;
+    my $schema        = $t->schema;
+    my $args          = $t->producer_args;
+    my @create;
+
+    if ( my $fmt = $args->{'format_pkg_name'} ) {
+        $t->format_package_name( $fmt );
+    }
+
+    if ( my $fmt = $args->{'format_fk_name'} ) {
+        $t->format_fk_name( $fmt );
+    }
+
+    my $db_user       = $args->{'db_user'} || '';
+    my $db_pass       = $args->{'db_password'} || '';
+    my $main_pkg_name = $args->{'package_name'} ||
+                        # $args->{'main_pkg_name'} || # keep this? undocumented
+                        $t->format_package_name('DBI');
+    my $header        = header_comment( __PACKAGE__, "# " );
+    my $parser_type   = ( split /::/, $t->parser_type )[-1];
+    my $from          = $CDBI_auto_pkgs{$parser_type} || '';
+    my $dsn           = $args->{'dsn'} || sprintf( 'dbi:%s:_',
+        $CDBI_auto_pkgs{ $parser_type }
+        ? $CDBI_auto_pkgs{ $parser_type } : $parser_type
+    );
+    my $sep           = '# ' . '-' x 67;
+
+
+    #
+    # Identify "link tables" (have only PK and FK fields).
+    #
+    my %linkable;
+    my %linktable;
+    for my $table ( $schema->get_tables ) {
+        debug("PKG: Table = ", $table->name, "\n");
+        my $is_link = 1;
+        for my $field ( $table->get_fields ) {
+            unless ( $field->is_primary_key or $field->is_foreign_key ) {
+                $is_link = 0;
+                last;
+            }
+        }
+
+        next unless $is_link;
+
+        foreach my $left ( $table->get_fields ) {
+            next unless $left->is_foreign_key;
+            my $lfk = $left->foreign_key_reference or next;
+            my $lr_table = $schema->get_table( $lfk->reference_table )
+              or next;
+            my $lr_field_name = ( $lfk->reference_fields )[0];
+            my $lr_field      = $lr_table->get_field($lr_field_name);
+            next unless $lr_field->is_primary_key;
+
+            foreach my $right ( $table->get_fields ) {
+                next if $left->name eq $right->name;
+
+                my $rfk = $right->foreign_key_reference or next;
+                my $rr_table = $schema->get_table( $rfk->reference_table )
+                  or next;
+                my $rr_field_name = ( $rfk->reference_fields )[0];
+                my $rr_field      = $rr_table->get_field($rr_field_name);
+                next unless $rr_field->is_primary_key;
+
+                $linkable{ $lr_table->name }{ $rr_table->name } = $table;
+                $linkable{ $rr_table->name }{ $lr_table->name } = $table;
+                $linktable{ $table->name } = $table;
+            }
+        }
+    }
+
     #
     # Iterate over all tables
     #
+    my ( %packages, $order );
     for my $table ( $schema->get_tables ) {
         my $table_name = $table->name or next;
-        my %pk;
 
-        unless ( $no_comments ) {
-            $create .=
-                "#\n# Package: " .
-                $translator->format_package_name($table_name).
-                "\n#\n"
-        }
+        my $table_pkg_name = join '::', $main_pkg_name, $t->format_package_name($table_name);
+        $packages{ $table_pkg_name } = {
+            order    => ++$order,
+            pkg_name => $table_pkg_name,
+            base     => $main_pkg_name,
+            table    => $table_name,
+        };
 
-        $create .= "package ".$translator->format_package_name($table_name).";\n";
-		$create .= "use base ".$translator->format_package_name('DBI').";\n";
-        $create .= "use mixin 'Class::DBI::Join';\n";
-        $create .= "use Class::DBI::Pager;\n\n";
-		
-        $create .= $translator->format_package_name($table_name)."->set_up_table('$table_name');\n\n";
-		
         #
-        # Primary key?
+        # Primary key may have a differenct accessor method name
         #
-        foreach my $constraint ( $table->get_constraints ) {
-            next unless $constraint->type eq PRIMARY_KEY;
-            my $field = ($constraint->fields)[0];
-			
-            $pk{ $table_name } = $field;
-            $create .= "sub " .$translator->format_pk_name(
-                $translator->format_package_name( $table_name ),
-                $field
-            ) . " { shift->".$field." }\n\n";
+#        if ( my $constraint = $table->primary_key ) {
+#            my $field = ( $constraint->fields )[0];
+#            $packages{ $table_pkg_name }{'_columns_primary'} = $field;
+#
+#            if ( my $pk_xform = $t->format_pk_name ) {
+#                my $pk_name = $pk_xform->( $table_pkg_name, $field );
+#
+#                $packages{$table_pkg_name}{'pk_accessor'} =
+#                  "#\n# Primary key accessor\n#\n"
+#                  . "sub $pk_name {\n    shift->$field\n}\n\n";
+#            }
+#        }
+
+        my $is_data = 0;
+        foreach my $field ( $table->get_fields ) {
+            if ( !$field->is_foreign_key and !$field->is_primary_key ) {
+                push @{ $packages{$table_pkg_name}{'_columns_essential'} },
+                  $field->name;
+                $is_data++;
+            }
+            elsif ( !$field->is_primary_key ) {
+                push @{ $packages{$table_pkg_name}{'_columns_others'} },
+                  $field->name;
+            }
         }
-		
+
+        my %linked;
+        if ($is_data) {
+            foreach my $link ( keys %{ $linkable{$table_name} } ) {
+                my $linkmethodname;
+
+                if ( my $fk_xform = $t->format_fk_name ) {
+
+                    # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
+                    $linkmethodname = $fk_xform->(
+                        $linkable{ $table_name }{ $link }->name,
+                        ( $schema->get_table( $link )->primary_key->fields )[0]
+                      )
+                      . 's';
+                }
+                else {
+                    # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
+                    $linkmethodname =
+                      $linkable{ $table_name }{ $link }->name . '_'
+                      . ( $schema->get_table( $link )->primary_key->fields )[0]
+                      . 's';
+                }
+
+                my @rk_fields = ();
+                my @lk_fields = ();
+                foreach my $field ( $linkable{$table_name}{$link}->get_fields )
+                {
+                    next unless $field->is_foreign_key;
+
+                    next unless (
+                        $field->foreign_key_reference->reference_table eq
+                           $table_name
+                        ||
+                        $field->foreign_key_reference->reference_table eq $link
+                    );
+
+                    push @lk_fields,
+                      ( $field->foreign_key_reference->reference_fields )[0]
+                      if $field->foreign_key_reference->reference_table eq
+                      $link;
+
+                    push @rk_fields, $field->name
+                      if $field->foreign_key_reference->reference_table eq
+                      $table_name;
+                }
+
+                #
+                # If one possible traversal via link table.
+                #
+                if ( scalar(@rk_fields) == 1 and scalar(@lk_fields) == 1 ) {
+                    foreach my $rk_field (@rk_fields) {
+                        push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
+                          "sub "
+                          . $linkmethodname
+                          . " { my \$self = shift; "
+                          . "return map \$_->"
+                          . ( $schema->get_table($link)->primary_key->fields )
+                          [0]
+                          . ", \$self->"
+                          . $linkable{$table_name}{$link}->name . "_"
+                          . $rk_field
+                          . " }\n\n";
+                    }
+
+                    #
+                    # Else there is more than one way to traverse it.
+                    # ack!  Let's treat these types of link tables as
+                    # a many-to-one (easier)
+                    #
+                    # NOTE: we need to rethink the link method name,
+                    # as the cardinality has shifted on us.
+                    #
+                }
+                elsif ( scalar(@rk_fields) == 1 ) {
+                    foreach my $rk_field (@rk_fields) {
+                        #
+                        # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
+                        #
+                        push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
+                          "sub "
+                          . $linkable{$table_name}{$link}->name
+                          . "s { my \$self = shift; return \$self->"
+                          . $linkable{$table_name}{$link}->name . "_"
+                          . $rk_field
+                          . "(\@_) }\n\n";
+                    }
+                }
+                elsif ( scalar(@lk_fields) == 1 ) {
+                    #
+                    # These will be taken care of on the other end...
+                    #
+                }
+                else {
+                    #
+                    # Many many many.  Need multiple iterations here,
+                    # data structure revision to handle N FK sources.
+                    # This code has not been tested and likely doesn't
+                    # work here.
+                    #
+                    foreach my $rk_field (@rk_fields) {
+                        # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
+                        push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
+                          "sub "
+                          . $linkable{$table_name}{$link}->name . "_"
+                          . $rk_field
+                          . "s { my \$self = shift; return \$self->"
+                          . $linkable{$table_name}{$link}->name . "_"
+                          . $rk_field
+                          . "(\@_) }\n\n";
+                    }
+                }
+            }
+        }
+
         #
-        # Find foreign keys
+        # Use foreign keys to set up "has_a/has_many" relationships.
         #
         foreach my $field ( $table->get_fields ) {
             if ( $field->is_foreign_key ) {
+                my $table_name = $table->name;
                 my $field_name = $field->name;
+#                my $fk_method  = $t->format_fk_name( $table_name, $field_name );
+                my $fk_method  = join('::', $table_pkg_name,
+                    $t->format_fk_name( $table_name, $field_name )
+                );
                 my $fk         = $field->foreign_key_reference;
                 my $ref_table  = $fk->reference_table;
-                my @ref_fields = $fk->reference_fields;
-                my @fields     = $fk->fields;
+                my $ref_pkg    = $t->format_package_name($ref_table);
+                my $ref_field  = ( $fk->reference_fields )[0];
+#                my $fk_method  = join('::',
+#                    $table_pkg_name, $t->format_fk_name( $ref_table )
+#                );
+
+                push @{ $packages{$table_pkg_name}{'has_a'} },
+                  "$table_pkg_name->has_a(\n"
+                  . "    $field_name => '$ref_pkg'\n);\n\n"
+                  . "sub $fk_method {\n"
+                  . "    return shift->$field_name\n}\n\n"
+                ;
 
-              $create .= $translator->format_package_name($table_name). 
-                    "->has_a(\n    " .
-                    $translator->format_package_name($ref_table). 
-                    " => '$field_name'\n);\n\n";
-              $create .= "sub " .
-                    $translator->format_fk_name($ref_table, $field_name).
-                    " {\n    return shift->$field_name\n}\n\n";
+                # if there weren't M-M relationships via the has_many
+                # being set up here, create nice pluralized method alias
+                # rather for user as alt. to ugly tablename_fieldname name
+                #
+#                if ( !$packages{$ref_pkg}{'has_many'}{$table_name} ) {
+#                    #
+#                    # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
+#                    #
+#                    push @{ $packages{$ref_pkg}{'has_many'}{$table_name} },
+#                        "sub ${table_name}s {\n    " .
+#                        "return shift->$table_name\_$field_name\n}\n\n";
+#                    # else ugly
+#                }
+#                else {
+#                }
+
+                push @{ $packages{$ref_pkg}{'has_many'}{$table_name} },
+                  "$ref_pkg->has_many(\n    '${table_name}_${field_name}', "
+                  . "'$table_pkg_name' => '$field_name'\n);\n\n";
 
             }
         }
+    }
 
-		#
-		# Identify link tables, defined as tables that have only PK and FK
-		# fields
-		#
-		my %linkable;
-		foreach my $table ($schema->get_tables) {
-		  my $is_link = 1;
-		  foreach my $field ($table->get_fields){
-			$is_link = 0 and last unless $field->is_primary_key or $field->is_foreign_key;
-		  }
-		  
-		  if($is_link){
-			foreach my $left ($table->get_fields){
-			  next unless $left->is_foreign_key and 
-				$schema->get_table(
-								   $left->foreign_key_reference->reference_table
-								  )->get_field(
-											   ($left->foreign_key_reference->reference_fields)[0]
-											  )->is_primary_key;
-			  
-			  foreach my $right ($table->get_fields){
-				#skip the diagonal
-				next if $left->name eq $right->name;
-				
-				next unless $right->is_foreign_key and
-				  $schema->get_table(
-									 $right->foreign_key_reference->reference_table
-									)->get_field(
-												 ($right->foreign_key_reference->reference_fields)[0]
-												)->is_primary_key;
-				
-				
-				$linkable{$left->foreign_key_reference->reference_table}{$right->foreign_key_reference->reference_table} = $table;
-				$linkable{$right->foreign_key_reference->reference_table}{$left->foreign_key_reference->reference_table} = $table;
-
-#				if($left->foreign_key_reference->reference_table eq 'feature' and
-#				   $right->foreign_key_reference->reference_table eq 'pub'){
-#				  warn $left->foreign_key_reference->reference_table . " to " . $right->foreign_key_reference->reference_table . " via " . $table->name;
-#				  warn "\tleft:  ".$left->name;
-#				  warn "\tright: ".$right->name;
-#			  }
-				
-			  }
-			}
-		  }
-		  
-		}
-
-
-		#
-		# Generate many-to-many linking methods for data tables
-		#
-		my $is_data = 0;
-		map {(!$_->is_foreign_key and !$_->is_primary_key) ? $is_data++ : 0} $table->get_fields;
-		my %linked;
-		if($is_data){
-		  foreach my $link (keys %{$linkable{$table->name}}){
-			my $linkmethodname = "_".$translator->format_fk_name($table->name,$link)."_refs";
-
-
-			$create .= $translator->format_package_name($table->name).
-				  "->has_many('$linkmethodname','".
-				  $translator->format_package_name($linkable{$table->name}{$link}->name)."','".
-				  $link."');\n";
-			$create .= "sub ". $translator->format_fk_name($table,$link).
-				  ### HARDCODED 's' HERE.  ADD CALLBACK FOR PLURALIZATION MANGLING
-				  "s {\n    my \$self = shift; return map \$_->".$link.
-				  ", \$self->".$linkmethodname.";\n}\n\n";
-		  }
-		}
-	  }
-
-    $create .= '1;';
-
-    return $create;
-}
+    #
+    # Now build up text of package.
+    #
+    my $base_pkg = sprintf( 'Class::DBI%s', $from ? "::$from" : '' );
+    push @create, join ( "\n",
+        "package $main_pkg_name;\n",
+        $header,
+        "use strict;",
+        "use base '$base_pkg';\n",
+        "$main_pkg_name->set_db('Main', '$dsn', '$db_user', '$db_pass');\n\n",
+    );
+
+    for my $pkg_name (
+        sort { $packages{ $a }{'order'} <=> $packages{ $b }{'order'} }
+        keys %packages
+    ) {
+        my $pkg = $packages{$pkg_name} or next;
+        next unless $pkg->{'pkg_name'};
+
+        push @create, join ( "\n",
+            $sep,
+            "package " . $pkg->{'pkg_name'} . ";",
+            "use base '" . $pkg->{'base'} . "';",
+            "use Class::DBI::Pager;\n\n",
+        );
+
+                if ( $from ) {
+                    push @create, join('',
+                        $pkg->{'pkg_name'},
+                        "->set_up_table('",
+                        $pkg->{'table'},
+                        "');\n\n"
+                    );
+                }
+                else {
+                    my $table       = $schema->get_table( $pkg->{'table'} );
+                    my @field_names = map { $_->name } $table->get_fields;
 
+                    push @create, join("\n",
+                        $pkg_name."->table('".$pkg->{'table'}."');\n",
+                        $pkg_name."->columns(All => qw/".
+                        join(' ', @field_names)."/);\n\n",
+                    );
+                }
 
-sub _from {
-    my $from = shift;
-    my @temp = split(/::/, $from);
-    $from    = $temp[$#temp];
+        push @create, "\n";
 
-    if ( $from eq 'MySQL') {
-        $from = lc($from);
-    } elsif ( $from eq 'PostgreSQL') {
-        $from = 'Pg';
-    } elsif ( $from eq 'Oracle') {
-        $from = 'Oracle';
-    } else {
-        die "__PACKAGE__ can't handle vendor $from";
+        if ( my $pk = $pkg->{'pk_accessor'} ) {
+            push @create, $pk;
+        }
+
+        if ( my @has_a = @{ $pkg->{'has_a'} || [] } ) {
+            push @create, $_ for @has_a;
+        }
+
+        foreach my $has_many_key ( keys %{ $pkg->{'has_many'} } ) {
+            if ( my @has_many = @{ $pkg->{'has_many'}{$has_many_key} || [] } ) {
+                push @create, $_ for @has_many;
+            }
+        }
     }
 
-    return $from;
+    push @create, "1;\n";
+
+    return wantarray
+        ? @create
+        : join('', @create);
 }
 
 1;
 
-__END__
+=pod
 
 =head1 NAME
 
-SQL::Translator::Producer::ClassDBI - 
-    Translate SQL schemata into Class::DBI classes
+SQL::Translator::Producer::ClassDBI - create Class::DBI classes from schema
 
 =head1 SYNOPSIS
 
 Use this producer as you would any other from SQL::Translator.  See
 L<SQL::Translator> for details.
 
-This package utilizes SQL::Translator's formatting methods
+This package uses SQL::Translator's formatting methods
 format_package_name(), format_pk_name(), format_fk_name(), and
 format_table_name() as it creates classes, one per table in the schema
 provided.  An additional base class is also created for database connectivity
@@ -225,6 +386,6 @@ configuration.  See L<Class::DBI> for details on how this works.
 
 =head1 AUTHORS
 
-Ying Zhang E<lt>zyolive@yahoo.comE<gt>, 
-Allen Day E<lt>allenday@ucla.eduE<gt>
-Ken Y. Clark E<lt>kclark@cpan.org<gt>.
+Allen Day E<lt>allenday@ucla.eduE<gt>,
+Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.