package blx::xsdsql::generator::sql::generic::handle;
use strict; # use strict is for PBP
use Filter::Include;
include blx::xsdsql::include;
#line 6
use blx::xsdsql::ut::ut qw(nvl ev);
use constant {
STREAM_CLASS => 'blx::xsdsql::ios::ostream'
};
use blx::xsdsql::schema_repository::sql::generic::column;
use base qw(blx::xsdsql::ios::debuglogger);
sub header {
my ($self,$table,%params)=@_;
return $self if $params{NO_EMIT_COMMENTS};
$self->{STREAMER}->put_line;
$self->{STREAMER}->put_line($table->comment('generated by blx::xsd2sql'));
$self->{STREAMER}->put_line;
return $self;
}
sub first_pass {
my ($self,%params)=@_;
return $self;
}
sub table_header {
my ($self,$table,%params)=@_;
return $self;
}
sub table_footer {
my ($self,$table,%params)=@_;
return $self;
}
sub column {
my ($self,$table,%params)=@_;
return $self;
}
sub last_pass {
my ($self,%params)=@_;
return $self;
}
sub footer {
my ($self,$table,%params)=@_;
return $self if $params{NO_EMIT_COMMENTS};
$self->{STREAMER}->put_line;
$self->{STREAMER}->put_line($table->comment('end of blx::xsd2sql'));
$self->{STREAMER}->put_line;
return $self;
}
sub new {
my ($class,%params)=@_;
my $fd=nvl(delete $params{FD},*STDOUT);
my $self=bless \%params,$class;
if (ref($fd) ne STREAM_CLASS) {
if (ref($self->{STREAMER}) eq STREAM_CLASS) {
$self->{STREAMER}->set_output_descriptor($fd);
}
else {
ev('use ',STREAM_CLASS);
$self->{STREAMER}=STREAM_CLASS->new(OUTPUT_STREAM => $fd);
}
}
else {
$self->{STREAMER}=$fd;
}
return $self;
}
{
my $filter=undef;
$filter=sub { #recursive function
my ($col,$table,%params)=@_;
my $newcol=$col->clone(); #clone the column for add ALIAS_NAME attr
my $table_ref=$newcol->get_table_reference;
my $viewable=$newcol->is_pk && !$params{START_TABLE} || $newcol->is_sys_attributes || $newcol->is_attribute ? 0 : 1;
my $join_table=defined $table_ref && $table_ref->get_max_occurs <= 1 && $newcol->get_max_occurs <=1 ? $table_ref->shallow_clone : undef;
$newcol->set_attrs_value(
VIEWABLE => $viewable
,TABLE => $table
);
if ($viewable) { #set the alias for view
my $tmpcol=$col->clone(EXCLUDE_ATTR_KEYS => [ qw(SQL_NAME) ]); # clone without SQL_NAME attribute for generate uniq alias name
my $alias_name=$tmpcol->set_sql_name(%params); #create a unique alias name
$newcol->set_attrs_value(ALIAS_NAME => $alias_name);
}
my @ret=($newcol);
if (defined $join_table) {
$join_table->set_attrs_value(ALIAS_COUNT => ++${$params{ALIAS_COUNT}});
$newcol->set_attrs_value(JOIN_TABLE => $join_table);
push @ret,map { $filter->($_,$join_table,%params,START_TABLE => 0) } $join_table->get_columns;
}
return @ret;
};
sub _get_columns {
my ($self,$table,%params)=@_;
my $t=$table->shallow_clone;
my $alias_count=0;
$t->set_attrs_value(ALIAS_COUNT => $alias_count);
my $colname_list={};
my @cols=map { $filter->($_,$t,COLUMNNAME_LIST => $colname_list,ALIAS_COUNT => \$alias_count,START_TABLE => 1,SCHEMA => $params{SCHEMA})} $t->get_columns;
return @cols;
}
}
sub get_view_columns {
my ($self,$table,%params)=@_;
my @cols=grep($_->{VIEWABLE},$self->_get_columns($table,%params));
return wantarray ? @cols : \@cols;
}
sub get_join_columns {
my ($self,$table,%params)=@_;
my @cols=grep(defined $_->get_attrs_value(qw(JOIN_TABLE)),$self->_get_columns($table,%params));
return wantarray ? @cols : \@cols;
}
sub put_comment {
my ($self,$catalog,$comment,%params)=@_;
$self->{STREAMER}->put_line($catalog->comment($comment));
return $self;
}
sub get_streamer { return $_[0]->{STREAMER}; }
sub get_binding_objects {
my ($self,$schema,%params)=@_;
my %t=$self->{EXTRA_TABLES}->factory_extra_tables;
my @t=values %t;
return wantarray ? @t : \@t;
}
sub relation_schema {
my ($self,%params)=@_;
return $self;
}
sub _create_indexes {
my ($self,$table,%params)=@_;
my $table_name=$table->get_sql_name(%params);
my $pk_name=$table->get_constraint_name('pk');
my @cols=map { $_->get_sql_name } $table->get_pk_columns;
$self->{STREAMER}->put_line("alter table $table_name add constraint $pk_name primary key (".join(',',@cols).')',$table->command_terminator);
$self->{STREAMER}->put_line;
for my $idx($table->get_uk_index_names) {
my @cols=$table->get_index_columns($idx);
my @col_names=map {
my $col=$cols[$_];
affirm { defined $col } "the position $_ of index $idx not has an associated column";
$col->get_sql_name;
} (0..scalar(@cols) - 1);
$self->{STREAMER}->put_line("create unique index $idx on ",$table_name,"(",join(',',@col_names),')',$table->command_terminator);
$self->{STREAMER}->put_line;
}
for my $idx($table->get_ix_index_names) {
my @cols=$table->get_index_columns($idx);
my @col_names=map {
my $col=$cols[$_];
affirm { defined $col } "the position $_ of index $idx not has an associated column";
$col->get_sql_name;
} (0..scalar(@cols) - 1);
$self->{STREAMER}->put_line("create index $idx on ",$table_name,"(",join(',',@col_names),')',$table->command_terminator);
$self->{STREAMER}->put_line;
}
return $self;
}
1;
__END__
=head1 NAME
blx::xsdsql::generator::sql::generic::handle - generic handles for generator
=cut
=head1 SYNOPSIS
use blx::xsdsql::generator::sql::generic::handle
=cut
=head1 DESCRIPTION
this package is a class - instance it with the method new
=head1 EXPORT
None by default.
=head1 EXPORT_OK
None
=head1 SEE ALSO
See blx:.xsdsql::generator for generate the schema of the database
=head1 AUTHOR
lorenzo.bellotti, E<lt>pauseblx@gmail.comE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2010 by lorenzo.bellotti
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
See http://www.perl.com/perl/misc/Artistic.html
=cut