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

   1 package SQL::Translator::Parser::DBI::Sybase;
   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::Sybase - parser for DBD::Sybase
  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.59';
  42 $DEBUG   = 0 unless defined $DEBUG;
  43
  44 no strict 'refs';
  45
  46 sub parse {
  47     my ( $tr, $dbh ) = @_;
  48
  49     if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
  50         warn "setting dbh attribute {FetchHashKeyName} to NAME_uc";
  51         $dbh->{FetchHashKeyName} = 'NAME_uc';
  52     }
  53
  54     if ($dbh->{ChopBlanks} != 1) {
  55         warn "setting dbh attribute {ChopBlanks} to 1";
  56         $dbh->{ChopBlanks} = 1;
  57     }
  58
  59     my $schema = $tr->schema;
  60
  61     my ($sth, @tables, $columns);
  62     my $stuff;
  63
  64     ### Columns
  65
  66     # it is much quicker to slurp back everything all at once rather
  67     # than make repeated calls
  68
  69     $sth = $dbh->column_info(undef, undef, undef, undef);
  70
  71
  72     foreach my $c (@{$sth->fetchall_arrayref({})}) {
  73         $columns
  74             ->{$c->{TABLE_CAT}}
  75                 ->{$c->{TABLE_SCHEM}}
  76                     ->{$c->{TABLE_NAME}}
  77                         ->{columns}
  78                             ->{$c->{COLUMN_NAME}}= $c;
  79     }
  80
  81     ### Tables and views
  82
  83     # Get a list of the tables and views.
  84     $sth = $dbh->table_info();
  85     @tables   = @{$sth->fetchall_arrayref({})};
  86
  87     my $h = $dbh->selectall_arrayref(q{
  88 SELECT o.name, colid,colid2,c.text
  89   FROM syscomments c
  90   JOIN sysobjects o
  91     ON c.id = o.id
  92  WHERE o.type ='V'
  93 ORDER BY o.name,
  94          c.colid,
  95          c.colid2
  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} .= $_->[3];
 106     }
 107
 108     #### objects with indexes.
 109     map {
 110         $stuff->{indexes}->{$_->[0]}++
 111             if defined;
 112     } @{$dbh->selectall_arrayref("SELECT DISTINCT object_name(id) AS name
 113                                     FROM sysindexes
 114                                    WHERE indid > 0")};
 115
 116     ## slurp objects
 117     map {
 118         $stuff->{$_->[1]}->{$_->[0]} = $_;
 119     } @{$dbh->selectall_arrayref("SELECT name,type, id FROM sysobjects")};
 120
 121
 122     ### Procedures
 123
 124     # This gets legitimate procedures by used the 'supported' API: sp_stored_procedures
 125     map {
 126         my $n = $_->{PROCEDURE_NAME};
 127         $n =~ s/;\d+$//;        # Ignore versions for now
 128         $_->{name} = $n;
 129         $stuff->{procedures}->{$n} = $_;
 130     } values %{$dbh->selectall_hashref("sp_stored_procedures", 'PROCEDURE_NAME')};
 131
 132
 133     # And this blasts in the text of 'legit' stored procedures.  Do
 134     # this rather than calling sp_helptext in a loop.
 135
 136     $h = $dbh->selectall_arrayref(q{
 137 SELECT o.name, colid,colid2,c.text
 138   FROM syscomments c
 139   JOIN sysobjects o
 140     ON c.id = o.id
 141  WHERE o.type ='P'
 142 ORDER BY o.name,
 143          c.colid,
 144          c.colid2
 145 }
 146 );
 147
 148     foreach (@{$h}) {
 149         $stuff->{procedures}->{$_->[0]}->{text} .= $_->[3]
 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,colid2,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          c.colid2
 174 }
 175 );
 176     foreach (@{$h}) {
 177         $stuff->{triggers}->{$_->[0]}->{text} .= $_->[3];
 178     }
 179
 180     ### References
 181     ### Keys
 182
 183     ### Types
 184     # Not sure what to do with these?
 185     $stuff->{type_info_all} = $dbh->type_info_all;
 186
 187     ### Tables
 188     # According to the DBI docs, these can be
 189
 190     # "TABLE"
 191     # "VIEW"
 192     # "SYSTEM TABLE"
 193     # "GLOBAL TEMPORARY",
 194     # "LOCAL TEMPORARY"
 195     # "ALIAS"
 196     # "SYNONYM"
 197
 198     foreach my $table_info (@tables) {
 199         next
 200             unless (defined($table_info->{TABLE_TYPE}));
 201
 202         if ($table_info->{TABLE_TYPE} =~ /TABLE/) {
 203             my $table = $schema->add_table(
 204                                            name =>
 205 $table_info->{TABLE_NAME},
 206                                            type =>
 207 $table_info->{TABLE_TYPE},
 208                                           ) || die $schema->error;
 209
 210             # find the associated columns
 211
 212             my $cols =
 213                 $columns->{$table_info->{TABLE_QUALIFIER}}
 214                     ->{$table_info->{TABLE_OWNER}}
 215                         ->{$table_info->{TABLE_NAME}}
 216                             ->{columns};
 217
 218             foreach my $c (values %{$cols}) {
 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
 226                 $f->is_nullable(1)
 227                     if ($c->{NULLABLE} == 1);
 228             }
 229
 230             # add in primary key
 231             my $h = $dbh->selectall_hashref("sp_pkeys
 232 $table_info->{TABLE_NAME}", 'COLUMN_NAME');
 233             if (scalar keys %{$h} > 1) {
 234                 my @c = map {
 235                     $_->{COLUMN_NAME}
 236                 } sort {
 237                     $a->{KEY_SEQ} <=> $b->{KEY_SEQ}
 238                 } values %{$h};
 239
 240                 $table->primary_key(@c)
 241                     if (scalar @c);
 242             }
 243
 244             # add in any indexes ... how do we tell if the index has
 245             # already been created as part of a primary key or other
 246             # constraint?
 247
 248             if (defined($stuff->{indexes}->{$table_info->{TABLE_NAME}})){
 249                 my $h = $dbh->selectall_hashref("sp_helpindex
 250 $table_info->{TABLE_NAME}", 'INDEX_NAME');
 251                 foreach (values %{$h}) {
 252                     my $fields = $_->{'INDEX_KEYS'};
 253                     $fields =~ s/\s*//g;
 254                     my $i = $table->add_index(
 255                                               name   =>
 256 $_->{INDEX_NAME},
 257                                               fields => $fields,
 258                                              );
 259                     if ($_->{'INDEX_DESCRIPTION'} =~ /unique/i) {
 260                         $i->type('unique');
 261
 262                         # we could make this a primary key if there
 263                         # isn't already one defined and if there
 264                         # aren't any nullable columns in thisindex.
 265
 266                         if (!defined($table->primary_key())) {
 267                             $table->primary_key($fields)
 268                                 unless grep {
 269                                     $table->get_field($_)->is_nullable()
 270                                 } split(/,\s*/, $fields);
 271                         }
 272                     }
 273                 }
 274             }
 275         } elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
 276             my $view =  $schema->add_view(
 277                                           name =>
 278 $table_info->{TABLE_NAME},
 279                                           );
 280
 281
 282             my $cols =
 283                 $columns->{$table_info->{TABLE_QUALIFIER}}
 284                     ->{$table_info->{TABLE_OWNER}}
 285                         ->{$table_info->{TABLE_NAME}}
 286                             ->{columns};
 287
 288             $view->fields(map {
 289                 $_->{COLUMN_NAME}
 290             } sort {
 291                 $a->{ORDINAL_POSITION} <=> $b->{ORDINAL_POSITION}
 292                 } values %{$cols}
 293                          );
 294
 295             $view->sql($stuff->{view}->{$table_info->{TABLE_NAME}}->{text})
 296                 if (defined($stuff->{view}->{$table_info->{TABLE_NAME}}->{text}));
 297         }
 298     }
 299
 300     foreach my $p (values %{$stuff->{procedures}}) {
 301         my $proc = $schema->add_procedure(
 302                                name      => $p->{name},
 303                                owner     => $p->{PROCEDURE_OWNER},
 304                                comments  => $p->{REMARKS},
 305                                sql       => $p->{text},
 306                                );
 307
 308     }
 309
 310     ### Permissions
 311     ### Groups
 312     ### Users
 313     ### Aliases
 314     ### Logins
 315     return 1;
 316 }
 317
 318 1;
 319
 320 =pod
 321
 322 =head1 AUTHOR
 323
 324 Paul Harrington E<lt>harringp@deshaw.comE<gt>.
 325
 326 =head1 SEE ALSO
 327
 328 DBI, DBD::Sybase, SQL::Translator::Schema.
 329
 330 =cut