generator.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::Generator.pm
#  Created	: 19 May 2006
#  Author	: Mario Gaffiero (gaffie)
#
# Copyright 1999-2007 Mario Gaffiero.
# 
# This file is part of Pequel(TM).
# 
# Pequel is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; version 2 of the License.
# 
# Pequel is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with Pequel; if not, write to the Free Software
# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
# ----------------------------------------------------------------------------------------------------
# Modification History
# When          Version     Who     What
# ----------------------------------------------------------------------------------------------------
package ETL::Pequel3::Generator;
require 5.005_62;
use strict;
use warnings;
# ----------------------------------------------------------------------------------------------------
# GENERATOR TYPE
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::Abstract; 
	use base qw(Class::STL::Element);
	use stl qw(list);
	use Class::STL::ClassMembers qw( err catalogue properties generator_name main segments user_prog caller_id ),
		Class::STL::ClassMembers::DataMember->new(name => 'show_info', default => 1);
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		use ETL::Pequel3::Error;
		$self->err(ETL::Pequel3::Error->new());
		use ETL::Pequel3::Type::Properties;
		$self->properties(ETL::Pequel3::Type::Properties->new());
		use ETL::Pequel3::Catalogue;
		$self->catalogue(ETL::Pequel3::Catalogue->new());

		$self->segments(list(element_type => 'ETL::Pequel3::Generator::Segment::Abstract'));
		$self->err()->user_error(10501, "Attribute @{[ ref($self) ]}::main is undefined!")
			unless (defined($self->main()));
		$self->err()->user_error(10500, "Attribute @{[ ref($self) ]}::main->config is undefined!")
			unless (defined($self->main()->config()));
		$self->caller_id(do { my $n=$self->main()->pequel_name();$n=~s/\W+/_/g;$n }); #???

		use ETL::Pequel3::CodeStyler;
		$self->user_prog(ETL::Pequel3::CodeStyler::Program::Perl->new(
			@_, # contains 'main', other
			program_name => 
			(
				$self->properties()->exec_dir() 
				. '/' 
				. (split(/[\/]+/, $self->main()->script_filename()))[-1]
				. ".code"
			),
			print_bookmarks => $self->err()->trace_level() >= 5,
			tab_size => $self->main()->config()->tab_size(),
			tab_type => $self->main()->config()->tab_type(),
			divider_char => $self->main()->config()->divider_char(),
			divider_length => $self->main()->config()->divider_length(),
		))
		unless (defined($self->user_prog()));
		return $self;
	}
	sub build
	{
		my $self = shift;
		$self->err()->diag(1, "[@{[ $self->main()->pequel_name() ]}] generate...");
		map($_->prepare(), $self->segments()->to_array());
		$self->user_prog()->prepare();
#>		TODO:use $self-os()->getpath(...)
		mkdir("@{[ $self->properties()->exec_dir() ]}");
		$self->user_prog()->save() if ($self->err()->trace_level() >= 5);
		$self->err->trace_msg(10, "\n++++++\n@{[ $self->user_prog()->display() ]}\n+++++\n");
	}
	sub exec
	{
		my $self = shift;
		$self->user_prog()->run();
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::MainProgram; 
	use base qw(ETL::Pequel3::Generator::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'generator_name', default => 'main_program');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->segments()->push_back(
			$self->catalogue()->code_segments()->startup()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->user_options()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->init_global()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->open_global()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->call_load_table()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->call_execute()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->close_global()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->divider()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->main_package()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->load_table()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->sub_programs()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->end_of_program()->new(@_, user_prog => $self->user_prog() ),
		);
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::SubProgram; 
	use base qw(ETL::Pequel3::Generator::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'generator_name', default => 'sub_program');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->segments()->push_back(
			$self->catalogue()->code_segments()->main_package()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->sub_programs()->new(@_, user_prog => $self->user_prog() ),
		);
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::TableLoader; 
	use base qw(ETL::Pequel3::Generator::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'generator_name', default => 'table_loader');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->segments()->push_back(
			$self->catalogue()->code_segments()->startup()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->user_options()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->header_info()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->load_table()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->sub_programs()->new(@_, user_prog => $self->user_prog() ),
			$self->catalogue()->code_segments()->end_of_program()->new(@_, user_prog => $self->user_prog() ),
		);
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
# GENERATOR TYPE CATALOGUE
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::Catalogue;
	use base qw(ETL::Pequel3::Type::Catalogue);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'catalogue_name', default => 'generators'),
		Class::STL::ClassMembers::DataMember->new(name => 'target_mem_name', default => 'generator_name'),
		Class::STL::ClassMembers::DataMember->new(name => 'element_type', default => 'ETL::Pequel3::Generator::Abstract');
	use Class::STL::ClassMembers::SingletonConstructor;
	sub new_extra
	{
		my $self = shift;
		$self->push_back(
			ETL::Pequel3::Generator::MainProgram->_new(),
			ETL::Pequel3::Generator::SubProgram->_new(),
			ETL::Pequel3::Generator::TableLoader->_new(),
		);
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
# SEGMENT TYPE
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::Segment::Abstract; 
	use base qw(Class::STL::Element);
	use Class::STL::ClassMembers 
		qw( err properties catalogue package_name user_prog main segment_name segments ),
		Class::STL::ClassMembers::DataMember->new(name => 'show_info', default => 1);
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		use ETL::Pequel3::Error;
		$self->err(ETL::Pequel3::Error->new()); # Singleton
		use ETL::Pequel3::Type::Properties;
		$self->properties(ETL::Pequel3::Type::Properties->new()); # Singleton
		use ETL::Pequel3::Catalogue;
		$self->catalogue(ETL::Pequel3::Catalogue->new());

		$self->err()->user_error(10502, "Class @{[ ref($self) ]}::user_prog is undefined!")
			unless (defined($self->user_prog()));
		use stl qw(list);
		$self->segments(list(element_type => 'ETL::Pequel3::Generator::Segment::Abstract'));
		$self->package_name("Pequel::@{[ do { my $n=$self->main()->pequel_name();$n=~s/\W+/_/g;$n } ]}")
			unless (defined($self->package_name()) || !defined($self->main()));
	}
	sub program_info
	{
		my $self = shift;
		my $extra = shift;
		return unless ($self->show_info());
		$self->user_prog()->comment("");
		$self->user_prog()->comment(" ++++ @{[ join(' ', map(ucfirst($_), split(/_/, $self->segment_name()))) ]}@{[ defined($extra) ? qq/ ($extra)/ : '' ]} Segment ++++");
		$self->user_prog()->comment("");
	}
	sub prepare_start
	{
		my $self = shift;
		$self->err()->diag(20, "...@{[ $_->segment_name() ]}...");
		map($_->prepare_start(), $self->segments()->to_array());
	}
	sub prepare_finish
	{
		my $self = shift;
		map($_->prepare_finish(), CORE::reverse($self->segments()->to_array()));
	}
	sub prepare
	{
		my $self = shift;
		$self->prepare_start();
		$self->prepare_finish();
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::Segment::SubPrograms; 
	use base qw(ETL::Pequel3::Generator::Segment::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'segment_name', default => 'sub_programs');
	use Class::STL::ClassMembers::Constructor; 
	sub prepare
	{
		my $self = shift;
		$self->program_info();
#?		foreach ($self->main()->all_pequels()->to_array()) {
		foreach (grep($_->duplicate() == 0, $self->main()->user_pequels()->to_array())) {
			my $sub = ETL::Pequel3::Generator::SubProgram->new(main => $_);
			$sub->build();
			$self->user_prog()->add($sub->user_prog());
		}
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::Segment::MainPackage; 
	use base qw(ETL::Pequel3::Generator::Segment::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'segment_name', default => 'main_package');
	use Class::STL::ClassMembers::Constructor; 
	sub new_extra
	{
		my $self = shift;
		$self->segments()->push_back(
			$self->catalogue()->code_segments()->package()->new(@_),
			$self->catalogue()->code_segments()->header_info()->new(@_),
			$self->catalogue()->code_segments()->sub_execute_body()->new(@_),
		);
	}
}
# ----------------------------------------------------------------------------------------------------
{	
	package ETL::Pequel3::Generator::Segment::SubExecuteBody; 
	use base qw(ETL::Pequel3::Generator::Segment::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'segment_name', default => 'sub_execute_body');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->segments()->push_back(
			$self->catalogue()->code_segments()->sub_execute_def()->new(@_),
			$self->catalogue()->code_segments()->declaration()->new(@_),
			$self->catalogue()->code_segments()->init_local()->new(@_),
			$self->catalogue()->code_segments()->open_local()->new(@_),
			$self->catalogue()->code_segments()->finish()->new(@_),
			$self->catalogue()->code_segments()->main()->new(@_),
		);
	}
}	
# ----------------------------------------------------------------------------------------------------
{	
	package ETL::Pequel3::Generator::Segment::SubExecuteDef; 
	use base qw(ETL::Pequel3::Generator::Segment::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'segment_name', default => 'sub_execute_def');
	use Class::STL::ClassMembers::Constructor;
	sub prepare_start
	{
		my $self = shift;
		$self->user_prog()->code("sub execute");
		$self->user_prog()->open_block();
	}
	sub prepare_finish
	{
		my $self = shift;
		$self->user_prog()->close_block();
	}
}	
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Generator::Segment::Startup; 
	use base qw(ETL::Pequel3::Generator::Segment::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'segment_name', default => 'startup');
	use Class::STL::ClassMembers::Constructor; 
	sub prepare_start
	{
		my $self = shift;
		$self->user_prog()->indent_off();
		$self->user_prog()->comment("!$^X");
		$self->user_prog()->indent_on();