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

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