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