The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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