lib/SQL/Translator/Parser/DBI/SQLServer.pm

   1 package SQL::Translator::Parser::DBI::SQLServer;
   2
   3 # -------------------------------------------------------------------
   4 # $Id$
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   7 #
   8 # This program is free software; you can redistribute it and/or
   9 # modify it under the terms of the GNU General Public License as
  10 # published by the Free Software Foundation; version 2.
  11 #
  12 # This program is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 # General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program; if not, write to the Free Software
  19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  20 # 02111-1307  USA
  21 # -------------------------------------------------------------------
  22
  23 =head1 NAME
  24
  25 SQL::Translator::Parser::DBI::SQLServer - parser for SQL Server through DBD::ODBC
  26
  27 =head1 SYNOPSIS
  28
  29 See SQL::Translator::Parser::DBI.
  30
  31 =head1 DESCRIPTION
  32
  33 Uses DBI Catalog Methods.
  34
  35 =cut
  36
  37 use strict;
  38 use DBI;
  39 use SQL::Translator::Schema;
  40 use Data::Dumper;
  41
  42 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  43 $VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
  44 $DEBUG   = 0 unless defined $DEBUG;
  45
  46 no strict 'refs';
  47
  48 # -------------------------------------------------------------------
  49 sub parse {
  50     my ( $tr, $dbh ) = @_;
  51
  52     if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
  53         warn "setting dbh attribute {FetchHashKeyName} to NAME_uc";
  54         $dbh->{FetchHashKeyName} = 'NAME_uc';
  55     }
  56
  57     if ($dbh->{ChopBlanks} != 1) {
  58         warn "setting dbh attribute {ChopBlanks} to 1";
  59         $dbh->{ChopBlanks} = 1;
  60     }
  61
  62     my $schema = $tr->schema;
  63
  64     my ($sth, @tables, $columns);
  65     my $stuff;
  66
  67     ### Columns
  68
  69     # it is much quicker to slurp back everything all at once rather
  70     # than make repeated calls
  71
  72     $sth = $dbh->column_info(undef, undef, undef, undef);
  73
  74
  75     foreach my $c (@{$sth->fetchall_arrayref({})}) {
  76         $columns
  77             ->{$c->{TABLE_CAT}}
  78                 ->{$c->{TABLE_SCHEM}}
  79                     ->{$c->{TABLE_NAME}}
  80                         ->{columns}
  81                             ->{$c->{COLUMN_NAME}}= $c;
  82     }
  83
  84     ### Tables and views
  85
  86     # Get a list of the tables and views.
  87     $sth = $dbh->table_info();
  88     @tables   = @{$sth->fetchall_arrayref({})};
  89
  90     my $h = $dbh->selectall_arrayref(q{
  91 SELECT o.name, colid,c.text
  92   FROM syscomments c
  93   JOIN sysobjects o
  94     ON c.id = o.id
  95  WHERE o.type ='V'
  96 ORDER BY o.name,
  97          c.colid
  98 }
  99 );
 100
 101     # View text
 102     # I had always thought there was something 'hard' about
 103     # reconstructing text from syscomments ..
 104     # this seems to work fine and is certainly not complicated!
 105
 106     foreach (@{$h}) {
 107         $stuff->{view}->{$_->[0]}->{text} .= $_->[2];
 108     }
 109
 110     #### objects with indexes.
 111     map {
 112         $stuff->{indexes}->{$_->[0]}++
 113             if defined;
 114     } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id)
 115                                     FROM sysindexes
 116                                    WHERE indid > 0 and indid < 255 and
 117                                          name not like '_WA_Sys%'")};
 118
 119     ## slurp objects
 120     map {
 121         $stuff->{$_->[1]}->{$_->[0]} = $_;
 122     } @{$dbh->selectall_arrayref("SELECT name,type, id FROM sysobjects")};
 123
 124
 125     ### Procedures
 126
 127     # This gets legitimate procedures by used the 'supported' API: sp_stored_procedures
 128     map {
 129         my $n = $_->{PROCEDURE_NAME};
 130         $n =~ s/;\d+$//;        # Ignore versions for now
 131         $_->{name} = $n;
 132         $stuff->{procedures}->{$n} = $_;
 133     } values %{$dbh->selectall_hashref("sp_stored_procedures", 'PROCEDURE_NAME')};
 134
 135
 136     # And this blasts in the text of 'legit' stored procedures.  Do
 137     # this rather than calling sp_helptext in a loop.
 138
 139     $h = $dbh->selectall_arrayref(q{
 140 SELECT o.name, colid,c.text
 141   FROM syscomments c
 142   JOIN sysobjects o
 143     ON c.id = o.id
 144  WHERE o.type in ('P', 'FN', 'TF', 'IF')
 145 }
 146 );
 147
 148     foreach (@{$h}) {
 149         $stuff->{procedures}->{$_->[0]}->{text} .= $_->[2]
 150             if (defined($stuff->{procedures}->{$_->[0]}));
 151     }
 152
 153     ### Defaults
 154     ### Rules
 155     ### Bind Defaults
 156     ### Bind Rules
 157
 158     ### Triggers
 159     # Since the 'target' of the trigger is defined in the text, we will
 160     # just create them independently for now rather than associating them
 161     # with a table.
 162
 163     $h = $dbh->selectall_arrayref(q{
 164 SELECT o.name, colid,c.text
 165   FROM syscomments c
 166   JOIN sysobjects o
 167     ON c.id = o.id
 168   JOIN sysobjects o1
 169     ON (o.id = o1.instrig OR o.id = o1.deltrig or o.id = o1.updtrig)
 170  WHERE o.type ='TR'
 171 ORDER BY o.name,
 172          c.colid
 173 }
 174 );
 175     foreach (@{$h}) {
 176         $stuff->{triggers}->{$_->[0]}->{text} .= $_->[2];
 177     }
 178
 179     ### References
 180     ### Keys
 181
 182     ### Types
 183     # Not sure what to do with these?
 184     $stuff->{type_info_all} = $dbh->type_info_all;
 185
 186     ### Tables
 187     # According to the DBI docs, these can be
 188
 189     # "TABLE"
 190     # "VIEW"
 191     # "SYSTEM TABLE"
 192     # "GLOBAL TEMPORARY",
 193     # "LOCAL TEMPORARY"
 194     # "ALIAS"
 195     # "SYNONYM"
 196
 197     foreach my $table_info (@tables) {
 198         next
 199             unless (defined($table_info->{TABLE_TYPE}));
 200
 201         if ($table_info->{TABLE_TYPE} eq "TABLE") {
 202             my $table = $schema->add_table(
 203                                            name =>
 204 $table_info->{TABLE_NAME},
 205                                            type =>
 206 $table_info->{TABLE_TYPE},
 207                                           ) || die $schema->error;
 208
 209             # find the associated columns
 210
 211             my $cols =
 212                 $columns->{$table_info->{TABLE_CAT}}
 213                     ->{$table_info->{TABLE_SCHEM}}
 214                         ->{$table_info->{TABLE_NAME}}
 215                             ->{columns};
 216
 217             foreach my $c (values %{$cols}) {
 218                                 my $is_auto_increment = $c->{TYPE_NAME} =~ s#(\(\))? identity##i;
 219                 my $f = $table->add_field(
 220                                           name        => $c->{COLUMN_NAME},
 221                                           data_type   => $c->{TYPE_NAME},
 222                                           order       => $c->{ORDINAL_POSITION},
 223                                           size        => $c->{COLUMN_SIZE},
 224                                          ) || die $table->error;
 225                 $f->is_nullable($c->{NULLABLE} == 1);
 226                 $f->is_auto_increment($is_auto_increment);
 227                 if ( defined $c->{COLUMN_DEF}) {
 228                         $c->{COLUMN_DEF} =~ s#\('?(.*?)'?\)#$1#;
 229                         $f->default_value($c->{COLUMN_DEF});
 230                 }
 231             }
 232
 233             # add in primary key
 234             my $h = $dbh->selectall_hashref("sp_pkeys
 235 $table_info->{TABLE_NAME}", 'COLUMN_NAME');
 236             if (scalar keys %{$h} >= 1) {
 237                 my @c = map {
 238                     $_->{COLUMN_NAME}
 239                 } sort {
 240                     $a->{KEY_SEQ} <=> $b->{KEY_SEQ}
 241                 } values %{$h};
 242
 243                 $table->primary_key(@c)
 244                     if (scalar @c);
 245             }
 246
 247             # add in foreign keys
 248             $h = $dbh->selectall_hashref("sp_fkeys NULL,
 249 \@fktable_name = '$table_info->{TABLE_NAME}'", 'FK_NAME');
 250                         foreach my $fk ( values %{$h} ) {
 251                                 my $constraint = $table->add_constraint( name => $fk->{FK_NAME},
 252                                         fields => [$fk->{FKCOLUMN_NAME}],
 253                                 );
 254                                 $constraint->type("FOREIGN_KEY");
 255                                 $constraint->on_delete(
 256                                         $fk->{DELETE_RULE} == 0 ? "CASCADE" :
 257                                         $fk->{DELETE_RULE} == 1 ? "NO ACTION" : "SET_NULL"
 258                                 );
 259                                 $constraint->on_update(
 260                                         $fk->{UPDATE_RULE} == 0 ? "CASCADE" :
 261                                         $fk->{UPDATE_RULE} == 1 ? "NO ACTION" : "SET_NULL"
 262                                 );
 263                                 $constraint->reference_table($fk->{PKTABLE_NAME});
 264                         }
 265
 266             # add in any indexes ... how do we tell if the index has
 267             # already been created as part of a primary key or other
 268             # constraint?
 269
 270             if (defined($stuff->{indexes}->{$table_info->{TABLE_NAME}})){
 271                 my $h = $dbh->selectall_hashref("sp_helpindex
 272 $table_info->{TABLE_NAME}", 'INDEX_NAME');
 273                 foreach (values %{$h}) {
 274                     my $fields = $_->{'INDEX_KEYS'};
 275                     $fields =~ s/\s*//g;
 276                     my $i = $table->add_index(
 277                                               name   =>
 278 $_->{INDEX_NAME},
 279                                               fields => $fields,
 280                                              );
 281                     if ($_->{'INDEX_DESCRIPTION'} =~ /unique/i) {
 282                         $i->type('unique');
 283
 284                         # we could make this a primary key if there
 285                         # isn't already one defined and if there
 286                         # aren't any nullable columns in thisindex.
 287
 288                         if (!defined($table->primary_key())) {
 289                             $table->primary_key($fields)
 290                                 unless grep {
 291                                     $table->get_field($_)->is_nullable()
 292                                 } split(/,\s*/, $fields);
 293                         }
 294                     }
 295                 }
 296             }
 297         } elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
 298                 next if $table_info->{TABLE_NAME} eq 'sysconstraints'
 299                         || $table_info->{TABLE_NAME} eq 'syssegments';
 300                 next if !$stuff->{view}->{$table_info->{TABLE_NAME}}->{text};
 301             my $view =  $schema->add_view(
 302                                           name =>
 303 $table_info->{TABLE_NAME},
 304                                           );
 305
 306
 307             my $cols =
 308                 $columns->{$table_info->{TABLE_CAT}}
 309                     ->{$table_info->{TABLE_SCHEM}}
 310                         ->{$table_info->{TABLE_NAME}}
 311                             ->{columns};
 312
 313             $view->fields(map {
 314                 $_->{COLUMN_NAME}
 315             } sort {
 316                 $a->{ORDINAL_POSITION} <=> $b->{ORDINAL_POSITION}
 317                 } values %{$cols}
 318                          );
 319
 320             $view->sql($stuff->{view}->{$table_info->{TABLE_NAME}}->{text})
 321                 if (defined($stuff->{view}->{$table_info->{TABLE_NAME}}->{text}));
 322         }
 323     }
 324
 325     foreach my $p (values %{$stuff->{procedures}}) {
 326         next if !$p->{text};
 327         my $proc = $schema->add_procedure(
 328                                name      => $p->{name},
 329                                owner     => $p->{PROCEDURE_OWNER},
 330                                comments  => $p->{REMARKS},
 331                                sql       => $p->{text},
 332                                );
 333
 334     }
 335
 336     ### Permissions
 337     ### Groups
 338     ### Users
 339     ### Aliases
 340     ### Logins
 341     return 1;
 342 }
 343
 344 1;
 345
 346 # -------------------------------------------------------------------
 347
 348 =pod
 349
 350 =head1 AUTHOR
 351
 352 Chris Hilton E<lt>chris@dctank.comE<gt> - Bulk of code from
 353 DBI-Sybase parser, I just tweaked it for SQLServer. Thanks.
 354
 355 =head1 SEE ALSO
 356
 357 DBI, DBD::ODBC, SQL::Translator::Schema.
 358
 359 =cut