use SQL::Translator::Types qw(DBIHandle);
has 'parser' => (
- isa => Str,
- is => 'ro',
- init_arg => 'from',
- required => 1,
+ isa => Str,
+ is => 'ro',
+ init_arg => 'from',
+ required => 1,
);
has 'producer' => (
- isa => Str,
- is => 'ro',
- init_arg => 'to',
- required => 1,
+ isa => Str,
+ is => 'ro',
+ init_arg => 'to',
+ required => 1,
);
has 'dbh' => (
extends 'SQL::Translator::Object';
has 'name' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'data_type' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'size' => (
- is => 'rw',
- isa => Maybe[Int],
- required => 1
+ is => 'rw',
+ isa => Maybe[Int],
+ required => 1
);
has 'is_nullable' => (
- is => 'rw',
- isa => Bool,
- required => 1,
- default => 1
+ is => 'rw',
+ isa => Bool,
+ required => 1,
+ default => 1
);
has 'is_auto_increment' => (
- is => 'rw',
- isa => Bool,
- required => 1,
- default => 0
+ is => 'rw',
+ isa => Bool,
+ required => 1,
+ default => 0
);
has 'default_value' => (
- is => 'rw',
- isa => Maybe[Str],
- required => 0
+ is => 'rw',
+ isa => Maybe[Str],
+ required => 0
);
has 'remarks' => (
- is => 'rw',
- isa => Maybe[Str],
- required => 0
+ is => 'rw',
+ isa => Maybe[Str],
+ required => 0
);
has 'trigger' => (
- is => 'rw',
- isa => Trigger,
- required => 0
+ is => 'rw',
+ isa => Trigger,
+ required => 0
);
__PACKAGE__->meta->make_immutable;
extends 'SQL::Translator::Object';
has 'name' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'columns' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Column],
- provides => {
- exists => 'exists_column',
- keys => 'column_ids',
- get => 'get_column',
- set => 'set_column',
- },
- required => 1
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Column],
+ provides => {
+ exists => 'exists_column',
+ keys => 'column_ids',
+ get => 'get_column',
+ },
+ curries => {
+ set => {
+ add_column => sub {
+ my ($self, $body, $column) = @_;
+ $self->$body($column->name, $column);
+ }
+ }
+ },
+ required => 1
);
has 'type' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
__PACKAGE__->meta->make_immutable;
extends 'SQL::Translator::Object';
has 'name' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'columns' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Column],
- provides => {
- exists => 'exists_column',
- keys => 'column_ids',
- get => 'get_column',
- },
- curries => { set => { add_column => sub { my ($self, $body, $column) = @_; $self->$body($column->name, $column); } } },
- default => sub { {} },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Column],
+ provides => {
+ exists => 'exists_column',
+ keys => 'column_ids',
+ get => 'get_column',
+ },
+ curries => {
+ set => {
+ add_column => sub {
+ my ($self, $body, $column) = @_;
+ $self->$body($column->name, $column);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
has 'type' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
__PACKAGE__->meta->make_immutable;
use MooseX::Types::Moose qw(HashRef Int Maybe Str);
use MooseX::AttributeHelpers;
use SQL::Translator::Types qw();
-use SQL::Translator::Object::Schema;
+use aliased 'SQL::Translator::Object::Schema';
extends 'SQL::Translator::Object';
has 'name' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'contents' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'parameters' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => Maybe[HashRef[Int|Str]],
- provides => {
- exists => 'exists_parameter',
- keys => 'parameter_ids',
- get => 'get_parameter',
- set => 'set_parameter',
- },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => Maybe[HashRef[Int|Str]],
+ provides => {
+ exists => 'exists_parameter',
+ keys => 'parameter_ids',
+ get => 'get_parameter',
+ set => 'set_parameter',
+ },
+ required => 0
);
has 'owner' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'comments' => (
- is => 'rw',
- isa => Str,
- required => 0
+ is => 'rw',
+ isa => Str,
+ required => 0
);
has 'schema' => (
- is => 'rw',
- isa => Schema,
- required => 1,
- default => sub { SQL::Translator::Object::Schema->new }
+ is => 'rw',
+ isa => Schema,
+ required => 1,
+ default => sub { Schema->new }
);
__PACKAGE__->meta->make_immutable;
extends 'SQL::Translator::Object';
has 'name' => (
- is => 'rw',
- isa => Maybe[Str],
- required => 1,
- default => ''
+ is => 'rw',
+ isa => Maybe[Str],
+ required => 1,
+ default => ''
);
has 'tables' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Table],
- provides => {
- exists => 'exists_table',
- keys => 'table_ids',
- get => 'get_table',
- },
- curries => { set => { add_table => sub { my ($self, $body, $table) = @_; $self->$body($table->name, $table); } } },
- default => sub { {} },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Table],
+ provides => {
+ exists => 'exists_table',
+ keys => 'table_ids',
+ get => 'get_table',
+ },
+ curries => {
+ set => {
+ add_table => sub {
+ my ($self, $body, $table) = @_;
+ $self->$body($table->name, $table);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
has 'views' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[View],
- provides => {
- exists => 'exists_view',
- keys => 'view_ids',
- get => 'get_view',
- },
- curries => { set => { add_view => sub { my ($self, $body, $view) = @_; $self->$body($view->name, $view); } } },
- default => sub { {} },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[View],
+ provides => {
+ exists => 'exists_view',
+ keys => 'view_ids',
+ get => 'get_view',
+ },
+ curries => {
+ set => {
+ add_view => sub {
+ my ($self, $body, $view) = @_;
+ $self->$body($view->name, $view);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
has 'procedures' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Procedure],
- provides => {
- exists => 'exists_procedure',
- keys => 'procedure_ids',
- get => 'get_procedure',
- },
- curries => { set => { add_procedure => sub { my ($self, $body, $procedure) = @_; $self->$body($procedure->name, $procedure); } } },
- default => sub { {} },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Procedure],
+ provides => {
+ exists => 'exists_procedure',
+ keys => 'procedure_ids',
+ get => 'get_procedure',
+ },
+ curries => {
+ set => {
+ add_procedure => sub {
+ my ($self, $body, $procedure) = @_;
+ $self->$body($procedure->name, $procedure);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
__PACKAGE__->meta->make_immutable;
use SQL::Translator::Types qw();
extends 'SQL::Translator::Object';
-has 'name' => (is => 'ro', isa => Str, required => 1);
+has 'name' => (
+ is => 'ro',
+ isa => Str,
+ required => 1
+);
__PACKAGE__->meta->make_immutable;
extends 'SQL::Translator::Object';
has 'name' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'columns' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Column],
- provides => {
- exists => 'exists_column',
- keys => 'column_ids',
- get => 'get_column',
- },
- curries => { set => { add_column => sub { my ($self, $body, $column) = @_; $self->$body($column->name, $column); } } },
- default => sub { {} },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Column],
+ provides => {
+ exists => 'exists_column',
+ keys => 'column_ids',
+ get => 'get_column',
+ },
+ curries => {
+ set => {
+ add_column => sub {
+ my ($self, $body, $column) = @_;
+ $self->$body($column->name, $column);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
has 'indexes' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Index],
- provides => {
- exists => 'exists_index',
- keys => 'index_ids',
- get => 'get_index',
- },
- curries => { set => { add_index => sub { my ($self, $body, $index) = @_; $self->$body($index->name, $index); } } },
- default => sub { {} },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Index],
+ provides => {
+ exists => 'exists_index',
+ keys => 'index_ids',
+ get => 'get_index',
+ },
+ curries => {
+ set => {
+ add_index => sub {
+ my ($self, $body, $index) = @_;
+ $self->$body($index->name, $index);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
has 'constraints' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Constraint],
- provides => {
- exists => 'exists_constraint',
- keys => 'constraint_ids',
- get => 'get_constraint',
- },
- curries => { set => { add_constraint => sub { my ($self, $body, $constraint) = @_; $self->$body($constraint->name, $constraint); } } },
- default => sub { {} },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Constraint],
+ provides => {
+ exists => 'exists_constraint',
+ keys => 'constraint_ids',
+ get => 'get_constraint',
+ },
+ curries => {
+ set => {
+ add_constraint => sub {
+ my ($self, $body, $constraint) = @_;
+ $self->$body($constraint->name, $constraint);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
has 'sequences' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Sequence],
- provides => {
- exists => 'exists_sequence',
- keys => 'sequence_ids',
- get => 'get_sequence',
- },
- curries => { set => { add_sequence => sub { my ($self, $body, $sequence) = @_; $self->$body($sequence->name, $sequence); } } },
- default => sub { {} },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Sequence],
+ provides => {
+ exists => 'exists_sequence',
+ keys => 'sequence_ids',
+ get => 'get_sequence',
+ },
+ curries => {
+ set => {
+ add_sequence => sub {
+ my ($self, $body, $sequence) = @_;
+ $self->$body($sequence->name, $sequence);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
__PACKAGE__->meta->make_immutable;
use SQL::Translator::Types qw();
extends 'SQL::Translator::Object';
-has 'name' => (is => 'ro', isa => Str, required => 1);
+has 'name' => (
+ is => 'ro',
+ isa => Str,
+ required => 1
+);
__PACKAGE__->meta->make_immutable;
extends 'SQL::Translator::Object';
has 'name' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
has 'columns' => (
- metaclass => 'Collection::Hash',
- is => 'rw',
- isa => HashRef[Column],
- provides => {
- exists => 'exists_column',
- keys => 'column_ids',
- get => 'get_column',
- set => 'set_column',
- },
- required => 0
+ metaclass => 'Collection::Hash',
+ is => 'rw',
+ isa => HashRef[Column],
+ provides => {
+ exists => 'exists_column',
+ keys => 'column_ids',
+ get => 'get_column',
+ },
+ curries => {
+ set => {
+ add_column => sub {
+ my ($self, $body, $column) = @_;
+ $self->$body($column->name, $column);
+ }
+ }
+ },
+ default => sub { {} },
+ required => 0
);
has 'sql' => (
- is => 'rw',
- isa => Str,
- required => 1
+ is => 'rw',
+ isa => Str,
+ required => 1
);
__PACKAGE__->meta->make_immutable;
use Moose;
use MooseX::Types::Moose qw(Str);
use SQL::Translator::Types qw(DBIHandle);
+use aliased 'SQL::Translator::Object::Schema';
my $apply_role_dbi = sub {
my $self = shift;
trigger => $apply_role_ddl,
);
-sub BUILD {}
-
sub parse {
my $self = shift;
- my $schema = SQL::Translator::Object::Schema->new({ name => $self->schema_name });
+ my $schema = Schema->new({ name => $self->schema_name });
$self->_add_tables($schema);
$schema;
}
use DBI::Const::GetInfoType;
use DBI::Const::GetInfo::ANSI;
use DBI::Const::GetInfoReturn;
-use SQL::Translator::Object::Column;
-use SQL::Translator::Object::Index;
-use SQL::Translator::Object::Table;
-use SQL::Translator::Object::View;
+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 'quoter' => (
- is => 'rw',
- isa => Str,
- requried => 1,
- lazy => 1,
- default => sub { shift->dbh->get_info(29) || q{"} }
+ is => 'rw',
+ isa => Str,
+ requried => 1,
+ lazy => 1,
+ default => sub { shift->dbh->get_info(29) || q{"} }
);
has 'namesep' => (
- is => 'rw',
- isa => Str,
- required => 1,
- lazy => 1,
- default => sub { shift->dbh->get_info(41) || '.' }
+ is => 'rw',
+ isa => Str,
+ required => 1,
+ lazy => 1,
+ default => sub { shift->dbh->get_info(41) || '.' }
);
has 'schema_name' => (
- is => 'rw',
- isa => Maybe[Str],
- required => 0,
- lazy => 1,
- default => undef
+ is => 'rw',
+ isa => Maybe[Str],
+ required => 0,
+ lazy => 1,
+ default => undef
);
has 'catalog_name' => (
- is => 'rw',
- isa => Maybe[Str],
- required => 0,
- lazy => 1,
- default => undef
+ is => 'rw',
+ isa => Maybe[Str],
+ required => 0,
+ lazy => 1,
+ default => undef
);
sub _subclass {
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} });
+ 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});
- $schema->add_view(SQL::Translator::Object::View->new({ name => $table_info->{TABLE_NAME}, sql => $sql }));
+ my $view = View->new({ name => $table_info->{TABLE_NAME}, sql => $sql });
+ $schema->add_view($view);
+ $self->_add_columns($view);
}
}
}
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}, });
+ my $column = 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);
}
}
$pk_name = $pk_col->{PK_NAME};
push @pk_cols, $pk_col->{COLUMN_NAME};
}
- my $index = SQL::Translator::Object::Index->new({ name => $pk_name, type => 'PRIMARY_KEY' });
+ my $index = Index->new({ name => $pk_name, type => 'PRIMARY_KEY' });
$index->add_column($table->get_column($_)) for @pk_cols;
$table->add_index($index);
}
use MooseX::Types::Moose qw(Str);
use SQL::Translator::Types qw(Schema);
-use Data::Dumper;
-
has 'schema' => (
- isa => Schema,
- is => 'rw',
- required => 1
+ isa => Schema,
+ is => 'rw',
+ required => 1
);
sub produce {
my $self = shift;
my $schema = $self->schema;
- my $tables = $schema->tables;
- foreach my $tname (keys %$tables) {
- $self->_create_table($tables->{$tname});
- }
+ $self->_create_table($_) for values %{$schema->tables};
}
sub _create_table {
my $sqlite_version = 0;
my $create_table;
+ my (@column_defs, @index_defs, @constraint_defs);
+
+ $create_table .= 'DROP TABLE ' . $table->name . ";\n" if $add_drop_table;
+ $create_table .= 'CREATE TABLE ' . $table->name . " (\n";
- $create_table .= 'DROP TABLE ' . $table->name . ";\n" if $add_drop_table;
- $create_table .= "CREATE TABLE " . $table->name . " (\n";
-
- my $columns = $table->columns;
- foreach my $cname (keys %$columns) {
- my $column = $columns->{$cname};
- $create_table .= ' ' . $column->name . ' ' . $column->data_type;
- $create_table .= '(' . $column->size . ')' if $column->size;
- $create_table .= ' NOT NULL' unless $column->is_nullable;
- $create_table .= ",\n";
- }
- $create_table =~ s/,$//;
- $create_table .= ");";
+ push @column_defs, $self->_create_column($_) for values %{$table->columns};
+ $create_table .= join(",\n", map { ' ' . $_ } @column_defs ) . "\n)";
print $create_table . "\n";
}
+sub _create_column {
+ my $self = shift;
+ my $column = shift;
+
+ my $column_def;
+ $column_def = $column->name . ' ' . $column->data_type;
+ $column_def .= '(' . $column->size . ')' if $column->size;
+ $column_def .= ' NOT NULL' unless $column->is_nullable;
+ $column_def;
+}
+
__PACKAGE__->meta->make_immutable;
1;
use namespace::autoclean;
use Moose::Role;
+sub _create_table {
+ my $self = shift;
+ my $table = shift;
+
+ my $no_comments = 0;
+ my $add_drop_table = 1;
+ my $sqlite_version = 0;
+
+ my $create_table;
+ my (@create, @column_defs, @index_defs, @constraint_defs);
+
+ $create_table .= 'DROP TABLE ' . $table->name . ";\n" if $add_drop_table;
+ $create_table .= 'CREATE TABLE ' . $table->name . " (\n";
+
+ push @column_defs, $self->_create_column($_) for values %{$table->columns};
+ $create_table .= join(",\n", map { ' ' . $_ } @column_defs ) . "\n)";
+
+ print $create_table . "\n";
+ return (@create, $create_table, @index_defs, @constraint_defs );
+}
+
+sub _create_column {
+ my $self = shift;
+ my $column = shift;
+
+ my $size = $column->data_type =~ /^(timestamp)/i ? undef : $column->size;
+
+ my $column_def;
+ $column_def = $column->name . ' ' . $column->data_type;
+ $column_def .= '(' . $column->size . ')' if $size;
+ $column_def .= ' NOT NULL' unless $column->is_nullable;
+ $column_def .= ' DEFAULT ' . $column->default_value if $column->default_value;
+ $column_def;
+}
+
1;
projects / dbsrgits/SQL-Translator-2.0-ish.git / commitdiff