From: Justin Hunter <justin.d.hunter@gmail.com>
Date: Sat, 20 Jun 2009 23:24:54 +0000 (-0700)
Subject: get parsing working
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c4ec1b63c155646a8ddd063a51b3249b96d2ea49;p=dbsrgits%2FSQL-Translator-2.0-ish.git

get parsing working
---

diff --git a/lib/SQL/Translator/Parser/DBI.pm b/lib/SQL/Translator/Parser/DBI.pm
index 3c6adf0..ca4b9a4 100644
--- a/lib/SQL/Translator/Parser/DBI.pm
+++ b/lib/SQL/Translator/Parser/DBI.pm
@@ -2,8 +2,11 @@ package SQL::Translator::Parser::DBI;
 use Class::MOP;
 use Moose;
 use MooseX::Types::Moose qw(Str);
-use SQL::Translator::Types qw(DBIHandle);
 use DBI::Const::GetInfoType;
+use DBI::Const::GetInfo::ANSI;
+use DBI::Const::GetInfoReturn;
+use SQL::Translator::Types qw(DBIHandle Schema);
+use Data::Dumper; 
 extends 'SQL::Translator::Parser';
 
 has 'dbh' => (
@@ -17,30 +20,23 @@ has 'translator' => (
   does => 'SQL::Translator::Parser::DBI::Dialect',
   handles => {
     make_create_string => 'make_create_string',
-    make_update_string => 'make_update_string'
+    make_update_string => 'make_update_string',
+    _tables_list => '_tables_list',
+    _table_columns => '_table_columns',
+    _table_pk_info => '_table_pk_info',
+    _table_uniq_info => '_table_uniq_info',
+    _table_fk_info => '_table_fk_info',
+    _columns_info_for => '_columns_info_for',
+    _extra_column_info => '_extra_column_info',
   }
 );
 
-has 'db_schema' => (
+has 'schema' => (
   is => 'rw',
-  isa => Str,
+  isa => Schema,
   lazy => 1,
   required => 1,
-  default => sub { shift->translator->db_schema }
-);
-
-has 'quoter' => (
-  is => 'rw',
-  isa => Str,
-  requried => 1,
-  default => q{"}
-);
-
-has 'namesep' => (
-  is => 'rw',
-  isa => Str,
-  required => 1,
-  default => '.'
+  default => sub { shift->translator->schema }
 );
 
 sub BUILD {
@@ -56,19 +52,19 @@ sub BUILD {
     my $translator = $class->new( dbh => $self->dbh );
     $self->translator($translator);
 
-    $self->quoter( $self->dbh->get_info(29) || q{"} );
-    $self->namesep( $self->dbh->get_info(41) || q{.} );
-}
+    my $tables = $self->_tables_list;
 
-sub _tables_list {
-    my $self = shift;
+    $self->schema->tables($self->_tables_list);
+    $self->schema->get_table($_)->columns($self->_columns_info_for($_)) for keys %$tables;
 
-    my $dbh = $self->dbh;
-    my @tables = $dbh->tables(undef, $self->db_schema, '%', '%');
-    s/\Q$self->quoter\E//g for @tables;
-    s/^.*\Q$self->namesep\E// for @tables;
+#    foreach my $table (keys %$tables) {
+#        my $columns = $self->_columns_info_for($table);
+#        my $table = $self->schema->get_table($key);
+#        $table->columns($columns);
+#         $self->schema->get_table($key)->columns($columns);
+#    }
 
-    return @tables;
+    print Dumper($self->schema);
 }
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/Dialect.pm b/lib/SQL/Translator/Parser/DBI/Dialect.pm
index 7bece8d..8d621af 100644
--- a/lib/SQL/Translator/Parser/DBI/Dialect.pm
+++ b/lib/SQL/Translator/Parser/DBI/Dialect.pm
@@ -1,13 +1,195 @@
 package SQL::Translator::Parser::DBI::Dialect;
 use Moose::Role;
+use MooseX::Types::Moose qw(Str);
+use SQL::Translator::Types qw(DBIHandle);
+use SQL::Translator::Object::Column;
+use SQL::Translator::Object::Table;
+use SQL::Translator::Object::Schema;
 
-requires 'make_create_string',
-         'make_update_string';
+has 'dbh' => (
+  is => 'rw',
+  isa => DBIHandle,
+  required => 1
+);
 
-sub do_common_stuff {
-    my ($self, @args) = @_;
-    print "COMMON STUFF!\n";
-    # ....
+has 'quoter' => (
+  is => 'rw',
+  isa => Str,
+  requried => 1,
+  default => q{"}
+);
+
+has 'namesep' => (
+  is => 'rw',
+  isa => Str,
+  required => 1,
+  default => '.'
+);
+
+sub BUILD {
+    my $self = shift;
+    $self->quoter( $self->dbh->get_info(29) || q{"} );
+    $self->namesep( $self->dbh->get_info(41) || q{.} );
 }
 
+sub _tables_list {
+    my $self = shift;
+
+    my $dbh = $self->dbh;
+    my $quoter = $self->quoter;
+    my $namesep = $self->namesep;
+
+    my @tables = $dbh->tables(undef, $self->schema->name, '%', '%');
+
+    s/\Q$quoter\E//g for @tables;
+    s/^.*\Q$namesep\E// for @tables;
+
+    my %retval;
+    map { $retval{$_} = SQL::Translator::Object::Table->new({ name => $_, schema => $self->schema }) } @tables;
+
+    return \%retval;
+}
+
+sub _table_columns {
+    my ($self, $table) = @_;
+
+    my $dbh = $self->dbh;
+
+    if($self->schema->name) {
+        $table = $self->schema->name . $self->namesep . $table;
+    }
+
+    my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1 = 0");
+    $sth->execute;
+    my $retval = \@{$sth->{NAME_lc}};
+    $sth->finish;
+
+    $retval;
+}
+
+sub _table_pk_info {
+    my ($self, $table) = @_;
+
+    my $dbh = $self->dbh;
+
+    my @primary = map { lc } $dbh->primary_key('', $self->schema->name, $table);
+    s/\Q$self->quoter\E//g for @primary;
+
+    return \@primary;
+}
+
+sub _table_uniq_info {
+    my ($self, $table) = @_;
+
+    my $dbh = $self->dbh;
+    if(!$dbh->can('statistics_info')) {
+        warn "No UNIQUE constraint information can be gathered for this vendor";
+        return [];
+    }
+
+    my %indices;
+    my $sth = $dbh->statistics_info(undef, $self->schema->name, $table, 1, 1);
+    while(my $row = $sth->fetchrow_hashref) {
+        # skip table-level stats, conditional indexes, and any index missing
+        #  critical fields
+        next if $row->{TYPE} eq 'table'
+            || defined $row->{FILTER_CONDITION}
+            || !$row->{INDEX_NAME}
+            || !defined $row->{ORDINAL_POSITION}
+            || !$row->{COLUMN_NAME};
+
+        $indices{$row->{INDEX_NAME}}->{$row->{ORDINAL_POSITION}} = $row->{COLUMN_NAME};
+    }
+    $sth->finish;
+
+    my @retval;
+    foreach my $index_name (keys %indices) {
+        my $index = $indices{$index_name};
+        push(@retval, [ $index_name => [
+            map { $index->{$_} }
+                sort keys %$index
+        ]]);
+    }
+
+    return \@retval;
+}
+
+sub _columns_info_for {
+    my ($self, $table) = @_;
+
+    my $dbh = $self->dbh;
+
+    if ($dbh->can('column_info')) {
+        my %result;
+        eval {
+            my $sth = $dbh->column_info( undef, $self->schema->name, $table, '%' );
+            while ( my $info = $sth->fetchrow_hashref() ) {
+                my (%column_info, $col_name);
+                $column_info{data_type}     = $info->{TYPE_NAME};
+                $column_info{size}          = $info->{COLUMN_SIZE};
+                $column_info{is_nullable}   = $info->{NULLABLE} ? 1 : 0;
+                $column_info{default_value} = $info->{COLUMN_DEF};
+                $column_info{index}         = $info->{ORDINAL_POSITION};
+                $column_info{remarks}       = $info->{REMARKS};
+                $col_name                   = $info->{COLUMN_NAME};
+                $col_name =~ s/^\"(.*)\"$/$1/;
+                $column_info{name} = $col_name;
+
+                my $extra_info = $self->_extra_column_info($info) || {};
+                my $column = SQL::Translator::Object::Column->new(%column_info);
+
+#                $result{$col_name} = { %column_info, %$extra_info };
+                $result{$col_name} = $column;
+            }
+            $sth->finish;
+        };
+      return \%result if !$@ && scalar keys %result;
+      print "OH NOES, $@\n";
+    }
+
+    if($self->schema->name) {
+        $table = $self->schema->name . $self->namesep . $table;
+    }
+    my %result;
+    my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1 = 0");
+    $sth->execute;
+    my @columns = @{$sth->{NAME_lc}};
+    for my $i ( 0 .. $#columns ) {
+        my %column_info;
+        $column_info{data_type}   = $sth->{TYPE}->[$i];
+        $column_info{size}        = $sth->{PRECISION}->[$i];
+        $column_info{is_nullable} = $sth->{NULLABLE}->[$i] ? 1 : 0;
+        $column_info{index} = $i;
+
+        if ($column_info{data_type} =~ m/^(.*?)\((.*?)\)$/) {
+            $column_info{data_type} = $1;
+            $column_info{size}      = $2;
+        }
+
+        my $extra_info = $self->_extra_column_info($table, $columns[$i], $sth, $i) || {};
+
+#        $result{$columns[$i]} = { %column_info, %$extra_info };
+        $column_info{name} = $columns[$i];
+        my $column = SQL::Translator::Object::Column->new(%column_info);
+        $result{$columns[$i]} = $column;
+
+    }
+    $sth->finish;
+
+    foreach my $col (keys %result) {
+        my $colinfo = $result{$col};
+        my $type_num = $colinfo->{data_type};
+        my $type_name;
+        if (defined $type_num && $dbh->can('type_info')) {
+            my $type_info = $dbh->type_info($type_num);
+            $type_name = $type_info->{TYPE_NAME} if $type_info;
+            $colinfo->{data_type} = $type_name if $type_name;
+        }
+    }
+
+    return \%result;
+}
+
+sub _extra_column_info { }
+
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/MySQL.pm b/lib/SQL/Translator/Parser/DBI/MySQL.pm
index afb1405..b06a4cc 100644
--- a/lib/SQL/Translator/Parser/DBI/MySQL.pm
+++ b/lib/SQL/Translator/Parser/DBI/MySQL.pm
@@ -2,14 +2,6 @@ package SQL::Translator::Parser::DBI::MySQL;
 use Moose;
 with 'SQL::Translator::Parser::DBI::Dialect';
 
-sub make_create_string {
-   print "MYSQL!\n";
-   # .....
-}
-
-sub make_update_string {
-   print "mYSQL!\n";
-}
-
+has 'schema' => (is => 'ro', isa => Str, default => { sub { SQL::Translator::Object::Schema->new( { name => '' }));
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/Oracle.pm b/lib/SQL/Translator/Parser/DBI/Oracle.pm
index d555f49..437c0c1 100644
--- a/lib/SQL/Translator/Parser/DBI/Oracle.pm
+++ b/lib/SQL/Translator/Parser/DBI/Oracle.pm
@@ -2,14 +2,6 @@ package SQL::Translator::Parser::DBI::Oracle;
 use Moose;
 with 'SQL::Translator::Parser::DBI::Dialect';
 
-sub make_create_string {
-   print "Oracle!\n";
-   # .....
-}
-
-sub make_update_string {
-   print "Oracle!\n";
-}
-
+has 'schema' => (is => 'ro', isa => Str, default => { sub { SQL::Translator::Object::Schema->new( { name => '' }));
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm
index 53d217d..28d1ac2 100644
--- a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm
+++ b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm
@@ -1,17 +1,8 @@
 package SQL::Translator::Parser::DBI::PostgreSQL;
 use Moose;
-use MooseX::Types::Moose qw(Str);
+use SQL::Translator::Types qw(Schema);
 with 'SQL::Translator::Parser::DBI::Dialect';
 
-has 'db_schema' => (is => 'ro', isa => Str, default => 'public');
-
-sub make_create_string { 
-   print "HELLO WORLD\n";
-   # ..... 
-}
-
-sub make_update_string {
-   print "WOOT\n";
-}
+has 'schema' => (is => 'ro', isa => Schema, default => sub { SQL::Translator::Object::Schema->new({ name => 'public' }); } );
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/SQLite.pm b/lib/SQL/Translator/Parser/DBI/SQLite.pm
index 968acdb..b9fbac9 100644
--- a/lib/SQL/Translator/Parser/DBI/SQLite.pm
+++ b/lib/SQL/Translator/Parser/DBI/SQLite.pm
@@ -1,15 +1,25 @@
 package SQL::Translator::Parser::DBI::SQLite;
 use Moose;
+use MooseX::Types::Moose qw(Str);
+use SQL::Translator::Types qw(DBIHandle);
 with 'SQL::Translator::Parser::DBI::Dialect';
 
-sub make_create_string {
-   print "SQLite\n";
-   # .....
-}
+has 'schema' => (is => 'ro', isa => Str, default => { sub { SQL::Translator::Object::Schema->new( { name => '' }));
 
-sub make_update_string {
-   print "SQLite\n";
-}
+sub _tables_list {
+    my $self = shift;
 
+    my $dbh = $self->dbh;
+    my $sth = $dbh->prepare("SELECT * FROM sqlite_master");
+    $sth->execute;
+    my @tables;
+    while ( my $row = $sth->fetchrow_hashref ) {
+        next unless lc( $row->{type} ) eq 'table';
+        next if $row->{tbl_name} =~ /^sqlite_/;
+        push @tables, $row->{tbl_name};
+    }
+    $sth->finish;
+    return @tables;
+}
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/Sybase.pm b/lib/SQL/Translator/Parser/DBI/Sybase.pm
index 017047b..0581c04 100644
--- a/lib/SQL/Translator/Parser/DBI/Sybase.pm
+++ b/lib/SQL/Translator/Parser/DBI/Sybase.pm
@@ -2,14 +2,6 @@ package SQL::Translator::Parser::DBI::Sybase;
 use Moose;
 with 'SQL::Translator::Parser::DBI::Dialect';
 
-sub make_create_string {
-   print "Sybase!\n";
-   # .....
-}
-
-sub make_update_string {
-   print "Sybase!\n";
-}
-
+has 'schema' => (is => 'ro', isa => Str, default => { sub { SQL::Translator::Object::Schema->new( { name => '' }));
 
 1;