Some fixes.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / ClassDBI.pm
index 907e829..0ac8d46 100755 (executable)
@@ -1,10 +1,9 @@
 package SQL::Translator::Producer::ClassDBI;
 
 # -------------------------------------------------------------------
-# $Id: ClassDBI.pm,v 1.30 2003-08-12 23:21:54 kycl4rk Exp $
+# $Id: ClassDBI.pm,v 1.40 2004-02-09 23:02:11 kycl4rk Exp $
 # -------------------------------------------------------------------
-# Copyright (C) 2003 Allen Day <allenday@ucla.edu>,
-#                    Ying Zhang <zyolive@yahoo.com>
+# Copyright (C) 2002-4 SQLFairy Authors
 #
 # This program is free software; you can redistribute it and/or
 # modify it under the terms of the GNU General Public License as
@@ -23,7 +22,7 @@ package SQL::Translator::Producer::ClassDBI;
 
 use strict;
 use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.40 $ =~ /(\d+)\.(\d+)/;
 $DEBUG = 1 unless defined $DEBUG;
 
 use SQL::Translator::Schema::Constants;
@@ -31,9 +30,9 @@ use SQL::Translator::Utils qw(header_comment);
 use Data::Dumper;
 
 my %CDBI_auto_pkgs = (
-    MySQL          => 'mysql',
-    PostgreSQL     => 'Pg',
-    Oracle         => 'Oracle',
+    MySQL      => 'mysql',
+    PostgreSQL => 'Pg',
+    Oracle     => 'Oracle',
 );
 
 # -------------------------------------------------------------------
@@ -46,15 +45,16 @@ sub produce {
     my $args          = $t->producer_args;
     my $db_user       = $args->{'db_user'} || '';
     my $db_pass       = $args->{'db_pass'} || '';
-    my $main_pkg_name = $t->format_package_name('DBI');
+    my $main_pkg_name = $args->{'main_pkg_name'} ||
+                        $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;
+    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).
@@ -151,17 +151,16 @@ sub produce {
 
                     # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
                     $linkmethodname = $fk_xform->(
-                        $linkable{$table_name}{$link}->name,
-                        ( $schema->get_table($link)->primary_key->fields )[0]
+                        $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]
+                      $linkable{ $table_name }{ $link }->name . '_'
+                      . ( $schema->get_table( $link )->primary_key->fields )[0]
                       . 's';
                 }
 
@@ -171,21 +170,26 @@ sub produce {
                 {
                     next unless $field->is_foreign_key;
 
-                    next
-                      unless ( $field->foreign_key_reference->reference_table eq
+                    next unless ( 
+                        $field->foreign_key_reference->reference_table eq
                            $table_name
-                        || $field->foreign_key_reference->reference_table eq
-                        $link );
+                        || 
+                        $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 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} },
@@ -201,17 +205,20 @@ sub produce {
                           . " }\n\n";
                     }
 
-                    # else there is more than one way to traverse it.
-                    # ack!  let's treat these types of link tables as
+                    #
+                    # 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
@@ -222,15 +229,18 @@ sub produce {
                     }
                 }
                 elsif ( scalar(@lk_fields) == 1 ) {
-                    # these will be taken care of on the other end...
+                    #
+                    # These will be taken care of on the other end...
+                    #
                 }
                 else {
-                    # many many many.  need multiple iterations here,
+                    #
+                    # 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
+                    # work here.
+                    #
                     foreach my $rk_field (@rk_fields) {
-
                         # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
                         push @{ $packages{$table_pkg_name}{'has_many'}{$link} },
                           "sub "
@@ -264,22 +274,18 @@ sub produce {
                   . "sub $fk_method {\n"
                   . "    return shift->$field_name\n}\n\n";
 
-                #
-                # If this table "has a" to the other, then it follows 
-                # that the other table "has many" of this one, right?
-                #
-                # No... there is the possibility of 1-1 cardinality
-
                 # 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
+                        "sub ${table_name}s {\n    " .
+                        "return shift->$table_name\_$field_name\n}\n\n";
+                    # else ugly
                 }
                 else {
                 }
@@ -308,7 +314,8 @@ sub produce {
         sort { $packages{ $a }{'order'} <=> $packages{ $b }{'order'} }
         keys %packages
     ) {
-        my $pkg = $packages{ $pkg_name };
+        my $pkg = $packages{$pkg_name} or next;
+        next unless $pkg->{'pkg_name'};
 
         $create .= join ( "\n",
             $sep,
@@ -317,54 +324,20 @@ sub produce {
             "use Class::DBI::Pager;\n\n",
         );
 
-        #if ( $from ) {
-        #    $create .= 
-        #        $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;
-        #
-        #    $create .= join("\n",
-        #        $pkg_name."->table('".$pkg->{'table'}."');\n",
-        #        $pkg_name."->columns(All => qw/".
-        #        join(' ', @field_names)."/);\n\n",
-        #    );
-        #}
-
-        # the approach here is to do lazy loading on the expensive
-        # columns (expensive defined as those columns which require
-        # construction of a referenced object) fields which are
-        # strictly data (ie, not references) are treated as essential
-        # b/c they don't require much time to set up.
-
-        $create .= $pkg_name . "->table('" . $pkg->{'table'} . "');\n";
-
-        # set up primary key field
-        if ( $pkg->{'_columns_primary'} ) {
-            $create .= $pkg_name
-              . "->columns(Primary   => qw/"
-              . $pkg->{'_columns_primary'} . "/);\n";
-        }
-        else {
-            die "Class::DBI isn't going to like that you don't have".
-                " a primary key field for table " . $pkg->{'table'} .
-                " in package '$pkg_name'";
-        }
-
-        # set up non-FK fields to be populated at construction
-        if ( $pkg->{'_columns_essential'} ) {
-            $create .= $pkg_name
-              . "->columns(Essential => qw/"
-              . join ( ' ', @{ $pkg->{'_columns_essential'} } ) . "/);\n";
-        }
-
-        # set up FK fields for lazy loading on request
-        if ( $pkg->{'_columns_others'} ) {
-            $create .= $pkg_name
-              . "->columns(Others    => qw/"
-              . join ( ' ', @{ $pkg->{'_columns_others'} } ) . "/);\n";
-        }
+                if ( $from ) {
+                    $create .= 
+                        $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;
+                                       
+                    $create .= join("\n",
+                        $pkg_name."->table('".$pkg->{'table'}."');\n",
+                        $pkg_name."->columns(All => qw/".
+                        join(' ', @field_names)."/);\n\n",
+                    );
+                }
 
         $create .= "\n";
 
@@ -411,6 +384,6 @@ configuration.  See L<Class::DBI> for details on how this works.
 
 =head1 AUTHORS
 
-Allen Day E<lt>allenday@ucla.eduE<gt>
+Allen Day E<lt>allenday@ucla.eduE<gt>,
 Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
-Ken Y. Clark E<lt>kclark@cpan.org<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.