lib/SQL/Translator/Producer/ClassDBI.pm

   1 package SQL::Translator::Producer::ClassDBI;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: ClassDBI.pm,v 1.9 2003-06-09 03:20:16 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.9 $ =~ /(\d+)\.(\d+)/;
  27 $DEBUG   = 1 unless defined $DEBUG;
  28
  29 use SQL::Translator::Schema::Constants;
  30 use SQL::Translator::Utils qw(header_comment);
  31 use Data::Dumper;
  32
  33 sub produce {
  34     my ($translator, $data) = @_;
  35     local $DEBUG            = $translator->debug;
  36     my $no_comments         = $translator->no_comments;
  37     my $schema              = $translator->schema;
  38
  39     my $create;
  40     $create .= header_comment(__PACKAGE__, "# ") unless ($no_comments);
  41
  42     $create .= "package " . $translator->format_package_name('DBI'). ";\n\n";
  43
  44     $create .= "my \$USER = '';\n";
  45     $create .= "my \$PASS = '';\n\n";
  46
  47     my $from = _from($translator->parser_type());
  48
  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";
  52
  53
  54         #
  55         # Identify link tables, defined as tables that have only PK and FK
  56         # fields
  57         #
  58         my %linkable;
  59         foreach my $table ($schema->get_tables) {
  60           my $is_link = 1;
  61           foreach my $field ($table->get_fields){
  62                 $is_link = 0 and last unless $field->is_primary_key or $field->is_foreign_key;
  63           }
  64
  65           if($is_link){
  66                 foreach my $left ($table->get_fields){
  67                   next unless $left->is_foreign_key;
  68                   foreach my $right ($table->get_fields){
  69                         next unless $right->is_foreign_key;
  70
  71                         $linkable{$left->foreign_key_reference->reference_table}
  72                           {$right->foreign_key_reference->reference_table} = $table;
  73                         $linkable{$right->foreign_key_reference->reference_table}
  74                           {$left->foreign_key_reference->reference_table} = $table;
  75                   }
  76                 }
  77           }
  78
  79         }
  80
  81     #
  82     # Iterate over all tables
  83     #
  84     for my $table ( $schema->get_tables ) {
  85         my $table_name = $table->name or next;
  86         my %pk;
  87
  88         unless ( $no_comments ) {
  89             $create .=
  90                 "#\n# Package: " .
  91                 $translator->format_package_name($table_name).
  92                 "\n#\n"
  93         }
  94
  95         $create .= "package ".$translator->format_package_name($table_name).";\n";
  96                 $create .= "use base ".$translator->format_package_name('DBI').";\n";
  97         $create .= "use mixin 'Class::DBI::Join';\n";
  98         $create .= "use Class::DBI::Pager;\n\n";
  99
 100         $create .= $translator->format_package_name($table_name)."->set_up_table('$table_name');\n\n";
 101
 102         #
 103         # Primary key?
 104         #
 105         foreach my $constraint ( $table->get_constraints ) {
 106             next unless $constraint->type eq PRIMARY_KEY;
 107             my $field = ($constraint->fields)[0];
 108
 109             $pk{ $table_name } = $field;
 110             $create .= "sub " .$translator->format_pk_name(
 111                 $translator->format_package_name( $table_name ),
 112                 $field
 113             ) . " { shift->".$field." }\n\n";
 114         }
 115
 116         #
 117         # Find foreign keys
 118         #
 119         foreach my $field ( $table->get_fields ) {
 120             if ( $field->is_foreign_key ) {
 121                 my $field_name = $field->name;
 122                 my $fk         = $field->foreign_key_reference;
 123                 my $ref_table  = $fk->reference_table;
 124                 my @ref_fields = $fk->reference_fields;
 125                 my @fields     = $fk->fields;
 126
 127               $create .= $translator->format_package_name($table_name).
 128                     "->hasa(\n    " .
 129                     $translator->format_package_name($ref_table).
 130                     " => '$field_name'\n);\n\n";
 131               $create .= "sub " .
 132                     $translator->format_fk_name($ref_table, $field_name).
 133                     " {\n    return shift->$field_name\n}\n\n";
 134             }
 135         }
 136
 137                 my $is_data = 0;
 138                 map {(!$_->is_foreign_key and !$_->is_primary_key) ? $is_data++ : 0} $table->get_fields;
 139                 if($is_data){
 140                   my %linked;
 141                   foreach my $field ( $table->get_fields ) {
 142                         if($field->is_foreign_key){
 143                           my $fk = $field->foreign_key_reference;
 144
 145 #                         next if $linked{($fk->reference_fields)[0]};
 146                           next unless $linkable{$fk->reference_table};
 147
 148                           foreach my $link (keys %{$linkable{$fk->reference_table}}){
 149                                 my $linkmethodname = "_".$translator->format_fk_name($fk->reference_table,$field->name)."_refs";
 150
 151                                 next if $linked{$linkmethodname};
 152
 153                                 $create .= $translator->format_package_name($table_name).
 154                                   "->has_many('$linkmethodname','".
 155                                   $translator->format_package_name($linkable{$fk->reference_table}{$link}->name)."','".
 156                                   ($fk->reference_fields)[0]."');\n";
 157                                 $create .= "sub ". $translator->format_fk_name($fk->reference_table,$field->name).
 158 ####HARDCODED S HERE.  ADD CALLBACK FOR PLURALIZATION MANGLING
 159                                   "s {\n    my \$self = shift; return map \$_->".($fk->reference_fields)[0].", \$self->".$linkmethodname.";\n}\n\n";
 160
 161                                 $linked{$linkmethodname}++;
 162                           }
 163                         }
 164                   }
 165                 }
 166
 167     }
 168
 169     $create .= '1;';
 170
 171 #    for my $table (keys %{$data}) {
 172 #        my $table_data = $data->{$table};
 173 #        my @fields =  keys %{$table_data->{'fields'}};
 174 #        my %pk;
 175 #
 176 #        $create .= "##\n## Package: " .$translator->format_package_name($table). "\n##\n" unless $no_comments;
 177 #        $create .= "package ". $translator->format_package_name($table). ";\n";
 178 #
 179 #        $create .= "use base \'Chado::DBI\';\n";
 180 #        $create .= "use mixin \'Class::DBI::Join\';\n";
 181 #        $create .= "use Class::DBI::Pager;\n\n";
 182 #
 183 #        $create .= $translator->format_package_name($table). "->set_up_table('$table');\n\n";
 184 #
 185 #        #
 186 #        # Primary key?
 187 #        #
 188 #        foreach my $constraint ( @{ $table_data->{'constraints'} } ) {
 189 #          my $name       = $constraint->{'name'} || '';
 190 #          my $type       = $constraint->{'type'};
 191 #          my $ref_table  = $constraint->{'reference_table'};
 192 #          my $ref_fields = $constraint->{'reference_fields'};
 193 #
 194 #          if ( $type eq 'primary_key') {
 195 #            $pk{$table} = $constraint->{'fields'}->[0];
 196 #            $create .= "sub " .$translator->format_pk_name(
 197 #                                                           $translator->format_package_name($table),
 198 #                                                           $constraint->{'fields'}->[0]
 199 #                                                          ) . " { shift->".$constraint->{'fields'}->[0]." }\n\n";
 200 #          }
 201 #        }
 202 #
 203 #        #
 204 #        # Foreign key?
 205 #        #
 206 #        foreach my $field (@fields){
 207 #          my $field_data = $table_data->{'fields'}->{$field}->{'constraints'};
 208 #          my $type = $field_data->[1]->{'type'} || '';
 209 #          my $ref_table = $field_data->[1]->{'reference_table'};
 210 #          my $ref_field = $field_data->[1]->{'reference_fields'}->[0];
 211 #          my $field = $field_data->[1]->{'fields'}->[0];
 212 #
 213 #          if ($type eq 'foreign_key') {
 214 #
 215 #    #THIS IS IMPOSSIBLE UNTIL WE HAVE A BETTER DATA MODEL.  THIS GIANT HASH SUCKS !!!
 216 #    #         my $r_link     = 0; #not a link table (yet)
 217 #    #         my $r_linkthis = 0;
 218 #    #         my $r_linkthat = 0;
 219 #    #         my $r_linkdata = 0;
 220 #    #         my $r_table = $data->{$ref_table};
 221 #    #         my @r_fields = keys %{$r_table->{'fields'}};
 222 #    #         foreach my $r_field ( keys %{$r_table->{'fields'}} ){
 223 #    #           $r_linkthis++ and next if $r_field eq $ref_field; #remote table links to local table
 224 #    #           if($r_table->{'fields'}->{$r_field}->{'constraints'}){
 225 #
 226 #    #             foreach my $r_constraint ($r_table->{'fields'}->{$r_field}->{'constraints'}){
 227 #    #               $create .= Dumper($r_constraint);
 228 #    #             }
 229 #
 230 #    #           } else {
 231 #    #             $r_linkdata++; #if not constraints, assume it's data (safe?)
 232 #    #           }
 233 #    #           foreach my $r_constraint ( @{ $r_table->{'fields'}->{$r_field}->{'constraints'} } ) {
 234 #    #             next unless $r_constraint->{'constraint_type'} eq 'foreign_key';
 235 #
 236 #    #             $r_linkthat++ unless $r_constraint->{'reference_table'} eq $table; #remote table links to non-local table
 237 #    #           }
 238 #    #         }
 239 #
 240 #    #        my $link = $r_linkthis && $r_linkthat && !$r_linkdata ? '_link' : '';
 241 #            $create .= $translator->format_package_name($table). "->hasa(" .$translator->format_package_name($ref_table). " => \'$field\');\n";
 242 #            $create .= "sub " .$translator->format_fk_name($ref_table, $field)." { return shift->$field }\n\n";
 243 #          }
 244 #        }
 245 #
 246 #    #THIS IS IMPOSSIBLE UNTIL WE HAVE A BETTER DATA MODEL.  THIS GIANT HASH SUCKS !!!
 247 #    #     #
 248 #    #     # Remote foreign key?
 249 #    #     #
 250 #    #     print "****$table\n";
 251 #    #     # find tables that refer to this table
 252 #    #     my %refers = ();
 253 #    #     for my $remote_table (keys %{$data}){
 254 #    #       next if $remote_table eq $table;
 255 #    # #      print "********".$remote_table."\n";
 256 #    #       my $remote_table_data = $data->{$remote_table};
 257 #
 258 #    #       foreach my $remote_field ( keys %{$remote_table_data->{'fields'}} ){
 259 #    #         foreach my $remote_constraint ( @{ $remote_table_data->{'fields'}->{$remote_field}->{'constraints'} } ) {
 260 #    #           next unless $remote_constraint->{'constraint_type'} eq 'foreign_key'; #only interested in foreign keys...
 261 #
 262 #    #           $refers{$remote_table} = 1 if $pk{$remote_constraint->{'reference_table'}} ;#eq $remote_constraint->{'reference_fields'}->[0];
 263 #    #            }
 264 #    #       }
 265 #    #     }
 266 #
 267 #    #     foreach my $refer (keys %refers){
 268 #    #       foreach my $refer_field ( keys %{$data->{$refer}->{'fields'}} ){
 269 #    #         foreach my $refer_constraint ( @{ $data->{$refer}->{'fields'}->{$refer_field}->{'constraints'} } ) {
 270 #    #           next unless $refer_constraint->{'constraint_type'} eq 'foreign_key'; #only interested in foreign keys...
 271 #    #           next if $refer_constraint->{'reference_table'} eq $table; #don't want to consider the current table vs itself
 272 #    #           print "********".$refer."\t".$refer_field."\t****\t".$refer_constraint->{'reference_table'}."\t".$refer_constraint->{'reference_fields'}->[0]."\n";
 273 #
 274 #    #           $create .= "****sub " .$translator->format_fk_name($refer_constraint->{'reference_table'}, $refer_constraint->{'reference_fields'}->[0]). " { return shift->".$refer_constraint->{'reference_fields'}->[0]." }\n\n";
 275 #    #         }
 276 #    #       }
 277 #    #     }
 278 #
 279 #        $create .= "1;\n\n\n";
 280 #    }
 281
 282     return $create;
 283 }
 284
 285
 286 sub _from {
 287     my $from = shift;
 288     my @temp = split(/::/, $from);
 289     $from    = $temp[$#temp];
 290
 291     if ( $from eq 'MySQL') {
 292         $from = lc($from);
 293     } elsif ( $from eq 'PostgreSQL') {
 294         $from = 'Pg';
 295     } elsif ( $from eq 'Oracle') {
 296         $from = 'Oracle';
 297     } else {
 298         die "__PACKAGE__ can't handle vendor $from";
 299     }
 300
 301     return $from;
 302 }
 303
 304 1;
 305
 306 __END__
 307
 308 =head1 NAME
 309
 310 SQL::Translator::Producer::ClassDBI -
 311     Translate SQL schemata into Class::DBI classes
 312
 313 =head1 SYNOPSIS
 314
 315 Use this producer as you would any other from SQL::Translator.  See
 316 L<SQL::Translator> for details.
 317
 318 This package utilizes SQL::Translator's formatting methods
 319 format_package_name(), format_pk_name(), format_fk_name(), and
 320 format_table_name() as it creates classes, one per table in the schema
 321 provided.  An additional base class is also created for database connectivity
 322 configuration.  See L<Class::DBI> for details on how this works.
 323
 324 =head1 AUTHORS
 325
 326 Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
 327 Allen Day E<lt>allenday@ucla.eduE<gt>
 328 Ken Y. Clark E<lt>kclark@cpan.org<gt>.