general.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::Type::General.pm
#  Created	: 8 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
# ----------------------------------------------------------------------------------------------------
require 5.005_62;
use strict;
use warnings;
use vars qw($VERSION $BUILD);
$VERSION = 0.01;
$BUILD = 'Friday September 22 21:19:58 BST 2006';
use ETL::Pequel3::Type::Macros;
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::General::Abstract;
	use base qw(ETL::Pequel3::Type::Macros::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'category', default => 'general');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Map; #TODO: test
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'The F<&map()> macro will lookup each element within the array I<expr> in I<table> and setting that element to the looked up value. Returns an array of results. Non-existing key values will be mapped to null.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&map(E<lt> I<table> E<gt>, E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'map');
	use Class::STL::ClassMembers::Constructor;
	sub translate # -- fmt => 'table, input_field | output_field',
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("join");
		$c->open_block('(');
			$c->code("\"@{[ $self->configuration()->default_list_delimiter() ]}\",");
			$c->code("map");
			$c->open_block("(");
				$c->code("@{[ $_[0] =~ /^%/ ? '' : '%' ]}$_[0](\$_),");
				$c->code("split(\/\\s*@{[ $self->configuration()->default_list_delimiter() ]}\\s*\/,$_[1],-1)");
			$c->close_block(")");
		$c->close_block(")");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Unpack;
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Unpacks the sequence of bytes in string I<expr> into a list using I<template>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&unpack(E<lt> I<template> E<gt>, E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'unpack');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my $delim = $self->configuration()->default_list_delimiter();
		$c->code("join('$delim', unpack($_[0], $_[1]))");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Pack;
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Packs the values in the array I<expr> into a sequence of bytes, using the specified I<template>. Returns the sequence as a string.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&pack(E<lt> I<template> E<gt>, E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'pack');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("pack($_[0], @{[ join(',', @_[1..$#_]) ]})");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::InputRepeatValue;
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the current value for the repeating field number I<expr> as specified in the I<repeat_on_input> section.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&irval(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'irval');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("\$_IRVAL_@{[ defined($_[0]) ? $_[0] : '1' ]}");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::OutputRepeatValue;
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the current value for the repeating field number I<expr> as specified in the I<repeat_on_output> section.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&orval(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'orval');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("\$_ORVAL_@{[ defined($_[0]) ? $_[0] : '1' ]}");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Commify;
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the comma formatted number for the value in I<expr>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&commify(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'commify');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("do");
		$c->open_block();
			$c->code("my \$idec = index($_[0], '.');");
			$c->code("my \$dec = \$idec > 0 ? substr($_[0], \$idec) : '';");
			$c->code("my \$txt = reverse(\$idec > 0 ? substr($_[0], 0, \$idec) : $_[0]);");
			$c->code("\$txt =~ s/(\\d\\d\\d)(?=\\d)(?!\\d*\\.)/\$1,/g;");
			$c->code("(scalar reverse \$txt) . \$dec;");
		$c->close_block();
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Env; #TODO: test
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the value for the environment variable as specified in I<expr>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&env(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'env');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("\$ENV{$_[0]}");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Configuration;
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the value for the configuration variable as specified in I<expr>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&configuration(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'configuration');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		#TODO: check exists
		#TODO: remove quote delimiters
		$c->code("q{@{[ $self->configuration()->exists($_[0])->value() ]}}");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::MatchAny;
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns 1 if any one of the elements in array I<expr> matches the expression I<patt>. Otherwise returns 0.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&match_any(E<lt> I<patt> E<gt>, E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'match_any');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("$_[0] =~ m/^(@{[ join('|', map(do{s/^[\"']?//; s/[\"']?$//; $_; },  @_[1..$#_])) ]})\$/ ? 1 : 0");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Match;
	use base qw(ETL::Pequel3::Type::Macros::MatchAny);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns 1 if any one of the elements in array I<expr> matches the expression I<patt>. Otherwise returns 0. (same as I<&match_any()>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&match(E<lt> I<patt> E<gt>, E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'match');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Select;
	use base qw(ETL::Pequel3::Type::Macros::General::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Similar to a switch statement. Parameters consist of a list of expression-value pairs, followed by one default value. Each expression is evaluated in turn and the first to evaluate to true will return its associated valued, otherwise the default value is returned.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&select(E<lt> I<expr> E<gt>, E<lt> I<value> E<gt> [, E<lt> I<expr> E<gt>, E<lt> I<value> E<gt> [, ...] ], E<lt> I<default> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'select');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;