X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FClassDBI.pm;h=61e731dd7098c784567949a41d47eefb43809e46;hb=ba506e52c480afe33dfec6b38a12759fad1e7fa2;hp=907e829787c0cd4aeef949d47a94b8c989985de1;hpb=10b40f96855f37ae506a5e8d841193da94d02544;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 907e829..61e731d
--- a/lib/SQL/Translator/Producer/ClassDBI.pm
+++ b/lib/SQL/Translator/Producer/ClassDBI.pm
@@ -1,10 +1,7 @@
 package SQL::Translator::Producer::ClassDBI;
 
 # -------------------------------------------------------------------
-# $Id: ClassDBI.pm,v 1.30 2003-08-12 23:21:54 kycl4rk Exp $
-# -------------------------------------------------------------------
-# Copyright (C) 2003 Allen Day <allenday@ucla.edu>,
-#                    Ying Zhang <zyolive@yahoo.com>
+# Copyright (C) 2002-2009 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,47 +20,60 @@ package SQL::Translator::Producer::ClassDBI;
 
 use strict;
 use vars qw[ $VERSION $DEBUG ];
-$VERSION = sprintf "%d.%02d", q$Revision: 1.30 $ =~ /(\d+)\.(\d+)/;
+$VERSION = '1.60';
 $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',
+    MySQL      => 'mysql',
+    PostgreSQL => 'Pg',
+    Oracle     => 'Oracle',
 );
 
 # -------------------------------------------------------------------
 sub produce {
-    my $t      = shift;
-    my $create = undef;
-    local $DEBUG = $t->debug;
+    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_pass'} || '';
-    my $main_pkg_name = $t->format_package_name('DBI');
+    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;
+    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;
-    foreach my $table ( $schema->get_tables ) {
+    for my $table ( $schema->get_tables ) {
+        debug("PKG: Table = ", $table->name, "\n");
         my $is_link = 1;
-        foreach my $field ( $table->get_fields ) {
+        for my $field ( $table->get_fields ) {
             unless ( $field->is_primary_key or $field->is_foreign_key ) {
                 $is_link = 0;
                 last;
@@ -105,8 +115,8 @@ sub produce {
     for my $table ( $schema->get_tables ) {
         my $table_name = $table->name or next;
 
-        my $table_pkg_name = $t->format_package_name($table_name);
-        $packages{$table_pkg_name} = {
+        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,
@@ -116,18 +126,18 @@ sub produce {
         #
         # Primary key may have a differenct accessor method name
         #
-        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";
-            }
-        }
+#        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 ) {
@@ -151,17 +161,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 +180,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 +215,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 +239,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 "
@@ -252,37 +272,40 @@ sub produce {
             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  = $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_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";
-
-                #
-                # 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
+                  . "    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 {
-                }
+                #
+#                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}', "
@@ -296,7 +319,7 @@ sub produce {
     # Now build up text of package.
     #
     my $base_pkg = sprintf( 'Class::DBI%s', $from ? "::$from" : '' );
-    $create .= join ( "\n",
+    push @create, join ( "\n",
         "package $main_pkg_name;\n",
         $header,
         "use strict;",
@@ -308,84 +331,57 @@ 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",
+        push @create, join ( "\n",
             $sep,
             "package " . $pkg->{'pkg_name'} . ";",
             "use base '" . $pkg->{'base'} . "';",
             "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 ) {
+                    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",
+                    );
+                }
 
-        $create .= "\n";
+        push @create, "\n";
 
         if ( my $pk = $pkg->{'pk_accessor'} ) {
-            $create .= $pk;
+            push @create, $pk;
         }
 
         if ( my @has_a = @{ $pkg->{'has_a'} || [] } ) {
-            $create .= $_ for @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} || [] } ) {
-                $create .= $_ for @has_many;
+                push @create, $_ for @has_many;
             }
         }
     }
 
-    $create .= "1;\n";
+    push @create, "1;\n";
 
-    return $create;
+    return wantarray
+        ? @create
+        : join('', @create);
 }
 
 1;
@@ -403,7 +399,7 @@ SQL::Translator::Producer::ClassDBI - create Class::DBI classes from schema
 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
@@ -411,6 +407,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 Youens-Clark E<lt>kclark@cpan.orgE<gt>.