pequeltypes.pm

来自「普通的ETL工具」· PM 代码 · 共 218 行

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::Type::PequelTypes.pm
#  Created	: 9 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::Type::PequelTypes;
require 5.005_62;
use strict;
use warnings;
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::PequelTypes::Abstract;
	use base qw(Class::STL::Element);
	use Class::STL::ClassMembers qw( name description validate_catalogue ),
		Class::STL::ClassMembers::DataMember->new(name => 'xs_type', default => 'NMTOKEN'),
		Class::STL::ClassMembers::DataMember->new(name => 'data_xs_type', default => 'xs:string'),
		Class::STL::ClassMembers::DataMember->new(name => 'validate', default => '^.*$');
	use Class::STL::ClassMembers::Constructor;
	sub getvar
	{
		my $self = shift;
		my $f = shift;
		return $f->getvar();
	}
	sub lt
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return '';
	}
	sub lte
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return '';
	}
	sub gt
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return '';
	}
	sub gte
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return '';
	}
	sub eq
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return '';
	}
	sub ne
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return '';
	}
	sub cmp
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return '';
	}
	sub xml_schema
	{
		use XML::Mini::Document;
		my $self = shift;
		my $xsd = shift;
		my $xml_node = shift || $xsd->schema_root();
		return if ($xsd->exists('element', $self->name(), $xml_node));
		$xsd->comment($xml_node, "Pequel Type: @{[ $self->name() ]}");
		my $element = $xsd->xs_element($xml_node, name => $self->name());
		if (defined($self->description()) && $self->description() ne '') {
			my $doc = $xsd->xs_documentation($xsd->xs_annotation($element), 'xml:lang' => 'en');
			$xsd->text($doc, $self->description());
		}
		my $restriction = $xsd->xs_restriction($xsd->xs_simpleType($element), 
			base => $self->data_xs_type()
		);
		$xsd->xs_pattern($restriction, value => $self->validate())
			if (defined($self->validate()));
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::PequelTypes::Numeric;
	use base qw(ETL::Pequel3::Type::PequelTypes::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'validate', default => '^\d+$'),
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Numeric data'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'numeric');
	use Class::STL::ClassMembers::Constructor;
	sub lt
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return "$v1 ne '' && $v1 < $v2";
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::PequelTypes::String;
	use base qw(ETL::Pequel3::Type::PequelTypes::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Alpha-numeric data'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'string');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::PequelTypes::Amount;
	use base qw(ETL::Pequel3::Type::PequelTypes::Abstract);
	use Class::STL::ClassMembers qw( decimal_places ),
		Class::STL::ClassMembers::DataMember->new(name => 'validate', default => '^(\d|\.|\-)+$'),
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Decimal numeric data'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'amount');
	use Class::STL::ClassMembers::Constructor;
	sub getvar
	{
		my $self = shift;
		my $f = shift;
		return defined($self->decimal_places())
			? "sprintf(\"%.@{[ $self->decimal_places() ]}f\", @{[ $f->getvar() ]})"
			: $f->getvar();
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::PequelTypes::Array;
	use base qw(ETL::Pequel3::Type::PequelTypes::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Array list data'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'array');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::PequelTypes::Date;
	use base qw(ETL::Pequel3::Type::PequelTypes::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'date'),
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Date data'),
		Class::STL::ClassMembers::DataMember->new(name => 'validate_catalogue', default => 'date_types');
	use Class::STL::ClassMembers::Constructor;
	sub lt
	{
		my $self = shift;
		my $v1 = shift;
		my $v2 = shift;
		return $self->date_type()->lt($v1, $v2);
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::PequelTypes::Catalogue;
	use base qw(ETL::Pequel3::Type::Catalogue);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'catalogue_name', default => 'pequel_types'),
		Class::STL::ClassMembers::DataMember->new(name => 'target_mem_name', default => 'name'),
		Class::STL::ClassMembers::DataMember->new(name => 'element_type', default => 'ETL::Pequel3::Type::PequelTypes::Abstract');
	use Class::STL::ClassMembers::SingletonConstructor;
	sub new_extra
	{
		my $self = shift;
		$self->push_back(
			ETL::Pequel3::Type::PequelTypes::Numeric->new(), # includes float
			ETL::Pequel3::Type::PequelTypes::String->new(),
			ETL::Pequel3::Type::PequelTypes::Amount->new(),
			ETL::Pequel3::Type::PequelTypes::Array->new(),
			ETL::Pequel3::Type::PequelTypes::Date->new(),
		);
		return $self;
	}
	sub catalogue
	{
		my $self = shift;
		my $xml_node = shift;
		foreach ($self->to_array()) {
			my $s_xml = $xml_node->createChild("pequel-data-type");
			$s_xml->attribute('pequel-type-name', $_->name());
		}
	}
}
# ----------------------------------------------------------------------------------------------------
1;