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

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

# -------------------------------------------------------------------
# $Id: ClassDBI.pm,v 1.27 2003-07-09 06:09:56 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.27 $ =~ /(\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"
                ;
            }
        }
        
        #
        # Use foreign keys to set up "has_a/has_many" relationships.
        #
        my $is_data = 0;
        foreach my $field ( $table->get_fields ) {
            $is_data++ if !$field->is_foreign_key and !$field->is_primary_key;
            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
                push @{ $packages{ $ref_pkg }{'has_many'} },
                    "$ref_pkg->has_many(\n    '${table_name}_${field_name}', ".
                    "'$table_pkg_name' => '$field_name'\n);\n\n"
                ;
            }
		}

         my %linked;
         if ( $is_data ) {
             foreach my $link ( keys %{ $linkable{ $table_name } } ) {
			   my $linkmethodname;

			   # ADD CALLBACK FOR PLURALIZATION MANGLING HERE
			   if ( my $fk_xform = $t->format_fk_name ){
				 $linkmethodname = $fk_xform->($linkable{$table_name}{$link}->name,
				   ($schema->get_table($link)->primary_key->fields)[0]).'s';
			   } else {
				 $linkmethodname = $linkable{$table_name}{$link}->name.'_'.
				   ($schema->get_table($link)->primary_key->fields)[0].'s';
			   }

#$create .= $field->name. "\n";
#$create .= $field->foreign_key_reference->reference_table. "\n";
#$create .= $linkable{ $table_name }{ $link }->name. "\n";
#$create .= $table_name. "\n";
#$create .= $link. "\n";
#$create .= "***\n\n";

			   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'} },
					 "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){
				   push @{ $packages{ $table_pkg_name }{'has_many'} },
					 "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
				 foreach my $rk_field (@rk_fields){
				   push @{ $packages{ $table_pkg_name }{'has_many'} },
					 "sub " . $linkable{$table_name}{$link}->name . "_" . $rk_field .
					   "s { my \$self = shift; return \$self->" .
						 $linkable{$table_name}{$link}->name . "_" .
						   $rk_field . "(\@_) }\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;
        }

        if ( my @has_many = @{ $pkg->{'has_many'} || [] } ) {
            $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	# -------------------------------------------------------------------
ae57c892	4	# $Id: ClassDBI.pm,v 1.27 2003-07-09 06:09:56 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 ];
ae57c892	26	$VERSION = sprintf "%d.%02d", q$Revision: 1.27 $ =~ /(\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);
bf4629e7	123
	124	$packages{ $table_pkg_name }{'pk_accessor'} =
	125	"#\n# Primary key accessor\n#\n".
390292d3	126	"sub $pk_name {\n shift->$field\n}\n\n"
bf4629e7	127	;
bf4629e7	128	}
6c45056f	129	}
bf4629e7	130
6c45056f	131	#
bf4629e7	132	# Use foreign keys to set up "has_a/has_many" relationships.
6c45056f	133	#
fe77d758	134	my $is_data = 0;
6c45056f	135	foreach my $field ( $table->get_fields ) {
fe77d758	136	$is_data++ if !$field->is_foreign_key and !$field->is_primary_key;
6c45056f	137	if ( $field->is_foreign_key ) {
bf4629e7	138	my $table_name = $table->name;
6c45056f	139	my $field_name = $field->name;
390292d3	140	my $fk_method = $t->format_fk_name($table_name, $field_name);
6c45056f	141	my $fk = $field->foreign_key_reference;
6c45056f	142	my $ref_table = $fk->reference_table;
390292d3	143	my $ref_pkg = $t->format_package_name($ref_table);
390292d3	144	my $ref_field = ($fk->reference_fields)[0];
6c45056f	145
bf4629e7	146	push @{ $packages{ $table_pkg_name }{'has_a'} },
	147	"$table_pkg_name->has_a(\n".
	148	" $field_name => '$ref_pkg'\n);\n\n".
390292d3	149	"sub $fk_method {\n".
bf4629e7	150	" return shift->$field_name\n}\n\n"
bf4629e7	151	;
52fbac6a	152
bf4629e7	153	#
	154	# If this table "has a" to the other, then it follows
	155	# that the other table "has many" of this one, right?
	156	#
c703e51d	157	# No... there is the possibility of 1-1 cardinality
bf4629e7	158	push @{ $packages{ $ref_pkg }{'has_many'} },
390292d3	159	"$ref_pkg->has_many(\n '${table_name}_${field_name}', ".
bf4629e7	160	"'$table_pkg_name' => '$field_name'\n);\n\n"
bf4629e7	161	;
6c45056f	162	}
c703e51d	163	}
	164
	165	my %linked;
	166	if ( $is_data ) {
	167	foreach my $link ( keys %{ $linkable{ $table_name } } ) {
	168	my $linkmethodname;
	169
	170	# ADD CALLBACK FOR PLURALIZATION MANGLING HERE
	171	if ( my $fk_xform = $t->format_fk_name ){
	172	$linkmethodname = $fk_xform->($linkable{$table_name}{$link}->name,
	173	($schema->get_table($link)->primary_key->fields)[0]).'s';
	174	} else {
	175	$linkmethodname = $linkable{$table_name}{$link}->name.'_'.
	176	($schema->get_table($link)->primary_key->fields)[0].'s';
	177	}
	178
	179	#$create .= $field->name. "\n";
	180	#$create .= $field->foreign_key_reference->reference_table. "\n";
	181	#$create .= $linkable{ $table_name }{ $link }->name. "\n";
	182	#$create .= $table_name. "\n";
	183	#$create .= $link. "\n";
	184	#$create .= "***\n\n";
	185
	186	my @rk_fields = ();
	187	my @lk_fields = ();
	188	foreach my $field ($linkable{$table_name}{$link}->get_fields){
	189	next unless $field->is_foreign_key;
	190
	191	next unless(
	192	$field->foreign_key_reference->reference_table eq $table_name
	193	\|\|
	194	$field->foreign_key_reference->reference_table eq $link
	195	);
	196	push @lk_fields, ($field->foreign_key_reference->reference_fields)[0]
	197	if $field->foreign_key_reference->reference_table eq $link;
	198	push @rk_fields, $field->name
	199	if $field->foreign_key_reference->reference_table eq $table_name;
	200	}
	201
	202	#if one possible traversal via link table
	203	if(scalar(@rk_fields) == 1 and scalar(@lk_fields) == 1){
	204	foreach my $rk_field (@rk_fields){
	205	push @{ $packages{ $table_pkg_name }{'has_many'} },
	206	"sub ".$linkmethodname." { my \$self = shift; ".
	207	"return map \$_->".
	208	($schema->get_table($link)->primary_key->fields)[0].
	209	", \$self->".$linkable{$table_name}{$link}->name.
	210	"_".$rk_field." }\n\n";
	211	}
	212	#else there is more than one way to traverse it. ack!
	213	#let's treat these types of link tables as a many-to-one (easier)
	214	#
	215	#NOTE: we need to rethink the link method name, as the cardinality
	216	#has shifted on us.
	217	} elsif(scalar(@rk_fields) == 1){
	218	foreach my $rk_field (@rk_fields){
	219	push @{ $packages{ $table_pkg_name }{'has_many'} },
	220	"sub " . $linkable{$table_name}{$link}->name .
	221	"s { my \$self = shift; return \$self->" .
	222	$linkable{$table_name}{$link}->name . "_" .
	223	$rk_field . "(\@_) }\n\n";
	224	}
	225	} elsif(scalar(@lk_fields) == 1){
	226	#these will be taken care of on the other end...
227	} else {
ae57c892	228	#many many many. need multiple iterations here, data structure revision
ae57c892	229	#to handle N FK sources
c703e51d	230	foreach my $rk_field (@rk_fields){
	231	push @{ $packages{ $table_pkg_name }{'has_many'} },
	232	"sub " . $linkable{$table_name}{$link}->name . "_" . $rk_field .
	233	"s { my \$self = shift; return \$self->" .
	234	$linkable{$table_name}{$link}->name . "_" .
	235	$rk_field . "(\@_) }\n\n";
	236	}
	237	}
fe77d758	238	}
fe77d758	239	}
bf4629e7	240	}
6c45056f	241
fe77d758	242	#
	243	# Now build up text of package.
	244	#
