lib/SQL/Translator/Producer/ClassDBI.pm

   1 package SQL::Translator::Producer::ClassDBI;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: ClassDBI.pm,v 1.12 2003-06-09 05:46:45 allenday Exp $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2003 Allen Day <allenday@ucla.edu>,
   7 #                    Ying Zhang <zyolive@yahoo.com>
   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.12 $ =~ /(\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     # 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 ) {
  61             $create .=
  62                 "#\n# Package: " .
  63                 $translator->format_package_name($table_name).
  64                 "\n#\n"
  65         }
  66
  67         $create .= "package ".$translator->format_package_name($table_name).";\n";
  68                 $create .= "use base ".$translator->format_package_name('DBI').";\n";
  69         $create .= "use mixin 'Class::DBI::Join';\n";
  70         $create .= "use Class::DBI::Pager;\n\n";
  71
  72         $create .= $translator->format_package_name($table_name)."->set_up_table('$table_name');\n\n";
  73
  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];
  80
  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         }
  87
  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).
 100                     "->has_a(\n    " .
 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";
 106
 107             }
 108         }
 109
 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                 #
 162                 my $is_data = 0;
 163                 map {(!$_->is_foreign_key and !$_->is_primary_key) ? $is_data++ : 0} $table->get_fields;
 164                 my %linked;
 165                 if($is_data){
 166                   foreach my $link (keys %{$linkable{$table->name}}){
 167                         my $linkmethodname = "_".$translator->format_fk_name($table->name,$link)."_refs";
 168
 169
 170                         $create .= $translator->format_package_name($table->name).
 171                                   "->has_many('$linkmethodname','".
 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";
 178                   }
 179                 }
 180           }
 181
 182     $create .= '1;';
 183
 184     return $create;
 185 }
 186
 187
 188 sub _from {
 189     my $from = shift;
 190     my @temp = split(/::/, $from);
 191     $from    = $temp[$#temp];
 192
 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     }
 202
 203     return $from;
 204 }
 205
 206 1;
 207
 208 __END__
 209
 210 =head1 NAME
 211
 212 SQL::Translator::Producer::ClassDBI -
 213     Translate SQL schemata into Class::DBI classes
 214
 215 =head1 SYNOPSIS
 216
 217 Use this producer as you would any other from SQL::Translator.  See
 218 L<SQL::Translator> for details.
 219
 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.
 225
 226 =head1 AUTHORS
 227
 228 Allen Day E<lt>allenday@ucla.eduE<gt>
 229 Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
 230 Ken Y. Clark E<lt>kclark@cpan.org<gt>.