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

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

# -------------------------------------------------------------------
# $Id: ClassDBI.pm,v 1.11 2003-06-09 05:38:11 allenday Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Ying Zhang <zyolive@yahoo.com>,
#                    Allen Day <allenday@ucla.edu>,
#
# 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.11 $ =~ /(\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 .= "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";
		$create .= "use base ".$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). 
                    "->has_a(\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;
		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
								  )->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
									)->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;

#				if($left->foreign_key_reference->reference_table eq 'feature' and
#				   $right->foreign_key_reference->reference_table eq 'pub'){
#				  warn $left->foreign_key_reference->reference_table . " to " . $right->foreign_key_reference->reference_table . " via " . $table->name;
#				  warn "\tleft:  ".$left->name;
#				  warn "\tright: ".$right->name;
#			  }
				
			  }
			}
		  }
		  
		}


		#
		# 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)."','".
				  $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

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