lib/SQL/Translator/Producer/ClassDBI.pm

   1 package SQL::Translator::Producer::ClassDBI;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: ClassDBI.pm,v 1.18 2003-06-24 03:50:43 kycl4rk 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.18 $ =~ /(\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                 my %linktable;
 116                 foreach my $table ($schema->get_tables) {
 117                   my $is_link = 1;
 118                   foreach my $field ($table->get_fields){
 119                         $is_link = 0 and last unless $field->is_primary_key or $field->is_foreign_key;
 120                   }
 121
 122                   if($is_link){
 123                         foreach my $left ($table->get_fields){
 124                           next unless $left->is_foreign_key and $schema->get_table($left->foreign_key_reference->reference_table);
 125
 126
 127                           next unless $left->is_foreign_key and
 128                                 $schema->get_table(
 129                                                                    $left->foreign_key_reference->reference_table
 130                                                                   )->get_field(
 131                                                                                            ($left->foreign_key_reference->reference_fields)[0]
 132                                                                                           )->is_primary_key;
 133
 134                           foreach my $right ($table->get_fields){
 135                                 #skip the diagonal
 136                                 next if $left->name eq $right->name;
 137
 138                                 next unless $right->is_foreign_key and $schema->get_table($right->foreign_key_reference->reference_table);
 139
 140                                 next unless $right->is_foreign_key and
 141                                   $schema->get_table(
 142                                                                          $right->foreign_key_reference->reference_table
 143                                                                         )->get_field(
 144                                                                                                  ($right->foreign_key_reference->reference_fields)[0]
 145                                                                                                 )->is_primary_key;
 146
 147
 148                                 $linkable{$left->foreign_key_reference->reference_table}{$right->foreign_key_reference->reference_table} = $table;
 149                                 $linkable{$right->foreign_key_reference->reference_table}{$left->foreign_key_reference->reference_table} = $table;
 150                                 $linktable{$table->name} = $table;
 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                                   ($schema->get_table($link)->primary_key->fields)[0]."');\n";
 174 #                                 $link."');\n";
 175                         $create .= "sub ". $translator->format_fk_name($table,$link).
 176                                   ### HARDCODED 's' HERE.  ADD CALLBACK FOR PLURALIZATION MANGLING
 177                                   "s {\n    my \$self = shift; return map \$_->".$link.
 178                                   ", \$self->".$linkmethodname.";\n}\n\n";
 179                   }
 180                 }
 181           }
 182
 183     $create .= '1;';
 184
 185     return $create;
 186 }
 187
 188
 189 sub _from {
 190     my $from = shift;
 191     my @temp = split(/::/, $from);
 192     $from    = $temp[$#temp];
 193
 194     if ( $from eq 'MySQL') {
 195         $from = lc($from);
 196     } elsif ( $from eq 'PostgreSQL') {
 197         $from = 'Pg';
 198     } elsif ( $from eq 'Oracle') {
 199         $from = 'Oracle';
 200     } else {
 201         die "__PACKAGE__ can't handle vendor $from";
 202     }
 203
 204     return $from;
 205 }
 206
 207 1;
 208
 209 __END__
 210
 211 =head1 NAME
 212
 213 SQL::Translator::Producer::ClassDBI -
 214     Translate SQL schemata into Class::DBI classes
 215
 216 =head1 SYNOPSIS
 217
 218 Use this producer as you would any other from SQL::Translator.  See
 219 L<SQL::Translator> for details.
 220
 221 This package utilizes SQL::Translator's formatting methods
 222 format_package_name(), format_pk_name(), format_fk_name(), and
 223 format_table_name() as it creates classes, one per table in the schema
 224 provided.  An additional base class is also created for database connectivity
 225 configuration.  See L<Class::DBI> for details on how this works.
 226
 227 =head1 AUTHORS
 228
 229 Allen Day E<lt>allenday@ucla.eduE<gt>
 230 Ying Zhang E<lt>zyolive@yahoo.comE<gt>,
 231 Ken Y. Clark E<lt>kclark@cpan.org<gt>.