lib/SQL/Translator/Producer/ClassDBI.pm

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