lib/SQL/Translator/Producer/ClassDBI.pm

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