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

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