docgen.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::DocGen.pm
#  Created	: 21 September 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::DocGen;
require 5.005_62;
use strict;
use warnings;
use stl;
use ETL::Pequel3::Type::Document;
# ----------------------------------------------------------------------------------------------------
# DOCUMENT TYPE
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::DocGen::MainProgram; 
	use base qw(ETL::Pequel3::Type::Document::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'doc_title', default => 'Pequel User Script Reference'),
		Class::STL::ClassMembers::DataMember->new(name => 'document_name', default => 'user_script_ref');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->err()->user_error(10801, "Class @{[ __PACKAGE__ ]}::main is undefined!")
			unless (defined($self->POM()));
		$self->err()->user_error(10800, "Class @{[ __PACKAGE__ ]}::main->config is undefined!")
			unless (defined($self->POM()->config()));
		my $major = 1;
		$self->chapters()->add
		(
			$self->catalogue()->doc_chapters()->_pequel_name->new(
				major => $major,
				chapter_name => $self->POM()->pequel_name()
			),
			$self->catalogue()->doc_chapters()->input()->new(major => $major,
				chapter_name_sub => $self->POM()->pequel_name()
			),
			$self->catalogue()->doc_chapters()->output()->new(major => $major,
				chapter_name_sub => $self->POM()->pequel_name()
			),
			map
			(
				$self->catalogue()->doc_chapters()->_table()->new(
						major => $major,
						table_ref => $_,
						chapter_name => "table_@{[ $_->name() ]}", 
				),
				sort {$a->name() cmp $b->name()} $self->POM()->user_tables()->to_array()
			),
			$self->catalogue()->doc_chapters()->pequel_script()->new(major => $major,
				chapter_name_sub => $self->POM()->pequel_name()
			),
			$self->catalogue()->doc_chapters()->sub_pequels()->new(major => $major),
			$self->catalogue()->doc_chapters()->pequel_generated()->new(major => $major),
		);
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::DocGen::SubProgram; 
	use base qw(ETL::Pequel3::Type::Document::Abstract);
	use Class::STL::ClassMembers qw( major ),
		Class::STL::ClassMembers::DataMember->new(name => 'document_name', default => 'sub_program');
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->chapters()->add
		(
			$self->catalogue()->doc_chapters()->_pequel_name->new(
				major => $self->major(),
				chapter_name => $self->POM()->pequel_name()
			),
			$self->catalogue()->doc_chapters()->input()->new(major => $self->major(),
				chapter_name_sub => $self->POM()->pequel_name()
			),
			$self->catalogue()->doc_chapters()->output()->new(major => $self->major(),
				chapter_name_sub => $self->POM()->pequel_name()
			),
			$self->catalogue()->doc_chapters()->pequel_script()->new(major => $self->major(),
				chapter_name_sub => $self->POM()->pequel_name()
			),
#<			$self->catalogue()->doc_chapters()->sub_pequels()->new(major => $self->major()),
		);
		return $self;
	}
}
# ----------------------------------------------------------------------------------------------------
# CHAPTER TYPE
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::DocGen::Chapter::SubPequels; 
	use base qw(ETL::Pequel3::Type::Document::Chapter::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'chapter_name', default => 'sub_pequels'),
		Class::STL::ClassMembers::DataMember->new(name => 'hidden', default => 1);
	use Class::STL::ClassMembers::Constructor; 
	sub prepare
	{
		my $self = shift;
		my $major = $self->major();
#<		foreach (grep($_->duplicate() == 0, $self->POM()->user_pequels()->to_array())) 

		#NOTE: need to do this once from root in order for major number to sequence correctly;
		foreach ($self->POM()->all_pequels()->to_array()) 
		{
			my $sub = ETL::Pequel3::DocGen::SubProgram->new(
				POM => $_, 
				major => ++$major,
				doc_filename => $self->doc_ref()->doc_filename(),
				doc_type =>$self->doc_ref()->doc_type(), 
				doc_version => $self->doc_ref()->doc_version(),
				doc_email => $self->doc_ref()->doc_email(),
				doc_author => $self->doc_ref()->doc_author(),
				show_copyright => 0,
			);
			$sub->build();
			$self->user_prog()->add($sub->user_prog());
		}
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::DocGen::Chapter::PequelName; 
	use base qw(ETL::Pequel3::Type::Document::Chapter::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'chapter_name', default => '_pequel_name');
	use Class::STL::ClassMembers::Constructor; 
	sub input_dataset_tree # recursive
	{
		my $self = shift;
		my $dataset = shift;
		my $name = shift;
		$self->user_prog()->code("E<lt> F<$name> (@{[ $dataset->name() ]})") if (defined($name)); 
		$self->user_prog()->over();
			$self->user_prog()->code("E<lt> @{[ 
				$dataset->datasource()->target_name() 
			]} (@{[
				$dataset->datasource()->datasource_name() 
			]}) @{[
				$dataset->shared() ? ' -- B<shared>' : ''
			]}");
			$self->input_dataset_tree(
				$dataset->pequel_ref()->exists($dataset->datasource()->target_name())
					->input()->input_dataset()
			)
			if ($dataset->datasource()->datasource_name() eq 'pequel');
		$self->user_prog()->back();
		$self->user_prog()->code();
	}
	sub output_dataset_tree # recursive
	{
		my $self = shift;
		my $dataset = shift;
		my $name = shift;
		$self->user_prog()->code("E<gt> F<$name> (@{[ $dataset->name() ]})") if (defined($name)); 
		$self->user_prog()->over();
			$self->user_prog()->code("E<gt> @{[ 
				$dataset->datasource()->target_name() 
			]} (@{[
				$dataset->datasource()->datasource_name() 
			]}) @{[
				$dataset->shared() ? ' -- B<shared>' : ''
			]}");
			$self->output_dataset_tree(
				$dataset->pequel_ref()->exists($dataset->datasource()->target_name())
					->output()->output_dataset()
			)
			if ($dataset->datasource()->datasource_name() eq 'pequel');
		$self->user_prog()->back();
		$self->user_prog()->code();
	}
	sub prepare
	{
		my $self = shift;
		$self->user_prog()->code("pequel_name: B<@{[ $self->POM()->pequel_name() ]}>");
		$self->user_prog()->code();
		$self->user_prog()->code();
		# Description
		$self->user_prog()->head2("Description");
		foreach 
		(
			map
			(
				$_->items()->to_array(), 
				$self->POM()->user_sections()->description()->to_array()
			)
		)
		{
			if (defined($_->header_text())) {
				$self->user_prog()->code("B<@{[ $_->header_text() ]}>");
				$self->user_prog()->code();
			}
			next unless (defined($_->body_text()));
			$self->user_prog()->code("@{[ $_->body_text() ]}");
			$self->user_prog()->code();
			$self->user_prog()->code();
			$self->user_prog()->code();
		}
		# Data Flow Summary
		$self->user_prog()->head2("Data Flow Summary");
		$self->input_dataset_tree($self->POM()->input()->input_dataset(), 'input');
		map
		(
			$self->input_dataset_tree($_->input_dataset(), 'input_join'),
			$self->POM()->user_sections()->input_join()->to_array()
		);
		map
		(
			$self->output_dataset_tree($_->output_dataset(), 'copy_record_on_input'),
			$self->POM()->user_sections()->copy_record_on_input()->to_array()
		);
		map
		(
			$self->output_dataset_tree($_->output_dataset(), 'copy_record_on_output'),
			$self->POM()->user_sections()->divert_record_on_output()->to_array()
		);
		map
		(
			$self->output_dataset_tree($_->output_dataset(), 'divert_record_on_input'),
			$self->POM()->user_sections()->divert_record_on_input()->to_array()
		);
		map
		(
			$self->output_dataset_tree($_->output_dataset(), 'divert_record_on_output'),
			$self->POM()->user_sections()->divert_record_on_output()->to_array()
		);
		map
		(
			$self->output_dataset_tree($_->dataset(), 'reject_record_on_input'),
			$self->POM()->user_sections()->reject_record_on_input()->to_array()
		);
		map
		(
			$self->output_dataset_tree($_->dataset(), 'reject_record_on_output'),
			$self->POM()->user_sections()->reject_record_on_output()->to_array()
		);
		$self->output_dataset_tree($self->POM()->output()->output_dataset(), 'output');
		map
		(
			do {
				if ($_->can('input_dataset')) {
					$self->input_dataset_tree($_->input_dataset(), "table @{[ $_->name() ]}")
				} else {
					$self->user_prog()->code("E<lt> table @{[ $_->name() ]}");
					$self->user_prog()->over();
						$self->user_prog()->code("E<lt> I<local>");
					$self->user_prog()->back();
				}
			},
			sort {$a->name() cmp $b->name()} $self->POM()->user_tables()->to_array()
		);

		# Build Information
		$self->user_prog()->head2("Build Information");
		$self->user_prog()->code("Perl Version: F<@{[ $^X . ' ' . sprintf(qq{%vd}, $^V) ]}>");
		$self->user_prog()->code();
		$self->user_prog()->code("Platform: F<@{[ $^O ]}>");
		$self->user_prog()->code();
		$self->user_prog()->code("Pequel Version: F<3.@{[ $self->properties()->version() ]}>");
		$self->user_prog()->code();
		$self->user_prog()->code("Date Created: F<@{[ '' . localtime() ]}>");
		$self->user_prog()->code();
		$self->user_prog()->code("User ID: F<@{[ getlogin() ]}>");
		$self->user_prog()->code();

		# Configuration
		#TODO: should be a table display (using Docbook)
		$self->user_prog()->head2("Configuration");
		foreach 
		(
			grep
			(
				$_->user_program_info() != 0 && defined($_->value()),
					grep($_->global(), $self->properties()->to_array()), 
					$self->POM()->config()->to_array()
			)
		) 
		{
			$self->user_prog()->code("@{[ 
					$_->name() 
				]} -- B<@{[ 
					($_->value() =~ /^(0|1)$/ ? ($_->value() == 0 ? 'NO' : 'YES') : $_->value()) 
				]}> -- I<@{[ 
					$_->description() . ($_->global() ? ' -- I<global>' : '') 
				]}>");
			$self->user_prog()->code();
		}
		$self->user_prog()->code();
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::DocGen::Chapter::PequelScript;
	use base qw(ETL::Pequel3::Type::Document::Chapter::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'chapter_name', default => 'pequel_script');
	use Class::STL::ClassMembers::Constructor; 
	sub prepare
	{
		my $self = shift;
		foreach my $s (map($_->to_array(), $self->POM()->user_sections()->to_array()))
		{
			next if ($s->section_name() eq 'description');
			$self->user_prog()->head2(
				do {
					my $n=$s->section_name();
					$n=~s/[\W_]+/ /g; 
					$n=~s/((^\w)|(\s\w))/\U$1/g; 
					$n=~s/([\w]+)/\u\L$1/g; 
					$n=~s/^\s+//;
					$n;
				}
			);
			if (grep(defined($_->value()), $s->attributes()->to_array()))
			{
				$self->user_prog()->code("F<Properties>");
				$self->user_prog()->code() if ($self->doc_ref()->target_fmt() ne 'pdf');
				$self->user_prog()->over();
				foreach my $p (grep(defined($_->value()), $s->attributes()->to_array()))