lib/SQL/Translator/Parser/DBI.pm

   1 package SQL::Translator::Parser::DBI;
   2 use Class::MOP;
   3 use Moose;
   4 use MooseX::Types::Moose qw(Str);
   5 use SQL::Translator::Types qw(DBIHandle);
   6 use DBI::Const::GetInfoType;
   7 extends 'SQL::Translator::Parser';
   8
   9 has 'dbh' => (
  10   is => 'rw',
  11   isa => DBIHandle,
  12   required => 1
  13 );
  14
  15 has 'translator' => (
  16   is => 'rw',
  17   does => 'SQL::Translator::Parser::DBI::Dialect',
  18   handles => {
  19     make_create_string => 'make_create_string',
  20     make_update_string => 'make_update_string'
  21   }
  22 );
  23
  24 has 'db_schema' => (
  25   is => 'rw',
  26   isa => Str,
  27   lazy => 1,
  28   required => 1,
  29   default => sub { shift->translator->db_schema }
  30 );
  31
  32 has 'quoter' => (
  33   is => 'rw',
  34   isa => Str,
  35   requried => 1,
  36   default => q{"}
  37 );
  38
  39 has 'namesep' => (
  40   is => 'rw',
  41   isa => Str,
  42   required => 1,
  43   default => '.'
  44 );
  45
  46 sub BUILD {
  47     my $self = shift;
  48
  49     local $self->dbh->{RaiseError} = 1;
  50     local $self->dbh->{PrintError} = 0;
  51
  52     my $dbtypename = $self->dbh->get_info( $GetInfoType{SQL_DBMS_NAME} ) || $self->dbh->{Driver}{Name};
  53
  54     my $class = 'SQL::Translator::Parser::DBI::' . $dbtypename;
  55     Class::MOP::load_class( $class );
  56     my $translator = $class->new( dbh => $self->dbh );
  57     $self->translator($translator);
  58
  59     $self->quoter( $self->dbh->get_info(29) || q{"} );
  60     $self->namesep( $self->dbh->get_info(41) || q{.} );
  61 }
  62
  63 sub _tables_list {
  64     my $self = shift;
  65
  66     my $dbh = $self->dbh;
  67     my @tables = $dbh->tables(undef, $self->db_schema, '%', '%');
  68     s/\Q$self->quoter\E//g for @tables;
  69     s/^.*\Q$self->namesep\E// for @tables;
  70
  71     return @tables;
  72 }
  73
  74 1;