user.pm

普通的ETL工具

	}
	sub from_hash
	{
		my $self = shift;
		my $filename = shift || do {
			$self->config()->prefix() 
			. '/' 
			. (split(/[\/]+/, $self->script_filename()))[-1]
			. ".dump"
		};
		open(HASH, "$filename");
		local $/=undef;
		my $hash = eval("my " . <HASH>);
		confess "Error in eval -- $@" if ($@);
		close(HASH);
		$self->hash2pequel($hash);
		$self->err()->diag(1, "<--HASH load read from $filename");
	}
	sub mk_filename #???
	{
		my $self = shift;
		my $suffix = shift;
		my $filename = shift || do {
			$self->config()->prefix() 
			. '/' 
			. (split(/[\/]+/, $self->script_filename()))[-1]
			. ".$suffix"
		};
		$filename = $self->config()->prefix() . '/' . $filename
		if (defined($self->config()->prefix()) && $filename !~ /^\// && $filename !~ /^\.\//);

		return $filename;
	}
	sub makefilepath
	{
		my $self = shift;
		my $filename = shift;
#>		my $suffix = shift; #--replace suffix in $filename with this;
#>		TODO:use $self-os()->getpath(...)
		return $filename if ($filename =~ /^\// || $filename =~ /^\.\//);

		return $self->config()->prefix() . '/' . $filename
		if (defined($self->config()) 
			&& defined($self->config()->prefix()) && $self->config()->prefix() ne '');

		return $self->properties()->prefix() . '/' . $filename
		if (defined($self->properties()) 
			&& defined($self->properties()->prefix()) && $self->properties()->prefix() ne '');

		return $filename;
	}
	sub check
	{
		my $self = shift;
		return $self->generator()->user_prog()->syntax_check();
	}
	sub display_code
	{
		# Display generated code to STDOUT with line numbers;
		my $self = shift;
		print $self->generator()->user_prog()->display();
	}
	sub dump_code
	{
		# Save generated code to file;
		my $self = shift;
		my $filename = shift;
		$self->generator()->user_prog()->save($filename);
	}
	sub xsdgen
	{
		my $self = shift;
		$self->xml_schema()->generate();
		my $filename = $self->xml_schema()->writefile(@_);
		$self->err()->diag(1, "-->Pequel xml-schema saved in $filename");
		return $filename;
	}
	sub docgen
	{
		my $self = shift;
		$self->section('configuration')->select()
			->add_item(property_name => 'tab_size', value => 3)
			->add_item(property_name => 'tab_type', value => 'spaces');
		$self->produce();
		use ETL::Pequel3::DocGen;
		$self->doc(ETL::Pequel3::DocGen::MainProgram->new(
			POM => $self, 
			doc_filename => ( (split(/[\/]+/, $self->script_filename()))[-1] . ".pod" ),
			doc_type => (
				$self->pequel_name() eq 'main' 
					? (split(/[\/]+/, $self->script_filename()))[-1]
					: $self->pequel_name()
				),
			doc_version => $self->config()->script_version(),
			doc_email => $self->properties()->pequel_home_page(),
			doc_author => $self->config()->script_author(),
			@_,
		));
		$self->err()->diag(1, "[@{[ $self->pequel_name() ]}] docgen...");
		$self->doc()->build();
		$self->err()->diag(1, "-->User Script Reference document POD saved in @{[ 
			$self->doc()->user_prog()->program_name() ]}");
		my $filename = $self->doc()->make_pdf();
		$self->err()->diag(1, "-->User Script Reference document PDF saved in $filename");
		return $self;
	}
	sub catgen
	{
		my $self = shift;
		eval("use ETL::Pequel3::Extension::DataSet::Apache");
		eval("use ETL::Pequel3::Extension::DataSet::CSV");
		use ETL::Pequel3::CatGen;
		$self->cat(ETL::Pequel3::CatGen::MainProgram->new(POM => $self, @_));
		$self->cat()->build();
		my $filename = $self->cat()->make_pdf();
		$self->err()->diag(1, "-->Pequel Type Catalogue document PDF saved in $filename");
		return $self;
	}
	sub eval
	{
		my $self = shift;
		$self->generator()->user_prog()->eval();
	}
	sub exec
	{
		my $self = shift;
		$self->generator()->user_prog()->exec();
	}
	sub execute
	{
		my $self = shift;
		$self->generator()->user_prog()->run();
	}
	sub spawn #TODO
	{
		my $self = shift;
		# execute in background as detached process...
	}
	sub produce 
	{
		my $self = shift;
		#TODO: need to be able to call multiple times;
#		return if (defined($self->generator()));
#< 		$self->getopt()->prep_options($self);
		$self->err()->diag(1, "[@{[ $self->pequel_name() ]}] produce...");
		$self->_prepare();
		$self->_parse();
		use ETL::Pequel3::Generator;
		$self->generator($self->catalogue()->generators()->exists($self->generator_type())
			->new(main => $self));
		$self->generator()->build();
		$self->getopt()->exec_options($self);
		return $self;
	}
	sub _prepare # recursive
	{
		my $self = shift;

		#NOTE: do NOT try to de-duplicate here -- won't work!
		map($_->_prepare(), $self->user_pequels()->to_array()); # recurse

		$self->config($self->user_sections()->configuration()->select()->config());
		$self->getopt()->copy_config($self->config());
		$self->user_joins($self->user_sections()->input_join());
		$self->user_tables(ETL::Pequel3::Type::Table::Factory::Global->new()); # Singleton
		$self->shared_datasets(ETL::Pequel3::Type::DataSet::UserShared::Global->new()); # Singleton
		$self->user_sections()->input()->select();
		$self->user_sections()->output()->select();

#>		$self->err()->display_dot_begin("[@{[ $self->pequel_name() ]}] prepare ...");
		$self->err()->diag(1, "[@{[ $self->pequel_name() ]}] prepare...");
		map
		(
			do 
			{ 
				$self->err()->diag(20, "...@{[ $_->section_name() ]}..." );
				$_->prepare();
			}, 
			map($_->to_array(), $self->user_sections()->to_array())
		);
	}
	sub _parse # recursive
	{
		my $self = shift;
		#TODO: remove the 1st:
		map($_->_parse(), grep($_->duplicate() == 0, $self->user_pequels()->to_array())); # recurse
#?		map($_->_parse(), $self->user_pequels()->to_array()); # recurse
		$self->parser(ETL::Pequel3::Parser->new(
			user_joins => $self->user_joins(),
			pequel_ref  => $self,
			macro_use_list => $self->macro_use_list(),
		));
		$self->parser_input(ETL::Pequel3::Parser->new(
			user_joins => $self->user_joins(),
			pequel_ref  => $self,
			macro_use_list => $self->macro_use_list(),
			translate_fields => ETL::Pequel3::Parser::TranslateFields::Input->new(
				input_fields => $self->input()->input_fields())
		));
		$self->parser_output(ETL::Pequel3::Parser->new(
			user_joins => $self->user_joins(),
			pequel_ref  => $self,
			macro_use_list => $self->macro_use_list(),
			translate_fields => ETL::Pequel3::Parser::TranslateFields::Output->new(
				input_fields => $self->input()->input_fields(), 
				output_fields => $self->output()->output_fields())
		));
		$self->err()->diag(1, "[@{[ $self->pequel_name() ]}] parse..."); 
		map
		(
			do 
			{ 
				$self->err()->diag(20, "...(section)@{[ $_->section_name() ]}...");
				$_->parse();
			}, 
			map($_->to_array(), $self->user_sections()->to_array())
		);
		map
		(
			do 
			{ 
				$self->err()->diag(20, "...(dataset)@{[ $_->name() ]}:@{[ 
					$_->datasource()->target_name() ]}...");
				$_->parse();
			}, 
			$self->user_datasets()->to_array()
#<			grep
#<			(
#<				defined($_),
#<				(
#<					map
#<					(
#<						$_->input_dataset(), 
#<						(
#<							$self->user_sections()->input()->to_array(),
#<							$self->user_sections()->input_join()->to_array(),
#<							grep ($_->can('input_dataset'), $self->user_tables()->to_array()),
#<						)
#<					),
#<					map
#<					(
#<						$_->output_dataset(), 
#<						(
#<							$self->user_sections()->output()->to_array(),
#<							$self->user_sections()->copy_record_on_input()->to_array(),
#<							$self->user_sections()->copy_record_on_output()->to_array(),
#<							$self->user_sections()->divert_record_on_input()->to_array(),
#<							$self->user_sections()->divert_record_on_output()->to_array(),
#<						)
#<					),
#<					map
#<					(
#<						$_->dataset(), #-->output_dataset
#<						(
#<							$self->user_sections()->reject_record_on_input()->to_array(),
#<							$self->user_sections()->reject_record_on_output()->to_array(),
#<						)
#<					),
#<					map
#<					(
#<						$_->transfer_dataset(), 
#<						(
#<							$self->user_sections()->output()->to_array(),
#<							$self->user_sections()->input_join()->to_array(),
#<						)
#<					)
#<				)
#<			)
		);
#<		map
#<		(
#<			$self->err()->diag(15, "Dataset:@{[ $_->datasource()->target_name() ]}"),
#<			$self->user_datasets()->to_array()
#<		);
	}
	sub output_interface # ??? remove
	{
		my $self = shift;
		return
		grep
		(
			$_->name() !~ /^_/,
			(
				$self->output()->transfer_fields()->to_array(),
				$self->output()->output_fields()->to_array() 
			)
		);
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::User::Find;
	use base qw(Class::STL::Utilities::FunctionObject::UnaryFunction);
	use Class::STL::ClassMembers qw( pequel_name );
	use Class::STL::ClassMembers::Constructor;
	sub function_operator
	{
		my $self = shift;
		my $arg = shift; # element object
		return $arg->pequel_name() eq $self->pequel_name() ? $arg : 0;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::User::TableLoader;
	use base qw(ETL::Pequel3::User);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'generator_type', default => 'table_loader');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::User::SubProgram;
	use base qw(ETL::Pequel3::User);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'generator_type', default => 'sub_program');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
1;