—
—

              
package SQL::Translator::Parser::DBI::DB2;
HideShow 15 lines of Pod
=head1 NAME
SQL::Translator::Parser::DBI::DB2 - parser for DBD::DB2
=head1 SYNOPSIS
See SQL::Translator::Parser::DBI.
=head1 DESCRIPTION
Uses DBI methods to determine schema structure.  DBI, of course, 
delegates to DBD::DB2.
=cut
use strict;
use DBI;
use Data::Dumper;
use SQL::Translator::Parser::DB2::Grammar;
use SQL::Translator::Schema::Constants;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
# $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
$DEBUG   = 0 unless defined $DEBUG;
# -------------------------------------------------------------------
sub parse {
    my ( $tr, $dbh ) = @_;
    my $schema = $tr->schema;
    my ($sth, @tables, $columns);
    my $stuff;
    if ($dbh->{FetchHashKeyName} ne 'NAME_uc') {
        $dbh->{FetchHashKeyName} = 'NAME_uc';
    }
    if ($dbh->{ChopBlanks} != 1) {
        $dbh->{ChopBlanks} = 1;
    }
    my $parser = SQL::Translator::Parser::DB2::Grammar->new();
    my $tabsth = $dbh->prepare(<<SQL);
SELECT t.TABSCHEMA,
       t.TABLEID,
       t.TABNAME,
       t.TYPE,
      ts.TBSPACE
FROM SYSCAT.TABLES t
JOIN SYSCAT.TABLESPACES ts ON t.TBSPACEID = ts.TBSPACEID
WHERE t.TABSCHEMA NOT LIKE 'SYS%'
ORDER BY t.TABNAME ASC
SQL
#    $sth = $dbh->table_info();
#    @tables   = @{$sth->fetchall_arrayref({})};
    my $colsth = $dbh->prepare(<<SQL);
SELECT c.TABSCHEMA,
       c.TABNAME,
       c.COLNAME,
       c.TYPENAME,
       c.LENGTH,
       c.DEFAULT,
       c.NULLS,
       c.COLNO
FROM SYSCAT.COLUMNS c
WHERE c.TABSCHEMA NOT LIKE 'SYS%' AND
     c.TABNAME = ?
ORDER BY COLNO
SQL
    my $consth = $dbh->prepare(<<SQL);
SELECT tc.TABSCHEMA,
       tc.TABNAME,
       kc.CONSTNAME,
       kc.COLNAME,
       tc.TYPE,
       tc.CHECKEXISTINGDATA
FROM SYSCAT.TABCONST tc
JOIN SYSCAT.KEYCOLUSE kc ON tc.CONSTNAME = kc.CONSTNAME AND
                            tc.TABSCHEMA = kc.TABSCHEMA AND
                            tc.TABNAME   = kc.TABNAME
WHERE tc.TABSCHEMA NOT LIKE 'SYS%' AND
      tc.TABNAME = ?
SQL
    my $indsth = $dbh->prepare(<<SQL);
SELECT i.INDSCHEMA, 
       i.INDNAME, 
       i.TABSCHEMA, 
       i.TABNAME, 
       i.UNIQUERULE, 
       i.INDEXTYPE, 
       ic.COLNAME 
FROM SYSCAT.INDEXES i 
JOIN SYSCAT.INDEXCOLUSE ic ON i.INDSCHEMA = ic.INDSCHEMA AND 
                              i.INDNAME = ic.INDNAME 
WHERE i.TABSCHEMA NOT LIKE 'SYS%' AND 
      i.INDEXTYPE <> 'P' AND
      i.TABNAME = ?
SQL
    my $trigsth = $dbh->prepare(<<SQL);
SELECT t.TRIGSCHEMA,
       t.TRIGNAME,
       t.TABSCHEMA, 
       t.TABNAME,
       t.TRIGTIME,
       t.TRIGEVENT,
       t.GRANULARITY,
       t.TEXT
FROM SYSCAT.TRIGGERS t
WHERE t.TABSCHEMA NOT LIKE 'SYS%' AND
      t.TABNAME = ?
SQL
    my $viewsth = $dbh->prepare(<<SQL);
SELECT v.VIEWSCHEMA,
       v.VIEWNAME,
       v.TEXT 
FROM SYSCAT.VIEWS v
WHERE v.VIEWSCHEMA NOT LIKE 'SYS%'
ORDER BY v.VIEWNAME ASC
SQL
    $tabsth->execute();
    @tables = @{$tabsth->fetchall_arrayref({})};
    foreach my $table_info (@tables) {
        next
            unless (defined($table_info->{TYPE}));
# Why are we not getting system tables, maybe a parameter should decide?
        if ($table_info->{TYPE} eq 'T'&&
            $table_info->{TABSCHEMA} !~ /^SYS/) {
            print Dumper($table_info) if($DEBUG);
            print  $table_info->{TABNAME} if($DEBUG);
            my $table = $schema->add_table(
                                           name => $table_info->{TABNAME},
                                           type => 'TABLE',
                                          ) || die $schema->error;
            $table->extra("TABLESPACE" => $table_info->{TBSPACE});
            $colsth->execute($table_info->{TABNAME});
            my $cols = $colsth->fetchall_hashref("COLNAME");
       
            foreach my $c (sort {$a->{COLNO} <=> $b->{COLNO}} 
                           values %{$cols}) {
                print Dumper($c) if $DEBUG;
                print $c->{COLNAME} if($DEBUG);
                my $f = $table->add_field(
                                        name        => $c->{COLNAME},
                                        default_value => $c->{DEFAULT},
                                        data_type   => $c->{TYPENAME},
                                        order       => $c->{COLNO},
                                        size        => $c->{LENGTH},
                                         ) || die $table->error;
                 
                $f->is_nullable($c->{NULLS} eq 'Y');
            }
            $consth->execute($table_info->{TABNAME});
            my $cons = $consth->fetchall_hashref("COLNAME");
            if(%$cons)
            {
                my @fields = map { $_->{COLNAME} } (values %{$cons});
                my $c = $cons->{$fields[0]};
                 
                print  $c->{CONSTNAME} if($DEBUG);
                my $con = $table->add_constraint(
                                                 name   => $c->{CONSTNAME},
                                                 fields => \@fields,
                                                 type   => $c->{TYPE} eq 'P' ?
                                                 PRIMARY_KEY : $c->{TYPE} eq 'F' ?
                                                 FOREIGN_KEY : UNIQUE
                                                 ) || die $table->error;
             
                $con->deferrable($c->{CHECKEXISTINGDATA} eq 'D');
            }
            $indsth->execute($table_info->{TABNAME});
            my $inds = $indsth->fetchall_hashref("INDNAME");
            print Dumper($inds) if($DEBUG);
#            if(%$inds)
            foreach my $ind (keys %$inds)
            {
                print $ind, "\n" if($DEBUG);
                $indsth->execute($table_info->{TABNAME});
                my $indcols = $indsth->fetchall_hashref("COLNAME");
                next if($inds->{$ind}{UNIQUERULE} eq 'P');
                 
#                print Dumper($indcols) if($DEBUG);
                 
                my @fields = map { $_->{INDNAME} eq $ind ? $_->{COLNAME} : () }
                (values %{$indcols});
                print "$fields[0] ", 
                  Dumper($indcols->{$fields[0]}), "\n" if($DEBUG);
                my $index = $indcols->{$fields[0]};
# print "Indices :", join(',', map {$_->name} $table->get_indices()), "\n";
                 
                my $inew = $table->add_index(
                                             name   => $index->{INDNAME},
                                             fields => \@fields,
                                             type   => $index->{UNIQUERULE} eq 'U' ?
                                             UNIQUE : NORMAL
                                             ) || die $table->error;
                 
                 
            }
         
            $trigsth->execute($table_info->{TABNAME});
            my $trigs = $trigsth->fetchall_hashref("TRIGNAME");
            print Dumper($trigs) if($DEBUG);
#            next if(!%$trigs);
            foreach my $t (values %$trigs)
            {         
                print  $t->{TRIGNAME} if($DEBUG);
                my $ptrigger = $parser->create($t->{TEXT});
                return $tr->error( "Parse failed." ) unless defined $ptrigger;
                print Dumper($ptrigger) if($DEBUG);
                my $trig = $schema->add_trigger(
                     name                  => $t->{TRIGNAME},
 #                      fields => \@fields,
                     perform_action_when   => $t->{TRIGTIME} eq 'A' ? 'after' :
                                              $t->{TRIGTIME} eq 'B' ? 'before':
                                              'instead',
                     database_event        => $t->{TRIGEVENT} eq 'I' ? 'insert'
                                            : $t->{TRIGEVENT} eq 'D' ? 'delete' 
                                            : 'update',
                     action                => $ptrigger->{action},
                     on_table              => $t->{TABNAME} 
                                              ) || die $schema->error;
             
                $trig->extra( reference => $ptrigger->{'reference'},
                              condition => $ptrigger->{'condition'},
                              granularity => $ptrigger->{'granularity'},
                              schema => $ptrigger->{'schema'});
                 
#                print  Dumper($trig);
            }
        }
    }
    $viewsth->execute();
    my @views = @{$viewsth->fetchall_arrayref({})};
    foreach my $view (@views) {
        print Dumper($view) if($DEBUG);
        my $pview = $parser->create($view->{TEXT});
        return $tr->error( "Parse failed." ) unless defined $pview;
        print Dumper($pview) if($DEBUG);
        my $v;
        foreach (@{$pview->{with}})
        {
            $v = $schema->add_view( name => $_->{name},
                                    sql  => $_->{query} );
        }
        my $v = $schema->add_view(name => $view->{VIEWNAME},
                                  sql  => $pview->{sql},
                                  tempview => $v);
        $v->fields($pview->{fields} || ());
#        { local $v->{schema}='hidden'; print Dumper($v); }
    }
    return 1;
}
1;
# -------------------------------------------------------------------
# Time is a waste of money.
# Oscar Wilde
# -------------------------------------------------------------------
HideShow 12 lines of Pod
=pod
=head1 AUTHOR
Jess Robinson <lt>castaway@desert-island.m.isar.de<gt>.
=head1 SEE ALSO
SQL::Translator, DBD::DB2.
=cut