bf4629e7	245	my $base_pkg = sprintf( 'Class::DBI%s', $from ? "::$from" : '' );
c703e51d	246	$create .= join("\n",
	247	"package $main_pkg_name;\n",
	248	$header,
	249	"use strict;",
	250	"use base '$base_pkg';\n",
	251	"$main_pkg_name->set_db('Main', '$dsn', '$db_user', '$db_pass');\n\n",
bf4629e7	252	);
	253
	254	for my $pkg_name (
	255	sort { $packages{ $a }{'order'} <=> $packages{ $b }{'order'} }
	256	keys %packages
	257	) {
	258	my $pkg = $packages{ $pkg_name };
	259
	260	$create .= join("\n",
	261	$sep,
	262	"package ".$pkg->{'pkg_name'}.";",
	263	"use base '".$pkg->{'base'}."';",
	264	"use Class::DBI::Pager;\n\n",
	265	);
f42e7027	266
bf4629e7	267	if ( $from ) {
	268	$create .=
	269	$pkg->{'pkg_name'}."->set_up_table('".$pkg->{'table'}."');\n\n";
	270	}
	271	else {
	272	my $table = $schema->get_table( $pkg->{'table'} );
	273	my @field_names = map { $_->name } $table->get_fields;
	274
	275	$create .= join("\n",
	276	$pkg_name."->table('".$pkg->{'table'}."');\n",
	277	$pkg_name."->columns(All => qw/".
	278	join(' ', @field_names)."/);\n\n",
	279	);
	280	}
52fbac6a	281
bf4629e7	282	if ( my $pk = $pkg->{'pk_accessor'} ) {
	283	$create .= $pk;
	284	}
df602cfb	285
bf4629e7	286	if ( my @has_a = @{ $pkg->{'has_a'} \|\| [] } ) {
	287	$create .= $_ for @has_a;
	288	}
	289
	290	if ( my @has_many = @{ $pkg->{'has_many'} \|\| [] } ) {
	291	$create .= $_ for @has_many;
	292	}
6c45056f	293	}
df602cfb	294
bf4629e7	295	$create .= "1;\n";
	296
	297	return $create;
f42e7027	298	}
	299
	300	1;
	301
bf4629e7	302	# -------------------------------------------------------------------
	303
	304	=pod
f42e7027	305
	306	=head1 NAME
	307
bf4629e7	308	SQL::Translator::Producer::ClassDBI - create Class::DBI classes from schema
f42e7027	309
	310	=head1 SYNOPSIS
	311
1eee27d3	312	Use this producer as you would any other from SQL::Translator. See
1eee27d3	313	L<SQL::Translator> for details.
f42e7027	314
1eee27d3	315	This package utilizes SQL::Translator's formatting methods
	316	format_package_name(), format_pk_name(), format_fk_name(), and
	317	format_table_name() as it creates classes, one per table in the schema
	318	provided. An additional base class is also created for database connectivity
	319	configuration. See L<Class::DBI> for details on how this works.
f42e7027	320
6c45056f	321	=head1 AUTHORS
f42e7027	322
6c45056f	323	Allen Day E<lt>allenday@ucla.eduE<gt>
5f054727	324	Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
6c45056f	325	Ken Y. Clark E<lt>kclark@cpan.org<gt>.