date.pm

普通的ETL工具

# vim:ts=4 sw=4
# ----------------------------------------------------------------------------------------------------
#  Name		: ETL::Pequel3::Type::Macros::Date.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;
$VERSION = 0.01;
$BUILD = 'Friday September 22 21:19:58 BST 2006';
use ETL::Pequel3::Type::Macros;
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Date::Abstract;
	use base qw(ETL::Pequel3::Type::Macros::Abstract);
	use Class::STL::ClassMembers
		Class::STL::ClassMembers::DataMember->new(name => 'category', default => 'date');
	use Class::STL::ClassMembers::Constructor;
	sub get_type
	{
		my $self = shift;
		my ($dt, $type_name) = ($_[0] =~ /(.*)<(.+)>$/ ? ($1, $2) : ($_[0], $self->configuration()->default_datetype()));
		my $type = $self->date_types()->exists($type_name)
			|| $self->err()->user_error(10701, "Invalid date type '$type_name'");
		return ($dt, $type);
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::ToDate;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the date I<expr> value in I<type> date format.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&to_date(E<lt> I<expr> E<gt> [, E<lt> I<type> E<gt> ])'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'to_date');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my $to_type_name = $_[1] || $self->configuration()->default_datetype();
		my $to_type = $self->date_types()->exists($to_type_name)
			|| $self->err()->user_error(10701, "Invalid date type '$to_type_name'");
		$c->code($to_type->from_dmy("&d($_[0])", "&m($_[0])", "&y($_[0])"));
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::Y;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the year number for the date in I<expr>'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&y(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'y');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my ($dt, $type) = $self->get_type($_[0]);
#>		$c->code($type->code_get_year($dt)->raw());
		($type->y()->len() == 2)
			? $c->code("(int(int(substr($dt, @{[ $type->y()->pos() ]}, 2)) < 20 ? '20' : '19') . substr($dt, @{[ $type->y()->pos() ]}, 2))")
			: $c->code("substr($dt, @{[ $type->y()->pos() ]}, @{[ $type->y()->len() ]})");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::D;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the day number for the date in I<expr>'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&d(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'd');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
#>		my ($dt, $type) = @_ == 2 ? (shift, shift) : $self->get_type($_[0]);
		my ($dt, $type) = $self->get_type($_[0]);
		$c->code("substr($dt, @{[ $type->d()->pos() ]}, @{[ $type->d()->len() ]})");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::M;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the month number for the date in I<expr>'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&m(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'm');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my ($dt, $type) = $self->get_type($_[0]);
		($type->m()->len() == 3)
			? $c->code("&month_number(substr($dt, @{[ $type->m()->pos() ]}, @{[ $type->m()->len() ]}))")
			: $c->code("substr($dt, @{[ $type->m()->pos() ]}, @{[ $type->m()->len() ]})");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::MonthsSince;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the number of months between the current system date and the date in I<expr>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&months_since(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'months_since');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my ($dt, $type) = $self->get_type($_[0]);
		$c->code(
			"$dt !~ /@{[ $type->regex() ]}/ ? 0 : "
			. "((&today_year() - &y($_[0])) * 12) + (&today_month() - &m($_[0]))"
		);
		return $c;
#?		return ("((_MONTHS_SINCE_TODAY_YEAR - (unpack('a4 a2', $_[0]))[0]) * 12) + (_MONTHS_SINCE_TODAY_MONTH - (unpack('a4 a2', $_[0]))[1])");
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::MonthsBetween;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the number of months between the two dates in I<expr1> and I<expr2>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&months_between(E<lt> I<expr1> E<gt>, E<lt> I<expr2> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'months_between');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my ($dt1, $type1) = $self->get_type($_[0]);
		my ($dt2, $type2) = $self->get_type($_[1]);
		$c->code(
			"$dt1 !~ /@{[ $type1->regex() ]}/ || $dt2 !~ /@{[ $type2->regex() ]}/ ? 0 : "
			. "abs(((&y($_[1]) - &y($_[0])) * 12) + (&m($_[1]) - &m($_[0])))"
		);
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::DateLastDay;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the date for the last day in the month for the date in I<expr>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&date_last_day(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'date_last_day');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my ($dt, $type) = $self->get_type($_[0]);
		$c->code($type->from_dmy("&month_last_day($_[0])", "&m($_[0])", "&y($_[0])"));
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::MonthLastDay;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the day number for the last day in the month for the date in I<expr>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&month_last_day(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'month_last_day');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my ($dt, $type) = $self->get_type($_[0]);
		$c->code("&days_in_month( &m($_[0]), &y($_[0]) )");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::DateNextDay;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the date for the day following the date in I<expr>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&date_next_day(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'date_next_day');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my ($dt, $type) = $self->get_type($_[0]);
		$c->code($type->from_dmy(
			"&d($_[0]) == &month_last_day($_[0]) ? 1 : 1 + &d($_[0])",
			"&d($_[0]) == &month_last_day($_[0]) ? (&m($_[0]) == 12 ? 1 : 1 + &m($_[0])) : &m($_[0])",
			"(&y($_[0]) + (&m($_[0]) == 12 && &d($_[0]) == 31 ? 1 : 0))"
		));
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::DateRangeValues;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns an array of dates for all the days within, and including, the dates in I<expr1> and I<expr2>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&date_range_values(E<lt> I<expr1> E<gt>, E<lt> I<expr2> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'date_range_values');
	use Class::STL::ClassMembers::Constructor;
	sub translate # args: date_from, date_to
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		my ($dt1, $type1) = $self->get_type($_[0]); # type must be the same -- ignore second type;
		my ($dt2, $type2) = $self->get_type($_[1]);
		$c->code('&{sub');
		$c->open_block();
			$c->code("my \@dates;");
			$c->code("my \$dfrom=&to_date($_[0], YYYYMMDD);");
			$c->code("my \$dto=&to_date($_[1], YYYYMMDD);");
			$c->code("for (my \$d=\$dfrom; \$d <= \$dto; \$d=&date_next_day(\$d<YYYYMMDD>))");
			$c->open_block();
				$c->code("push(\@dates, &to_date(\$d<YYYYMMDD>, @{[ $type1->name() ]}));");
			$c->close_block();
			$c->code("return wantarray");
			$c->over();
				$c->code("? \@dates");
				$c->code(": join('@{[ $self->configuration()->default_list_delimiter() ]}', \@dates);");
			$c->back();
		$c->close_block();
		$c->code("}");
		return $c; # comma delimited list of dates
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::DayOfYear;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the year day number (1 to 365/366) for the date in I<expr>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&day_of_year(E<lt> I<expr> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'day_of_year');
	use Class::STL::ClassMembers::Constructor;
	sub translate
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("&d($_[0]) + &month_first_day_of_year(&m($_[0]), &y($_[0]))");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::MonthFirstDayOfYear;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the year day number (1 to 365/366) for the first day of the month I<expr1> in year I<expr2>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&month_first_day_of_year(E<lt> I<expr1> E<gt>, E<lt> I<expr2> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'month_first_day_of_year');
	use Class::STL::ClassMembers::Constructor;
	sub code_init_global
	{
		my $self = shift;
		my $c = $self->SUPER::code_init_global(@_);
		$c->code("my \@g_@{[ uc($self->name()) ]}_LEAP = (0,1,32,61,92,122,153,183,214,245,275,306,336); # \&@{[ $self->name() ]}()");
		$c->code("my \@g_@{[ uc($self->name()) ]} = (0,1,32,60,91,121,152,182,213,244,274,305,335); # \&@{[ $self->name() ]}()");
		return $c;
	}
	sub translate # args: month, year
	{
		my $self = shift;
		my $c = $self->SUPER::translate(@_);
		$c->code("($_[1] % 4 == 0 ? \$g_@{[ uc($self->name()) ]}_LEAP\[$_[0]] : \$g_@{[ uc($self->name()) ]}\[$_[0]])");
		return $c;
	}
}
# ----------------------------------------------------------------------------------------------------
{
	package ETL::Pequel3::Type::Macros::MonthLastDayOfYear;
	use base qw(ETL::Pequel3::Type::Macros::Date::Abstract);
	use Class::STL::ClassMembers 
		Class::STL::ClassMembers::DataMember->new(name => 'description', default => 'Returns the year day number (1 to 365/366) for the last day of the month I<expr1> in year I<expr2>.'),
		Class::STL::ClassMembers::DataMember->new(name => 'usage', default => '&month_last_day_of_year(E<lt> I<expr1> E<gt>, E<lt> I<expr2> E<gt>)'),
		Class::STL::ClassMembers::DataMember->new(name => 'name', default => 'month_last_day_of_year');
	use Class::STL::ClassMembers::Constructor;
	sub translate # args: month, year
	{