section.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::Type::Section.pm
#  Created	: 22 June 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::Type::Section;
require 5.005_62;
use strict;
use warnings;
# ----------------------------------------------------------------------------------------------------
{	
	package ETL::Pequel3::Type::Attributes::Abstract;
	use base qw(ETL::Pequel3::Type::Catalogue);
	use Class::STL::ClassMembers qw( err catalogue ),
		Class::STL::ClassMembers::DataMember->new(name => 'target_mem_name', default => 'name'),
		Class::STL::ClassMembers::DataMember->new(name => 'element_type', default => 'ETL::Pequel3::Type::Properties::Abstract');
	use Class::STL::ClassMembers::Constructor;
	use vars qw( $AUTOLOAD );
	sub AUTOLOAD
	{
		my $self = shift;
		(my $attr = $AUTOLOAD) =~ s/.*:://;
		my $p;
		$self->err()->user_error(10201, "Unknown attribute name '$attr'!")
			unless ($p = $self->exists($attr));
		return $p->value(@_);
	}
	sub DESTROY { }
	sub new_extra
	{
		my $self = shift;
		$self->err(ETL::Pequel3::Error->new());
		$self->catalogue(ETL::Pequel3::Catalogue->new());
	}
	sub set
	{
		my $self = shift;
		my %p = @_;
		map($_->value($_->default()), grep(defined($_->default()), $self->to_array()));
		map($_->value($p{$_->name()}), grep(exists($p{$_->name()}), $self->to_array()));
		foreach (grep($_->required(), $self->to_array())) {
			$self->err()->user_error(10202, "Required item attribute '@{[ $_->name() ]}' not specified!")
				unless (exists($p{$_->name()}));
		}
		foreach (grep(defined($_->validate_catalogue()), $self->to_array())) 
		{
			$self->err()->user_error(10203, "Catalogue '@{[ 
				$_->validate_catalogue() ]}' does not exist!")
				unless (ref $self->catalogue()->exists($_->validate_catalogue()));
			$self->err()->user_error(10203, "Attribute '@{[ 
				$_->name() ]}' value '@{[ $_->value() 
				]}' does not exist in catalogue '@{[ $_->validate_catalogue() ]}'!")
				if (defined($_->value()) 
					&& !$self->catalogue()->exists($_->validate_catalogue())->exists($_->value()));
		}
		foreach (grep(defined($_->validate()), $self->to_array())) 
		{
			$self->err()->user_error(10203, "Attribute '@{[ 
				$_->name() ]}' value '@{[ $_->value() ]}' failed validation '@{[ $_->validate() ]}'!")
				if (defined($_->value()) && $_->value() !~ /@{[ $_->validate() ]}/);
		}
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Section::Item::Abstract;
	use base qw(Class::STL::Element);
	use Class::STL::ClassMembers qw( err attributes pequel_ref );
	use Class::STL::ClassMembers::Constructor;
	use vars qw( $AUTOLOAD );
	sub AUTOLOAD
	{
		my $self = shift;
		(my $attr = $AUTOLOAD) =~ s/.*:://;
		my $p;
		$self->err()->user_error(10204, "Unknown attribute name '$attr'!")
			unless ($p = $self->attributes()->exists($attr));
		return $p->value(@_);
	}
	sub DESTROY { }
	sub new_extra
	{
		my $self = shift;
		$self->err(ETL::Pequel3::Error->new());
		$self->attributes(ETL::Pequel3::Type::Attributes::Abstract->new());
	}
	sub xml_schema
	{
		my $self = shift;
		my $xsd = shift;
		my $xs_node = shift;
		#<xs:element name="item"...
		my $items = $xsd->xs_element($xs_node,
			name => "item",
			minOccurs => "0", #TODO  more here?
			maxOccurs => "unbounded"
		);
			#<xs:complexType
				#<xs:sequence
		my $items_sequence = $xsd->xs_sequence($xsd->xs_complexType($items));
		foreach my $item_att ($self->attributes()->to_array()) 
		{
					#<xs:element
			my $item_element = $xsd->xs_element($items_sequence, 
				'ref', $item_att->name(),
				(do{ $item_att->required() ? () : ('minOccurs' => "0"); })
			);
					#</xs:element
			$item_att->xml_schema($xsd); # attach property definition to root node;
		}
				#</xs:sequence
			#</xs:complexType
		#</xs:element -- item
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Section::Item::CondExp;
	use base qw(ETL::Pequel3::Type::Section::Item::Abstract);
	use Class::STL::ClassMembers;
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->attributes()->push_back(
			$self->attributes()->factory(name => 'condition_exp', required => 1),
		);
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Section::Item::RepeatExp; # TODO: not used???
	use base qw(ETL::Pequel3::Type::Section::Item::Abstract);
	use Class::STL::ClassMembers;
	use Class::STL::ClassMembers::Constructor;
	sub new_extra
	{
		my $self = shift;
		$self->attributes()->push_back(
			$self->attributes()->factory(name => 'repeat_exp', required => 1),
		);
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Section::Abstract;
	use base qw(ETL::Pequel3::Type::Catalogue);
	use Class::STL::ClassMembers 
		qw( 
			err
			section_name 
			items 
			attributes
			user_notes 
			pequel_ref
			description
		),
		Class::STL::ClassMembers::DataMember->new(name => 'required', default => 0),
		Class::STL::ClassMembers::DataMember->new(name => 'target_mem_name', default => 'section_name'),
		Class::STL::ClassMembers::DataMember->new(name => 'item_type', default => 'ETL::Pequel3::Type::Section::Item::Abstract'),
		Class::STL::ClassMembers::DataMember->new(name => 'element_type', default => "@{[ __PACKAGE__ ]}");
	use Class::STL::ClassMembers::Constructor;
	use vars qw( $AUTOLOAD );
	sub AUTOLOAD
	{
		my $self = shift;
		(my $attr = $AUTOLOAD) =~ s/.*:://;
		my $p;
		$self->err()->user_error(10205, 
			"Unknown attribute name '$attr' for section '@{[ $self->section_name() ]}'!")
			unless ($p = $self->attributes()->exists($attr));
		return $p->value(@_);
	}
	sub DESTROY { }
	sub new_extra
	{
		my $self = shift;
		$self->err(ETL::Pequel3::Error->new());
		$self->items(stl::deque(element_type => $self->item_type()))
			unless (defined($self->items())); #? && !defined($self->user()));
		$self->user_notes(stl::list());
		$self->attributes(ETL::Pequel3::Type::Attributes::Abstract->new());
		return $self;
	}
	sub construction_type
	{
		my $self = shift;
		return $self->attributes()->exists('on')
			? ($self->target_mem_name() eq 'section_name')
				? 'Input/Output'
				: "Input/Output Multi Target (I<@{[ $self->target_mem_name() ]}>)"
			: ($self->target_mem_name() eq 'section_name')
				? 'Single'
				: "Multi Target (I<@{[ $self->target_mem_name() ]}>)"
	}
	sub add
	{
		my $self = shift;
		$self->push_back($self->factory(pequel_ref => $self->pequel_ref(), @_));
		$self->err()->diag(15, "[@{[ $self->pequel_ref()->pequel_name() ]}] @{[ $self->section_name() ]}..."); 
	}
	sub add_item
	{
		my $self = shift;
		my %p = @_;
		my $p;
		$self->items()->push_back($self->items()->factory(pequel_ref => $self->pequel_ref(), @_));
		$self->items()->back()->attributes()->set(@_);
		$self->err()->diag(20, "[@{[ $self->pequel_ref()->pequel_name() ]}] @{[ 
			$self->section_name() ]}->item...");
		return $self; # chain add_item() calls
	}
	sub property
	{
		my $self = shift;
		return $self->attributes(@_);
	}
	sub prepare
	{
		my $self = shift;
	}
	sub parse
	{
		my $self = shift;
	}
	sub select
	{
		my $self = shift;
		if (!$self->size()) {
			$self->add(@_);
			$self->back()->attributes()->set(@_);
		}
		return $self->back();
	}
	sub xml_schema
	{
		my $self = shift;
		my $xsd = shift;
		my $xs_node = shift || $xsd->schema_root();
		#<xs:element
		$xsd->comment($xs_node, "Section Type: @{[ $self->section_name() ]} [@{[ ref($self) ]}]");
		$xsd->comment($xs_node, "Description: @{[ do{my $d = $self->description(); $d=~s/\-+/-/g; $d; } ]}") 
			if (defined($self->description()));
		my $root_element = $xsd->xs_element($xs_node, name => $self->section_name());
			#<xs:complexType
				#<xs:sequence
		my $sequence = $xsd->xs_sequence($xsd->xs_complexType($root_element));
					#<xs:sequence
		my $sequence_2 = $xsd->xs_sequence($sequence) if ($self->attributes()->size());
		foreach my $att ($self->attributes()->to_array()) 
		{
						#<xs:element
			my $xml_att = $xsd->xs_element($sequence_2, 
				'ref', $att->name(),
				(do{ $att->required() ? () : (minOccurs => "0"); })
			);
						#</xs:element
			$att->xml_schema($xsd); # attach property definition to root node;
		}
					#</xs:sequence
					#<xs:element name="item"...
		$self->items()->factory()->xml_schema($xsd, $sequence);
					#</xs:element -- item
				#</xs:sequence
			#</xs:complexType
		#</xs:element
	}
}
# ----------------------------------------------------------------------------------------------------
1;