string.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::Type::Macros::String.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::String::Abstract;
	use base qw(ETL::Pequel3::Type::Macros::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'category', default => 'string');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Trim;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'The <&trim()> macro returns I<expr> with the specified leading and trailing I<trim-chars> character(s) removed. If I<trim-chars> is not specified, then the default value is space character.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&trim(E<lt> I<expr> E<gt>, [ E<lt> I<trim-chars> E<gt> ])'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'trim');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my $trim_chars = $_[1] || '\s';
		$trim_chars =~ s/['"]//g;
		$c->code("&{sub{");
		$c->over();
		$c->code("my \$tmp=$_[0]; ");
		$c->code("while (\$tmp ne '' && substr(\$tmp, 0, 1) =~ /[$trim_chars]/) ");
		$c->code("{ \$tmp = substr(\$tmp, 1); }");
		$c->code(" while (\$tmp ne '' && substr(reverse(\$tmp), 0, 1) =~ /[$trim_chars]/) ");
		$c->code("{ \$tmp = reverse(substr(reverse(\$tmp), 1)); }");
		$c->code(" \$tmp; ");
		$c->back();
		$c->code("}}");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Length;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => ''),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&length(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'length');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("length($_[0])");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Substr;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'The F<&substr()> macro extracts a substring of length I<length> staring at position I<offset> out of I<expr> and returns it. If I<offset> is negative, counts from the end of the string. If I<length> is omitted, return all characters till the end of string.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&substr(E<lt> I<expr> E<gt>, E<lt> I<offset> E<gt> [, E<lt> I<length> E<gt> ])'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'substr');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("substr($_[0], $_[1]@{[ defined($_[2]) ? ', ' . $_[2] : '' ]})");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Index;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'The F<&index()> macro returns the position of I<substr> in I<expr> at or after I<offset>. If I<substr> is not found, returns -1. If I<offset> is not specified then the search will begin at position 0.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&index(E<lt> I<expr> E<gt>, E<lt> I<substr> E<gt> [, E<lt> I<offset> E<gt> ])'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'index');
	use Class::STL::ClassMembers::Constructor;
	sub translate # field, substr [, offset ]
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("index($_[0], $_[1] @{[ defined($_[2]) ? ', ' . $_[2] : '' ]})");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::RightIndex;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'The F<&index()> macro returns the position of B<last> I<substr> in I<expr> at or after I<offset>. If I<substr> is not found, returns -1. If I<offset> is not specified then the search will begin at position 0.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&rindex(E<lt> I<expr> E<gt>, E<lt> I<substr> E<gt> [, E<lt> I<offset> E<gt> ])'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'rindex');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("rindex($_[0], $_[1] @{[ defined($_[2]) ? ', ' . $_[2] : '' ]})");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Sprintf;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns a string resulting from formatting, according to I<format>, the list of values in I<expr>. Please refer to Perl B<sprintf> formats.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&sprintf(E<lt> I<format> E<gt>, E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'sprintf');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("sprintf(@{[ join(',', @_) ]})");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Lc;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the value in I<expr> with all the characters converted to lower-case.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&lc(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'lc');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("lc($_[0])");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Uc;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the value in I<expr> with all the characters converted to upper-case.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&uc(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'uc');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("uc($_[0])");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::LcFirst;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the value in I<expr> with the first character converted to lower-case.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&lc_first(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'lc_first');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("lcfirst($_[0])");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::UcFirst;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the value in I<expr> with the first character converted to upper-case.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&uc_first(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'uc_first');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("ucfirst($_[0])");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::LcFirstAbbr;
	use base qw(ETL::Pequel3::Type::Macros::LcFirst);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&lcfirst(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'lcfirst');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::UcFirstAbbr;
	use base qw(ETL::Pequel3::Type::Macros::UcFirst);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&ucfirst(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'ucfirst');
	use Class::STL::ClassMembers::Constructor;
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::TrimTrailing;
	use base qw(ETL::Pequel3::Type::Macros::String::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'The <&trim()> macro returns I<expr> with the specified trailing I<trim-chars> character(s) removed. If I<trim-chars> is not specified, then the default value is space character.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&trim_trailing(E<lt> I<expr> E<gt>, [ E<lt> I<trim-chars> E<gt> ])'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'trim_trailing');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my $trim_chars = $_[1];
		$trim_chars =~ s/['"]//g;	# only remove quotes at start and end
		#return "&{sub{ my \$tmp=$_[0]; \$tmp =~ s/[!@#\$\%^*()+{}\[\]\\:;<>?/]+//g; \$tmp; }}"
		$c->newline_off();
		$c->code("&{sub{");
		$c->code("my \$tmp=$_[0]; ");
		$c->code("while (\$tmp ne '' && substr(reverse(\$tmp), 0, 1) =~ /[$trim_chars]/) ");
		$c->code("{ \$tmp = reverse(substr(reverse(\$tmp), 1)); }");
		$c->code(" \$tmp; ");
		$c->code("}}");
		return $c;