don't required => 1 when lazy & default specified

[dbsrgits/SQL-Translator-2.0-ish.git] / lib / SQL / Translator / Parser / DBI.pm

diff --git a/lib/SQL/Translator/Parser/DBI.pm b/lib/SQL/Translator/Parser/DBI.pm
index 3c6adf0..094944f 100644 (file)
--- a/lib/SQL/Translator/Parser/DBI.pm
+++ b/lib/SQL/Translator/Parser/DBI.pm
@@ -1,74 +1,113 @@
 package SQL::Translator::Parser::DBI;
-use Class::MOP;
-use Moose;
-use MooseX::Types::Moose qw(Str);
-use SQL::Translator::Types qw(DBIHandle);
+use namespace::autoclean;
+use Moose::Role;
+use MooseX::Types::Moose qw(Maybe Str);
 use DBI::Const::GetInfoType;
-extends 'SQL::Translator::Parser';
+use DBI::Const::GetInfo::ANSI;
+use DBI::Const::GetInfoReturn;
+use aliased 'SQL::Translator::Object::Column';
+use aliased 'SQL::Translator::Object::Index';
+use aliased 'SQL::Translator::Object::Table';
+use aliased 'SQL::Translator::Object::View';
 
-has 'dbh' => (
-  is => 'rw',
-  isa => DBIHandle,
-  required => 1
-);
-
-has 'translator' => (
-  is => 'rw', 
-  does => 'SQL::Translator::Parser::DBI::Dialect',
-  handles => {
-    make_create_string => 'make_create_string',
-    make_update_string => 'make_update_string'
-  }
+has 'quoter' => (
+    is => 'rw',
+    isa => Str,
+    lazy => 1,
+    default => sub { shift->dbh->get_info(29) || q{"} }
 );
 
-has 'db_schema' => (
-  is => 'rw',
-  isa => Str,
-  lazy => 1,
-  required => 1,
-  default => sub { shift->translator->db_schema }
+has 'namesep' => (
+    is => 'rw',
+    isa => Str,
+    lazy => 1,
+    default => sub { shift->dbh->get_info(41) || '.' }
 );
 
-has 'quoter' => (
-  is => 'rw',
-  isa => Str,
-  requried => 1,
-  default => q{"}
+has 'schema_name' => (
+    is => 'rw',
+    isa => Maybe[Str],
+    lazy => 1,
+    default => undef
 );
 
-has 'namesep' => (
-  is => 'rw',
-  isa => Str,
-  required => 1,
-  default => '.'
+has 'catalog_name' => (
+    is => 'rw',
+    isa => Maybe[Str],
+    lazy => 1,
+    default => undef
 );
 
-sub BUILD {
+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);
+}
 
-    my $class = 'SQL::Translator::Parser::DBI::' . $dbtypename;
-    Class::MOP::load_class( $class );    
-    my $translator = $class->new( dbh => $self->dbh );
-    $self->translator($translator);
+sub _is_auto_increment { 0 }
 
-    $self->quoter( $self->dbh->get_info(29) || q{"} );
-    $self->namesep( $self->dbh->get_info(41) || q{.} );
+sub _column_default_value {
+    my $self = shift;
+    my $column_info = shift;
+
+    return $column_info->{COLUMN_DEF};
 }
 
-sub _tables_list {
+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 = 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});
+            my $view = View->new({ name => $table_info->{TABLE_NAME}, sql => $sql });
+            $schema->add_view($view);
+            $self->_add_columns($view);
+        }
+    }
+}
+
+sub _add_columns {
+    my $self  = shift;
+    my $table = shift;
 
-    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;
+    my $sth = $self->dbh->column_info($self->catalog_name, $self->schema_name, $table->name, '%');
+    while (my $column_info = $sth->fetchrow_hashref) {
+        my $column = Column->new({ name => $column_info->{COLUMN_NAME},
+                                   data_type => $column_info->{DATA_TYPE},
+                                   size => $column_info->{COLUMN_SIZE},
+                                   default_value => $self->_column_default_value($column_info),
+                                   is_auto_increment => $self->_is_auto_increment($column_info),
+                                   is_nullable => $column_info->{NULLABLE},
+                                 });
+        $table->add_column($column);
+    }
+}
+
+sub _add_primary_key {
+    my $self = shift;
+    my $table = shift;
 
-    return @tables;
+    my $pk_info = $self->dbh->primary_key_info($self->catalog_name, $self->schema_name, $table->name);
+    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};
+    }
+    my $index = Index->new({ name => $pk_name, type => 'PRIMARY_KEY' });
+    $index->add_column($table->get_column($_)) for @pk_cols;
+    $table->add_index($index);
 }
 
 1;