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

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

# -------------------------------------------------------------------
# $Id: ClassDBI.pm,v 1.7 2003-05-11 04:04:17 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.7 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 1 unless defined $DEBUG;

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

sub produce {
  my ($translator, $data) = @_;
  $DEBUG                  = $translator->debug;
  my $no_comments         = $translator->no_comments;

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

  $create .= $translator->format_package_name('DBI'). "->set_db(\'Main', \'dbi:" .$from. ":_\', \$USER,\$PASS,);\n\n";
  $create .= "1;\n\n\n";

  #
  # Iterate over all tables
  #
  for my $table (keys %{$data}) {
	my $table_data = $data->{$table};
	my @fields =  keys %{$table_data->{'fields'}};
	my %pk;

	$create .= "##\n## Package: " .$translator->format_package_name($table). "\n##\n" unless $no_comments;
	$create .= "package ". $translator->format_package_name($table). ";\n";

	$create .= "use base \'Chado::DBI\';\n";
	$create .= "use mixin \'Class::DBI::Join\';\n";
	$create .= "use Class::DBI::Pager;\n\n";

	$create .= $translator->format_package_name($table). "->set_up_table('$table');\n\n";

	#
	# Primary key?
	#
	foreach my $constraint ( @{ $table_data->{'constraints'} } ) {
	  my $name       = $constraint->{'name'} || '';
	  my $type       = $constraint->{'type'};
	  my $ref_table  = $constraint->{'reference_table'};
	  my $ref_fields = $constraint->{'reference_fields'};

	  if ( $type eq 'primary_key') {
		$pk{$table} = $constraint->{'fields'}->[0];
		$create .= "sub " .$translator->format_pk_name(
													   $translator->format_package_name($table),
													   $constraint->{'fields'}->[0]
													  ) . " { shift->".$constraint->{'fields'}->[0]." }\n\n";
	  }
	}

	#
	# Foreign key?
	#
	foreach my $field (@fields){
	  my $field_data = $table_data->{'fields'}->{$field}->{'constraints'};
	  my $type = $field_data->[1]->{'type'} || '';
	  my $ref_table = $field_data->[1]->{'reference_table'};
	  my $ref_field = $field_data->[1]->{'reference_fields'}->[0];
	  my $field = $field_data->[1]->{'fields'}->[0];

	  if ($type eq 'foreign_key') {

#THIS IS IMPOSSIBLE UNTIL WE HAVE A BETTER DATA MODEL.  THIS GIANT HASH SUCKS !!!
# 		my $r_link     = 0; #not a link table (yet)
# 		my $r_linkthis = 0;
# 		my $r_linkthat = 0;
# 		my $r_linkdata = 0;
# 		my $r_table = $data->{$ref_table};
# 		my @r_fields = keys %{$r_table->{'fields'}};
# 		foreach my $r_field ( keys %{$r_table->{'fields'}} ){
# 		  $r_linkthis++ and next if $r_field eq $ref_field; #remote table links to local table
# 		  if($r_table->{'fields'}->{$r_field}->{'constraints'}){

# 			foreach my $r_constraint ($r_table->{'fields'}->{$r_field}->{'constraints'}){
# 			  $create .= Dumper($r_constraint);
# 			}

# 		  } else {
# 			$r_linkdata++; #if not constraints, assume it's data (safe?)
# 		  }
# 		  foreach my $r_constraint ( @{ $r_table->{'fields'}->{$r_field}->{'constraints'} } ) {
# 			next unless $r_constraint->{'constraint_type'} eq 'foreign_key';

# 			$r_linkthat++ unless $r_constraint->{'reference_table'} eq $table; #remote table links to non-local table
# 		  }
# 		}

#		my $link = $r_linkthis && $r_linkthat && !$r_linkdata ? '_link' : '';
		$create .= $translator->format_package_name($table). "->hasa(" .$translator->format_package_name($ref_table). " => \'$field\');\n";
		$create .= "sub " .$translator->format_fk_name($ref_table, $field)." { return shift->$field }\n\n";
	  }
	}
	
#THIS IS IMPOSSIBLE UNTIL WE HAVE A BETTER DATA MODEL.  THIS GIANT HASH SUCKS !!!
# 	#
# 	# Remote foreign key?
# 	#
# 	print "****$table\n";
# 	# find tables that refer to this table
# 	my %refers = ();
# 	for my $remote_table (keys %{$data}){
# 	  next if $remote_table eq $table;
# #	  print "********".$remote_table."\n";
# 	  my $remote_table_data = $data->{$remote_table};

# 	  foreach my $remote_field ( keys %{$remote_table_data->{'fields'}} ){
# 		foreach my $remote_constraint ( @{ $remote_table_data->{'fields'}->{$remote_field}->{'constraints'} } ) {
# 		  next unless $remote_constraint->{'constraint_type'} eq 'foreign_key'; #only interested in foreign keys...

# 		  $refers{$remote_table} = 1 if $pk{$remote_constraint->{'reference_table'}} ;#eq $remote_constraint->{'reference_fields'}->[0];
#    		}
# 	  }
# 	}

# 	foreach my $refer (keys %refers){
# 	  foreach my $refer_field ( keys %{$data->{$refer}->{'fields'}} ){
# 		foreach my $refer_constraint ( @{ $data->{$refer}->{'fields'}->{$refer_field}->{'constraints'} } ) {
# 		  next unless $refer_constraint->{'constraint_type'} eq 'foreign_key'; #only interested in foreign keys...
# 		  next if $refer_constraint->{'reference_table'} eq $table; #don't want to consider the current table vs itself
# 		  print "********".$refer."\t".$refer_field."\t****\t".$refer_constraint->{'reference_table'}."\t".$refer_constraint->{'reference_fields'}->[0]."\n";

# 		  $create .= "****sub " .$translator->format_fk_name($refer_constraint->{'reference_table'}, $refer_constraint->{'reference_fields'}->[0]). " { return shift->".$refer_constraint->{'reference_fields'}->[0]." }\n\n";
# 		}
# 	  }
# 	}

	$create .= "1;\n\n\n";
  }
 
  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 AUTHOR

Ying Zhang <zyolive@yahoo.com>, Allen Day <allenday@ucla.edu>
Commit	Line	Data
f42e7027	1	package SQL::Translator::Producer::ClassDBI;
	2
	3	# -------------------------------------------------------------------
6ba91faa	4	# $Id: ClassDBI.pm,v 1.7 2003-05-11 04:04:17 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 ];
6ba91faa	26	$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
f42e7027	27	$DEBUG = 1 unless defined $DEBUG;
f42e7027	28
5ee19df8	29	use SQL::Translator::Utils qw(header_comment);
f42e7027	30	use Data::Dumper;
	31
	32	sub produce {
	33	my ($translator, $data) = @_;
	34	$DEBUG = $translator->debug;
	35	my $no_comments = $translator->no_comments;
	36
	37	my $create;
5ee19df8	38	$create .= header_comment(__PACKAGE__, "## ") unless ($no_comments);
f42e7027	39
	40	$create .= "package " . $translator->format_package_name('DBI'). ";\n\n";
	41
	42	$create .= "my \$USER = \'\';\n";
	43	$create .= "my \$PASS = \'\';\n\n";
	44
	45	my $from = _from($translator->parser_type());
	46
	47	$create .= "use base \'Class::DBI::" .$from. "\';\n\n";
	48
	49	$create .= $translator->format_package_name('DBI'). "->set_db(\'Main', \'dbi:" .$from. ":_\', \$USER,\$PASS,);\n\n";
	50	$create .= "1;\n\n\n";
	51
6ba91faa	52	#
	53	# Iterate over all tables
	54	#
f42e7027	55	for my $table (keys %{$data}) {
	56	my $table_data = $data->{$table};
	57	my @fields = keys %{$table_data->{'fields'}};
6ba91faa	58	my %pk;
f42e7027	59
d2cc87fc	60	$create .= "##\n## Package: " .$translator->format_package_name($table). "\n##\n" unless $no_comments;
f42e7027	61	$create .= "package ". $translator->format_package_name($table). ";\n";
	62
	63	$create .= "use base \'Chado::DBI\';\n";
	64	$create .= "use mixin \'Class::DBI::Join\';\n";
	65	$create .= "use Class::DBI::Pager;\n\n";
	66
d2cc87fc	67	$create .= $translator->format_package_name($table). "->set_up_table('$table');\n\n";
f42e7027	68
f42e7027	69	#
	70	# Primary key?
	71	#
6ba91faa	72	foreach my $constraint ( @{ $table_data->{'constraints'} } ) {
6ba91faa	73	my $name = $constraint->{'name'} \|\| '';
f42e7027	74	my $type = $constraint->{'type'};
f42e7027	75	my $ref_table = $constraint->{'reference_table'};
	76	my $ref_fields = $constraint->{'reference_fields'};
	77
	78	if ( $type eq 'primary_key') {
6ba91faa	79	$pk{$table} = $constraint->{'fields'}->[0];
	80	$create .= "sub " .$translator->format_pk_name(
	81	$translator->format_package_name($table),
	82	$constraint->{'fields'}->[0]
	83	) . " { shift->".$constraint->{'fields'}->[0]." }\n\n";
f42e7027	84	}
f42e7027	85	}
	86
	87	#
	88	# Foreign key?
	89	#
6ba91faa	90	foreach my $field (@fields){
f42e7027	91	my $field_data = $table_data->{'fields'}->{$field}->{'constraints'};
1eee27d3	92	my $type = $field_data->[1]->{'type'} \|\| '';
f42e7027	93	my $ref_table = $field_data->[1]->{'reference_table'};
6ba91faa	94	my $ref_field = $field_data->[1]->{'reference_fields'}->[0];
6ba91faa	95	my $field = $field_data->[1]->{'fields'}->[0];
38c87513	96
f42e7027	97	if ($type eq 'foreign_key') {
6ba91faa	98
	99	#THIS IS IMPOSSIBLE UNTIL WE HAVE A BETTER DATA MODEL. THIS GIANT HASH SUCKS !!!
	100	# my $r_link = 0; #not a link table (yet)
	101	# my $r_linkthis = 0;
	102	# my $r_linkthat = 0;
	103	# my $r_linkdata = 0;
	104	# my $r_table = $data->{$ref_table};
	105	# my @r_fields = keys %{$r_table->{'fields'}};
	106	# foreach my $r_field ( keys %{$r_table->{'fields'}} ){
	107	# $r_linkthis++ and next if $r_field eq $ref_field; #remote table links to local table
	108	# if($r_table->{'fields'}->{$r_field}->{'constraints'}){
	109
	110	# foreach my $r_constraint ($r_table->{'fields'}->{$r_field}->{'constraints'}){
	111	# $create .= Dumper($r_constraint);
	112	# }
	113
	114	# } else {
	115	# $r_linkdata++; #if not constraints, assume it's data (safe?)
	116	# }
	117	# foreach my $r_constraint ( @{ $r_table->{'fields'}->{$r_field}->{'constraints'} } ) {
	118	# next unless $r_constraint->{'constraint_type'} eq 'foreign_key';
	119
	120	# $r_linkthat++ unless $r_constraint->{'reference_table'} eq $table; #remote table links to non-local table
	121	# }
	122	# }
	123
	124	# my $link = $r_linkthis && $r_linkthat && !$r_linkdata ? '_link' : '';
	125	$create .= $translator->format_package_name($table). "->hasa(" .$translator->format_package_name($ref_table). " => \'$field\');\n";
	126	$create .= "sub " .$translator->format_fk_name($ref_table, $field)." { return shift->$field }\n\n";
f42e7027	127	}
	128	}
	129
6ba91faa	130	#THIS IS IMPOSSIBLE UNTIL WE HAVE A BETTER DATA MODEL. THIS GIANT HASH SUCKS !!!
	131	# #
	132	# # Remote foreign key?
	133	# #
	134	# print "****$table\n";
	135	# # find tables that refer to this table
	136	# my %refers = ();
	137	# for my $remote_table (keys %{$data}){
	138	# next if $remote_table eq $table;
	139	# # print "********".$remote_table."\n";
	140	# my $remote_table_data = $data->{$remote_table};
	141
	142	# foreach my $remote_field ( keys %{$remote_table_data->{'fields'}} ){
	143	# foreach my $remote_constraint ( @{ $remote_table_data->{'fields'}->{$remote_field}->{'constraints'} } ) {
	144	# next unless $remote_constraint->{'constraint_type'} eq 'foreign_key'; #only interested in foreign keys...
	145
	146	# $refers{$remote_table} = 1 if $pk{$remote_constraint->{'reference_table'}} ;#eq $remote_constraint->{'reference_fields'}->[0];
	147	# }
	148	# }
	149	# }
	150
	151	# foreach my $refer (keys %refers){
	152	# foreach my $refer_field ( keys %{$data->{$refer}->{'fields'}} ){
	153	# foreach my $refer_constraint ( @{ $data->{$refer}->{'fields'}->{$refer_field}->{'constraints'} } ) {
	154	# next unless $refer_constraint->{'constraint_type'} eq 'foreign_key'; #only interested in foreign keys...
	155	# next if $refer_constraint->{'reference_table'} eq $table; #don't want to consider the current table vs itself
	156	# print "******".$refer."\t".$refer_field."\t**\t".$refer_constraint->{'reference_table'}."\t".$refer_constraint->{'reference_fields'}->[0]."\n";
	157
	158	# $create .= "****sub " .$translator->format_fk_name($refer_constraint->{'reference_table'}, $refer_constraint->{'reference_fields'}->[0]). " { return shift->".$refer_constraint->{'reference_fields'}->[0]." }\n\n";
	159	# }
	160	# }
	161	# }
	162
f42e7027	163	$create .= "1;\n\n\n";
f42e7027	164	}
77a87d30	165
77a87d30	166	return $create;
f42e7027	167	}
	168
	169
	170	sub _from {
	171	my $from = shift;
	172	my @temp = split(/::/, $from);
	173	$from = $temp[$#temp];
	174
	175	if ( $from eq 'MySQL') {
	176	$from = lc($from);
	177	} elsif ( $from eq 'PostgreSQL') {
	178	$from = 'Pg';
	179	} elsif ( $from eq 'Oracle') {
77a87d30	180	$from = 'Oracle';
f42e7027	181	} else {
77a87d30	182	die "__PACKAGE__ can't handle vendor $from";
f42e7027	183	}
	184
	185	return $from;
	186	}
	187
	188	1;
	189
	190	__END__
	191
	192	=head1 NAME
	193
1eee27d3	194	SQL::Translator::Producer::ClassDBI - Translate SQL schemata into Class::DBI classes
f42e7027	195
	196	=head1 SYNOPSIS
	197
1eee27d3	198	Use this producer as you would any other from SQL::Translator. See
1eee27d3	199	L<SQL::Translator> for details.
f42e7027	200
1eee27d3	201	This package utilizes SQL::Translator's formatting methods
	202	format_package_name(), format_pk_name(), format_fk_name(), and
	203	format_table_name() as it creates classes, one per table in the schema
	204	provided. An additional base class is also created for database connectivity
	205	configuration. See L<Class::DBI> for details on how this works.
f42e7027	206
	207	=head1 AUTHOR
	208
1eee27d3	209	Ying Zhang <zyolive@yahoo.com>, Allen Day <allenday@ucla.edu>