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

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