lib/SQL/Translator/Producer/ClassDBI.pm

   1 package SQL::Translator::Producer::ClassDBI;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: ClassDBI.pm,v 1.7 2003-05-11 04:04:17 allenday Exp $
   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 ];
  26 $VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/;
  27 $DEBUG   = 1 unless defined $DEBUG;
  28
  29 use SQL::Translator::Utils qw(header_comment);
  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;
  38   $create .= header_comment(__PACKAGE__, "## ") unless ($no_comments);
  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
  52   #
  53   # Iterate over all tables
  54   #
  55   for my $table (keys %{$data}) {
  56         my $table_data = $data->{$table};
  57         my @fields =  keys %{$table_data->{'fields'}};
  58         my %pk;
  59
  60         $create .= "##\n## Package: " .$translator->format_package_name($table). "\n##\n" unless $no_comments;
  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
  67         $create .= $translator->format_package_name($table). "->set_up_table('$table');\n\n";
  68
  69         #
  70         # Primary key?
  71         #
  72         foreach my $constraint ( @{ $table_data->{'constraints'} } ) {
  73           my $name       = $constraint->{'name'} || '';
  74           my $type       = $constraint->{'type'};
  75           my $ref_table  = $constraint->{'reference_table'};
  76           my $ref_fields = $constraint->{'reference_fields'};
  77
  78           if ( $type eq 'primary_key') {
  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";
  84           }
  85         }
  86
  87         #
  88         # Foreign key?
  89         #
  90         foreach my $field (@fields){
  91           my $field_data = $table_data->{'fields'}->{$field}->{'constraints'};
  92           my $type = $field_data->[1]->{'type'} || '';
  93           my $ref_table = $field_data->[1]->{'reference_table'};
  94           my $ref_field = $field_data->[1]->{'reference_fields'}->[0];
  95           my $field = $field_data->[1]->{'fields'}->[0];
  96
  97           if ($type eq 'foreign_key') {
  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";
 127           }
 128         }
 129
 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
 163         $create .= "1;\n\n\n";
 164   }
 165
 166   return $create;
 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') {
 180         $from = 'Oracle';
 181   } else {
 182         die "__PACKAGE__ can't handle vendor $from";
 183   }
 184
 185   return $from;
 186 }
 187
 188 1;
 189
 190 __END__
 191
 192 =head1 NAME
 193
 194 SQL::Translator::Producer::ClassDBI - Translate SQL schemata into Class::DBI classes
 195
 196 =head1 SYNOPSIS
 197
 198 Use this producer as you would any other from SQL::Translator.  See
 199 L<SQL::Translator> for details.
 200
 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.
 206
 207 =head1 AUTHOR
 208
 209 Ying Zhang <zyolive@yahoo.com>, Allen Day <allenday@ucla.edu>