From: Justin Hunter <justin.d.hunter@gmail.com>
Date: Thu, 2 Jul 2009 07:34:49 +0000 (-0700)
Subject: proper parsing, using add_* instead of throwing a whole blob in
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=684763c14c057bbf26b8a16a4bb3239bed2240f4;p=dbsrgits%2FSQL-Translator-2.0-ish.git

proper parsing, using add_* instead of throwing a whole blob in
---

diff --git a/lib/SQL/Translator/Parser/DBI.pm b/lib/SQL/Translator/Parser/DBI.pm
index 02fdf46..a4f43b3 100644
--- a/lib/SQL/Translator/Parser/DBI.pm
+++ b/lib/SQL/Translator/Parser/DBI.pm
@@ -1,64 +1,124 @@
 package SQL::Translator::Parser::DBI;
-use Class::MOP;
-use Moose;
-use MooseX::Types::Moose qw(Str);
+use Moose::Role;
+use MooseX::Types::Moose qw(Maybe Str);
 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';
+use SQL::Translator::Object::Column;
+use SQL::Translator::Object::Index;
+use SQL::Translator::Object::Table;
+use SQL::Translator::Object::View;
 
-has 'dbh' => (
+has 'quoter' => (
   is => 'rw',
-  isa => DBIHandle,
-  required => 1
+  isa => Str,
+  requried => 1,
+  lazy => 1,
+  default => sub { shift->dbh->get_info(29) || q{"} }
 );
 
-has 'translator' => (
-  is => 'rw', 
-  does => 'SQL::Translator::Parser::DBI::Dialect',
-  handles => {
-    _tables_list => '_tables_list',
-    _table_columns => '_table_columns',
-    _table_pk_info => '_table_pk_info',
-    _table_fk_info => '_table_fk_info',
-    _table_uniq_info => '_table_uniq_info',
-    _columns_info_for => '_columns_info_for',
-    _extra_column_info => '_extra_column_info',
-  }
+has 'namesep' => (
+  is => 'rw',
+  isa => Str,
+  required => 1,
+  lazy => 1,
+  default => sub { shift->dbh->get_info(41) || '.' }
 );
 
-has 'schema' => (
+has 'schema_name' => (
   is => 'rw',
-  isa => Schema,
+  isa => Maybe[Str],
+  required => 1,
   lazy => 1,
+  default => sub { undef }
+);
+
+has 'catalog_name' => (
+  is => 'rw',
+  isa => Maybe[Str],
   required => 1,
-  default => sub { shift->translator->schema }
+  lazy => 1,
+  default => sub { undef }
 );
 
-sub BUILD {
+no Moose;
+
+sub _subclass {
     my $self = shift;
 
-    local $self->dbh->{RaiseError} = 1;
-    local $self->dbh->{PrintError} = 0;
+    my $dbtype = $self->dbh->get_info($GetInfoType{SQL_DBMS_NAME}) || $self->dbh->{Driver}{Name};
 
-    my $dbtypename = $self->dbh->get_info( $GetInfoType{SQL_DBMS_NAME} ) || $self->dbh->{Driver}{Name};
+    my $class = __PACKAGE__ . '::'. $dbtype;
+    Class::MOP::load_class($class);
+    $class->meta->apply($self);
+}
+
+sub _add_tables {
+    my $self = shift;
+    my $schema = shift;
+
+    my $sth = $self->dbh->table_info($self->catalog_name, $self->schema_name, '%', 'TABLE,VIEW');
+    while (my $table_info = $sth->fetchrow_hashref) {
+        if ($table_info->{TABLE_TYPE} eq 'TABLE') {
+            my $table = SQL::Translator::Object::Table->new({ name => $table_info->{TABLE_NAME} });
+            $schema->add_table($table);
+            $self->_add_columns($table);
+            $self->_add_primary_key($table);
+        }
+        elsif ($table_info->{TABLE_TYPE} eq 'VIEW') {
+            my $sql = $self->_get_view_sql($table_info->{TABLE_NAME});
+            $schema->add_view(SQL::Translator::Object::View->new({ name => $table_info->{TABLE_NAME}, sql => $sql }));
+        }
+    }
+}
 
-    my $class = 'SQL::Translator::Parser::DBI::' . $dbtypename;
-    Class::MOP::load_class( $class );    
-    my $translator = $class->new( dbh => $self->dbh );
-    $self->translator($translator);
+sub _add_columns {
+    my $self  = shift;
+    my $table = shift;
 
-    my $tables = $self->_tables_list; print Dumper($tables);
+    my $sth = $self->dbh->column_info($self->catalog_name, $self->schema_name, $table->name, '%');
+    while (my $col_info = $sth->fetchrow_hashref) {
+        my $column = SQL::Translator::Object::Column->new({ name => $col_info->{COLUMN_NAME},
+                                                            data_type => $col_info->{TYPE_NAME},
+                                                            size => $col_info->{COLUMN_SIZE},
+                                                            default_value => $col_info->{COLUMN_DEF},
+                                                            is_nullable => $col_info->{NULLABLE}, });
+        $table->add_column($column);
 
-    $self->schema->tables($tables);
+    }
+}
+
+sub _add_primary_key {
+    my $self = shift;
+    my $table = shift;
 
-    foreach my $table (keys %$tables) {
-        my $columns = $self->_columns_info_for($table);
-        $self->schema->get_table($table)->columns($columns);
+    my $pk_info = $self->dbh->primary_key_info($self->catalog_name, $self->schema_name, $table->name);
+#    use Data::Dumper;
+    my ($pk_name, @pk_cols);
+    while (my $pk_col = $pk_info->fetchrow_hashref) {
+        $pk_name = $pk_col->{PK_NAME};
+        push @pk_cols, $pk_col->{COLUMN_NAME};
+#        print Dumper($pk_col);
+=cut
+$VAR1 = {
+          'PK_NAME' => 'tester_pkey',
+          'pg_column' => 'tester_pkey',
+          'pg_table' => 'tester',
+          'COLUMN_NAME' => 'id',
+          'pg_tablespace_name' => undef,
+          'pg_tablespace_location' => undef,
+          'TABLE_CAT' => undef,
+          'TABLE_NAME' => 'tester',
+          'DATA_TYPE' => 'int4',
+          'pg_schema' => 'public',
+          'TABLE_SCHEM' => 'public',
+          'KEY_SEQ' => '1'
+        };
+=cut
     }
-#    print Dumper($self->schema);
+    my $index = SQL::Translator::Object::Index->new({ name => $pk_name, type => 'PRIMARY_KEY' });
+    $index->add_column($table->get_column($_)) for @pk_cols;
+    $table->add_index($index);
 }
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/MySQL.pm b/lib/SQL/Translator/Parser/DBI/MySQL.pm
index 427e325..0e8e163 100644
--- a/lib/SQL/Translator/Parser/DBI/MySQL.pm
+++ b/lib/SQL/Translator/Parser/DBI/MySQL.pm
@@ -1,8 +1,6 @@
 package SQL::Translator::Parser::DBI::MySQL;
-use Moose;
-use SQL::Translator::Types qw(Schema);
-with 'SQL::Translator::Parser::DBI::Dialect';
+use Moose::Role;
 
-has 'schema' => (is => 'ro', isa => Schema, default => sub { SQL::Translator::Object::Schema->new( { name => '' }) });
+no Moose;
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/Oracle.pm b/lib/SQL/Translator/Parser/DBI/Oracle.pm
index 7137c1a..8c91d3c 100644
--- a/lib/SQL/Translator/Parser/DBI/Oracle.pm
+++ b/lib/SQL/Translator/Parser/DBI/Oracle.pm
@@ -1,8 +1,6 @@
 package SQL::Translator::Parser::DBI::Oracle;
-use Moose;
-use SQL::Translator::Types qw(Schema);
-with 'SQL::Translator::Parser::DBI::Dialect';
+use Moose::Role;
 
-has 'schema' => (is => 'ro', isa => Schema, default => sub { SQL::Translator::Object::Schema->new( { name => '' }) });
+no Moose;
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm
index 28d1ac2..8668a76 100644
--- a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm
+++ b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm
@@ -1,8 +1,23 @@
 package SQL::Translator::Parser::DBI::PostgreSQL;
-use Moose;
-use SQL::Translator::Types qw(Schema);
-with 'SQL::Translator::Parser::DBI::Dialect';
+use Moose::Role;
+use MooseX::Types::Moose qw(Str);
 
-has 'schema' => (is => 'ro', isa => Schema, default => sub { SQL::Translator::Object::Schema->new({ name => 'public' }); } );
+has 'schema_name' => (
+  is => 'rw',
+  isa => Str,
+  required => 1,
+  lazy => 1,
+  default => 'public'
+);
+
+no Moose;
+
+sub _get_view_sql {
+    my $self = shift;
+    my $view = shift;
+
+    my ($sql) = $self->dbh->selectrow_array("SELECT pg_get_viewdef('$view'::regclass)");
+    return $sql;
+}
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/SQLite.pm b/lib/SQL/Translator/Parser/DBI/SQLite.pm
index e190a22..41447c3 100644
--- a/lib/SQL/Translator/Parser/DBI/SQLite.pm
+++ b/lib/SQL/Translator/Parser/DBI/SQLite.pm
@@ -1,25 +1,6 @@
 package SQL::Translator::Parser::DBI::SQLite;
-use Moose;
-use SQL::Translator::Types qw(Schema);
-use SQL::Translator::Object::Table;
-with 'SQL::Translator::Parser::DBI::Dialect';
+use Moose::Role;
 
-has 'schema' => (is => 'ro', isa => Schema, default => sub { SQL::Translator::Object::Schema->new( { name => '' }) });
-
-sub _tables_list {
-    my $self = shift;
-
-    my $dbh = $self->dbh;
-    my $sth = $dbh->prepare("SELECT * FROM sqlite_master WHERE type = 'table'");
-    $sth->execute;
-
-    my %tables;
-    while ( my $row = $sth->fetchrow_hashref ) {
-        next if $row->{tbl_name} =~ /^sqlite_/;
-        $tables{$row->{tbl_name}} = SQL::Translator::Object::Table->new( { name => $row->{tbl_name}, schema => $self->schema } );
-    }
-    $sth->finish;
-    return \%tables;
-}
+no Moose;
 
 1;
diff --git a/lib/SQL/Translator/Parser/DBI/Sybase.pm b/lib/SQL/Translator/Parser/DBI/Sybase.pm
index 1022481..4d5bbc7 100644
--- a/lib/SQL/Translator/Parser/DBI/Sybase.pm
+++ b/lib/SQL/Translator/Parser/DBI/Sybase.pm
@@ -1,8 +1,5 @@
 package SQL::Translator::Parser::DBI::Sybase;
-use Moose;
-use SQL::Translator::Types qw(Schema);
-with 'SQL::Translator::Parser::DBI::Dialect';
-
-has 'schema' => (is => 'ro', isa => Schema, default => sub { SQL::Translator::Object::Schema->new( { name => '' }) });
+use Moose::Role;
 
+no Moose;
 1;