[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Producer / ClassDBI.pm

package SQL::Translator::Producer::ClassDBI;

# -------------------------------------------------------------------
# $Id: ClassDBI.pm,v 1.28 2003-07-09 17:48:12 allenday Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Allen Day <allenday@ucla.edu>,
#                    Ying Zhang <zyolive@yahoo.com>
#
# 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.28 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 1 unless defined $DEBUG;

use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(header_comment);
use Data::Dumper;

my %CDBI_auto_pkgs = (
    MySQL      => 'mysql',
    PostgreSQL => 'Pg',
    Oracle     => 'Oracle',
);

# -------------------------------------------------------------------
sub produce {
    my $t             = shift;
	my $create        = undef;
    local $DEBUG      = $t->debug;
    my $no_comments   = $t->no_comments;
    my $schema        = $t->schema;
    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 $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;
    foreach my $table ( $schema->get_tables ) {
        my $is_link = 1;
        foreach 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 $table_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,
        };

        #
        # Primary key may have a differenct accessor method name
        #
        if ( my $pk_xform = $t->format_pk_name ) {
            if ( my $constraint = $table->primary_key ) {
                my $field          = ($constraint->fields)[0];
                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 ) {
		  $is_data++ if !$field->is_foreign_key and !$field->is_primary_key;
		}

		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";
			  }
			}
		  }
        }


        #
        # 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         = $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];

                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

				#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";

            }
		}
	}

    #
    # Now build up text of package.
    #
    my $base_pkg = sprintf( 'Class::DBI%s', $from ? "::$from" : '' );
    $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 };

        $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",
            );
        }

        if ( my $pk = $pkg->{'pk_accessor'} ) {
            $create .= $pk;
        }

        if ( my @has_a = @{ $pkg->{'has_a'} || [] } ) {
            $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;
		  }
		}
    }

    $create .= "1;\n";

    return $create;
}

1;

# -------------------------------------------------------------------

=pod

=head1 NAME

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
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
configuration.  See L<Class::DBI> for details on how this works.

=head1 AUTHORS

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