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

   1 package SQL::Translator::Parser::DBI::Sybase;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: Sybase.pm 1440 2009-01-17 16:31:57Z jawnsy $
   5 # -------------------------------------------------------------------
   6 # Copyright (C) 2002-2009 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::Sybase - parser for DBD::Sybase
  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 @EXPORT_OK ];
  43 $DEBUG   = 0 unless defined $DEBUG;
  44
  45 no strict 'refs';
  46
  47 # -------------------------------------------------------------------
  48 sub parse {
  49     my ( $tr, $dbh ) = @_;
  50
  51     if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
  52         warn "setting dbh attribute {FetchHashKeyName} to NAME_uc";
  53         $dbh->{FetchHashKeyName} = 'NAME_uc';
  54     }
  55
  56     if ($dbh->{ChopBlanks} != 1) {
  57         warn "setting dbh attribute {ChopBlanks} to 1";
  58         $dbh->{ChopBlanks} = 1;
  59     }
  60
  61     my $schema = $tr->schema;
  62
  63     my ($sth, @tables, $columns);
  64     my $stuff;
  65
  66     ### Columns
  67
  68     # it is much quicker to slurp back everything all at once rather
  69     # than make repeated calls
  70
  71     $sth = $dbh->column_info(undef, undef, undef, undef);
  72
  73
  74     foreach my $c (@{$sth->fetchall_arrayref({})}) {
  75         $columns
  76             ->{$c->{TABLE_CAT}}
  77                 ->{$c->{TABLE_SCHEM}}
  78                     ->{$c->{TABLE_NAME}}
  79                         ->{columns}
  80                             ->{$c->{COLUMN_NAME}}= $c;
  81     }
  82
  83     ### Tables and views
  84
  85     # Get a list of the tables and views.
  86     $sth = $dbh->table_info();
  87     @tables   = @{$sth->fetchall_arrayref({})};
  88
  89     my $h = $dbh->selectall_arrayref(q{
  90 SELECT o.name, colid,colid2,c.text
  91   FROM syscomments c
  92   JOIN sysobjects o
  93     ON c.id = o.id
  94  WHERE o.type ='V'
  95 ORDER BY o.name,
  96          c.colid,
  97          c.colid2
  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} .= $_->[3];
 108     }
 109
 110     #### objects with indexes.
 111     map {
 112         $stuff->{indexes}->{$_->[0]}++
 113             if defined;
 114     } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id) AS name
 115                                     FROM sysindexes
 116                                    WHERE indid > 0")};
 117
 118     ## slurp objects
 119     map {
 120         $stuff->{$_->[1]}->{$_->[0]} = $_;
 121     } @{$dbh->selectall_arrayref("SELECT name,type, id FROM sysobjects")};
 122
 123
 124     ### Procedures
 125
 126     # This gets legitimate procedures by used the 'supported' API: sp_stored_procedures
 127     map {
 128         my $n = $_->{PROCEDURE_NAME};
 129         $n =~ s/;\d+$//;        # Ignore versions for now
 130         $_->{name} = $n;
 131         $stuff->{procedures}->{$n} = $_;
 132     } values %{$dbh->selectall_hashref("sp_stored_procedures", 'PROCEDURE_NAME')};
 133
 134
 135     # And this blasts in the text of 'legit' stored procedures.  Do
 136     # this rather than calling sp_helptext in a loop.
 137
 138     $h = $dbh->selectall_arrayref(q{
 139 SELECT o.name, colid,colid2,c.text
 140   FROM syscomments c
 141   JOIN sysobjects o
 142     ON c.id = o.id
 143  WHERE o.type ='P'
 144 ORDER BY o.name,
 145          c.colid,
 146          c.colid2
 147 }
 148 );
 149
 150     foreach (@{$h}) {
 151         $stuff->{procedures}->{$_->[0]}->{text} .= $_->[3]
 152             if (defined($stuff->{procedures}->{$_->[0]}));
 153     }
 154
 155     ### Defaults
 156     ### Rules
 157     ### Bind Defaults
 158     ### Bind Rules
 159
 160     ### Triggers
 161     # Since the 'target' of the trigger is defined in the text, we will
 162     # just create them independently for now rather than associating them
 163     # with a table.
 164
 165     $h = $dbh->selectall_arrayref(q{
 166 SELECT o.name, colid,colid2,c.text
 167   FROM syscomments c
 168   JOIN sysobjects o
 169     ON c.id = o.id
 170   JOIN sysobjects o1
 171     ON (o.id = o1.instrig OR o.id = o1.deltrig or o.id = o1.updtrig)
 172  WHERE o.type ='TR'
 173 ORDER BY o.name,
 174          c.colid,
 175          c.colid2
 176 }
 177 );
 178     foreach (@{$h}) {
 179         $stuff->{triggers}->{$_->[0]}->{text} .= $_->[3];
 180     }
 181
 182     ### References
 183     ### Keys
 184
 185     ### Types
 186     # Not sure what to do with these?
 187     $stuff->{type_info_all} = $dbh->type_info_all;
 188
 189     ### Tables
 190     # According to the DBI docs, these can be
 191
 192     # "TABLE"
 193     # "VIEW"
 194     # "SYSTEM TABLE"
 195     # "GLOBAL TEMPORARY",
 196     # "LOCAL TEMPORARY"
 197     # "ALIAS"
 198     # "SYNONYM"
 199
 200     foreach my $table_info (@tables) {
 201         next
 202             unless (defined($table_info->{TABLE_TYPE}));
 203
 204         if ($table_info->{TABLE_TYPE} =~ /TABLE/) {
 205             my $table = $schema->add_table(
 206                                            name =>
 207 $table_info->{TABLE_NAME},
 208                                            type =>
 209 $table_info->{TABLE_TYPE},
 210                                           ) || die $schema->error;
 211
 212             # find the associated columns
 213
 214             my $cols =
 215                 $columns->{$table_info->{TABLE_QUALIFIER}}
 216                     ->{$table_info->{TABLE_OWNER}}
 217                         ->{$table_info->{TABLE_NAME}}
 218                             ->{columns};
 219
 220             foreach my $c (values %{$cols}) {
 221                 my $f = $table->add_field(
 222                                           name        => $c->{COLUMN_NAME},
 223                                           data_type   => $c->{TYPE_NAME},
 224                                           order       => $c->{ORDINAL_POSITION},
 225                                           size        => $c->{COLUMN_SIZE},
 226                                          ) || die $table->error;
 227
 228                 $f->is_nullable(1)
 229                     if ($c->{NULLABLE} == 1);
 230             }
 231
 232             # add in primary key
 233             my $h = $dbh->selectall_hashref("sp_pkeys
 234 $table_info->{TABLE_NAME}", 'COLUMN_NAME');
 235             if (scalar keys %{$h} > 1) {
 236                 my @c = map {
 237                     $_->{COLUMN_NAME}
 238                 } sort {
 239                     $a->{KEY_SEQ} <=> $b->{KEY_SEQ}
 240                 } values %{$h};
 241
 242                 $table->primary_key(@c)
 243                     if (scalar @c);
 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             my $view =  $schema->add_view(
 279                                           name =>
 280 $table_info->{TABLE_NAME},
 281                                           );
 282
 283
 284             my $cols =
 285                 $columns->{$table_info->{TABLE_QUALIFIER}}
 286                     ->{$table_info->{TABLE_OWNER}}
 287                         ->{$table_info->{TABLE_NAME}}
 288                             ->{columns};
 289
 290             $view->fields(map {
 291                 $_->{COLUMN_NAME}
 292             } sort {
 293                 $a->{ORDINAL_POSITION} <=> $b->{ORDINAL_POSITION}
 294                 } values %{$cols}
 295                          );
 296
 297             $view->sql($stuff->{view}->{$table_info->{TABLE_NAME}}->{text})
 298                 if (defined($stuff->{view}->{$table_info->{TABLE_NAME}}->{text}));
 299         }
 300     }
 301
 302     foreach my $p (values %{$stuff->{procedures}}) {
 303         my $proc = $schema->add_procedure(
 304                                name      => $p->{name},
 305                                owner     => $p->{PROCEDURE_OWNER},
 306                                comments  => $p->{REMARKS},
 307                                sql       => $p->{text},
 308                                );
 309
 310     }
 311
 312     ### Permissions
 313     ### Groups
 314     ### Users
 315     ### Aliases
 316     ### Logins
 317     return 1;
 318 }
 319
 320 1;
 321
 322 # -------------------------------------------------------------------
 323
 324 =pod
 325
 326 =head1 AUTHOR
 327
 328 Paul Harrington E<lt>harringp@deshaw.comE<gt>.
 329
 330 =head1 SEE ALSO
 331
 332 DBI, DBD::Sybase, SQL::Translator::Schema.
 333
 334 =cut