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

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

# -------------------------------------------------------------------
# $Id: ClassDBI.pm,v 1.19 2003-06-25 02:04:33 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.19 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 1 unless defined $DEBUG;

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

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 .= "use strict;\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";
	
    #
    # Iterate over all tables
    #
    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"
        }

        $create .= "package ".$translator->format_package_name($table_name).";\n\n";
		$create .= "use strict;\n";
		$create .= "use base qw(".$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?
        #
        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";
        }
		
        #
        # Find foreign keys
        #
        foreach my $field ( $table->get_fields ) {
            if ( $field->is_foreign_key ) {
                my $field_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;

              $create .= $translator->format_package_name($table_name). 
                    "->hasa(\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";

            }
        }

		#
		# Identify link tables, defined as tables that 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){
			$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);


			  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);
				
				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;
				$linktable{$table->name} = $table;
				
			  }
			}
		  }
		  
		}


		#
		# 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)."','".
				  ($schema->get_table($link)->primary_key->fields)[0]."');\n";
#				  $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;
}


sub _from {
    my $from = shift;
    my @temp = split(/::/, $from);
    $from    = $temp[$#temp];

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

    return $from;
}

1;

__END__

=head1 NAME

SQL::Translator::Producer::ClassDBI - 
    Translate SQL schemata into Class::DBI classes

=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	# -------------------------------------------------------------------
ddeb20a5	4	# $Id: ClassDBI.pm,v 1.19 2003-06-25 02:04:33 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 ];
ddeb20a5	26	$VERSION = sprintf "%d.%02d", q$Revision: 1.19 $ =~ /(\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;
	32
	33	sub produce {
52fbac6a	34	my ($translator, $data) = @_;
	35	local $DEBUG = $translator->debug;
	36	my $no_comments = $translator->no_comments;
	37	my $schema = $translator->schema;
df602cfb	38
6c45056f	39	my $create;
6c45056f	40	$create .= header_comment(__PACKAGE__, "# ") unless ($no_comments);
df602cfb	41
6c45056f	42	$create .= "package " . $translator->format_package_name('DBI'). ";\n\n";
df602cfb	43
ddeb20a5	44	$create .= "use strict;\n\n";
6c45056f	45	$create .= "my \$USER = '';\n";
6c45056f	46	$create .= "my \$PASS = '';\n\n";
df602cfb	47
6c45056f	48	my $from = _from($translator->parser_type());
df602cfb	49
6c45056f	50	$create .= "use base 'Class::DBI::$from';\n\n" .
	51	$translator->format_package_name('DBI') .
	52	"->set_db('Main', 'dbi:$from:_', \$USER, \$PASS);\n\n";
df602cfb	53
6c45056f	54	#
	55	# Iterate over all tables
	56	#
	57	for my $table ( $schema->get_tables ) {
	58	my $table_name = $table->name or next;
	59	my %pk;
	60
	61	unless ( $no_comments ) {
df602cfb	62	$create .=
6c45056f	63	"#\n# Package: " .
df602cfb	64	$translator->format_package_name($table_name).
df602cfb	65	"\n#\n"
6c45056f	66	}
6c45056f	67
ddeb20a5	68	$create .= "package ".$translator->format_package_name($table_name).";\n\n";
	69	$create .= "use strict;\n";
	70	$create .= "use base qw(".$translator->format_package_name('DBI').");\n";
6c45056f	71	$create .= "use mixin 'Class::DBI::Join';\n";
6c45056f	72	$create .= "use Class::DBI::Pager;\n\n";
52fbac6a	73
52fbac6a	74	$create .= $translator->format_package_name($table_name)."->set_up_table('$table_name');\n\n";
df602cfb	75
6c45056f	76	#
	77	# Primary key?
	78	#
	79	foreach my $constraint ( $table->get_constraints ) {
	80	next unless $constraint->type eq PRIMARY_KEY;
	81	my $field = ($constraint->fields)[0];
df602cfb	82
6c45056f	83	$pk{ $table_name } = $field;
	84	$create .= "sub " .$translator->format_pk_name(
	85	$translator->format_package_name( $table_name ),
	86	$field
	87	) . " { shift->".$field." }\n\n";
	88	}
df602cfb	89
6c45056f	90	#
	91	# Find foreign keys
	92	#
	93	foreach my $field ( $table->get_fields ) {
	94	if ( $field->is_foreign_key ) {
	95	my $field_name = $field->name;
	96	my $fk = $field->foreign_key_reference;
	97	my $ref_table = $fk->reference_table;
	98	my @ref_fields = $fk->reference_fields;
	99	my @fields = $fk->fields;
	100
	101	$create .= $translator->format_package_name($table_name).
ddeb20a5	102	"->hasa(\n '" .
6c45056f	103	$translator->format_package_name($ref_table).
ddeb20a5	104	"' => '$field_name'\n);\n\n";
6c45056f	105	$create .= "sub " .
	106	$translator->format_fk_name($ref_table, $field_name).
	107	" {\n return shift->$field_name\n}\n\n";
52fbac6a	108
6c45056f	109	}
6c45056f	110	}
df602cfb	111
7813f003	112	#
	113	# Identify link tables, defined as tables that have only PK and FK
	114	# fields
	115	#
	116	my %linkable;
52fbac6a	117	my %linktable;
	118	foreach my $table ($schema->get_tables) {
	119	my $is_link = 1;
	120	foreach my $field ($table->get_fields){
	121	$is_link = 0 and last unless $field->is_primary_key or $field->is_foreign_key;
	122	}
	123
	124	if($is_link){
	125	foreach my $left ($table->get_fields){
	126	next unless $left->is_foreign_key and $schema->get_table($left->foreign_key_reference->reference_table);
	127
	128
	129	next unless $left->is_foreign_key and
	130	$schema->get_table(
	131	$left->foreign_key_reference->reference_table
	132	)->get_field(
	133	($left->foreign_key_reference->reference_fields)[0]
	134	)->is_primary_key;
	135
	136	foreach my $right ($table->get_fields){
	137	#skip the diagonal
	138	next if $left->name eq $right->name;
	139
	140	next unless $right->is_foreign_key and $schema->get_table($right->foreign_key_reference->reference_table);
	141
	142	next unless $right->is_foreign_key and
	143	$schema->get_table(
	144	$right->foreign_key_reference->reference_table
	145	)->get_field(
	146	($right->foreign_key_reference->reference_fields)[0]
	147	)->is_primary_key;
	148
	149
	150	$linkable{$left->foreign_key_reference->reference_table}{$right->foreign_key_reference->reference_table} = $table;
	151	$linkable{$right->foreign_key_reference->reference_table}{$left->foreign_key_reference->reference_table} = $table;
	152	$linktable{$table->name} = $table;
	153
	154	}
	155	}
	156	}
	157
7813f003	158	}
	159
	160
	161	#
	162	# Generate many-to-many linking methods for data tables
	163	#
df602cfb	164	my $is_data = 0;
52fbac6a	165	map {(!$_->is_foreign_key and !$_->is_primary_key) ? $is_data++ : 0} $table->get_fields;
7813f003	166	my %linked;
52fbac6a	167	if($is_data){
	168	foreach my $link (keys %{$linkable{$table->name}}){
	169	my $linkmethodname = "_".$translator->format_fk_name($table->name,$link)."_refs";
	170
	171
	172	$create .= $translator->format_package_name($table->name).
	173	"->has_many('$linkmethodname','".
	174	$translator->format_package_name($linkable{$table->name}{$link}->name)."','".
	175	($schema->get_table($link)->primary_key->fields)[0]."');\n";
	176	# $link."');\n";
	177	$create .= "sub ". $translator->format_fk_name($table,$link).
	178	### HARDCODED 's' HERE. ADD CALLBACK FOR PLURALIZATION MANGLING
	179	"s {\n my \$self = shift; return map \$_->".$link.
	180	", \$self->".$linkmethodname.";\n}\n\n";
	181	}
	182	}
	183	}
6c45056f	184
	185	$create .= '1;';
	186
6c45056f	187	return $create;
f42e7027	188	}
f42e7027	189
52fbac6a	190
f42e7027	191	sub _from {
6c45056f	192	my $from = shift;
	193	my @temp = split(/::/, $from);
	194	$from = $temp[$#temp];
df602cfb	195
6c45056f	196	if ( $from eq 'MySQL') {
	197	$from = lc($from);
	198	} elsif ( $from eq 'PostgreSQL') {
	199	$from = 'Pg';
	200	} elsif ( $from eq 'Oracle') {
	201	$from = 'Oracle';
	202	} else {
	203	die "__PACKAGE__ can't handle vendor $from";
	204	}
df602cfb	205
6c45056f	206	return $from;
f42e7027	207	}
	208
	209	1;
	210
	211	__END__
	212
	213	=head1 NAME
	214
6c45056f	215	SQL::Translator::Producer::ClassDBI -
6c45056f	216	Translate SQL schemata into Class::DBI classes
f42e7027	217
	218	=head1 SYNOPSIS
	219
1eee27d3	220	Use this producer as you would any other from SQL::Translator. See
1eee27d3	221	L<SQL::Translator> for details.
f42e7027	222
1eee27d3	223	This package utilizes SQL::Translator's formatting methods
	224	format_package_name(), format_pk_name(), format_fk_name(), and
	225	format_table_name() as it creates classes, one per table in the schema
	226	provided. An additional base class is also created for database connectivity
	227	configuration. See L<Class::DBI> for details on how this works.
f42e7027	228
6c45056f	229	=head1 AUTHORS
f42e7027	230
6c45056f	231	Allen Day E<lt>allenday@ucla.eduE<gt>
5f054727	232	Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
6c45056f	233	Ken Y. Clark E<lt>kclark@cpan.org<gt>.