DateTimeX-Lite
view release on metacpan or search on metacpan
lib/DateTimeX/Lite.pm view on Meta::CPAN
DateTimeX::Lite::Util::seconds_as_components
( $self->{local_rd_secs}, $self->{utc_rd_secs}, $self->{offset_modifier} );
}
sub from_object {
my ($class, %p) = @_;
my $object = delete $p{object};
my ( $rd_days, $rd_secs, $rd_nanosecs ) = $object->utc_rd_values;
# A kludge because until all calendars are updated to return all
# three values, $rd_nanosecs could be undef
$rd_nanosecs ||= 0;
# This is a big hack to let _seconds_as_components operate naively
# on the given value. If the object _is_ on a leap second, we'll
# add that to the generated seconds value later.
my $leap_seconds = 0;
if ( $object->can('time_zone') && ! $object->time_zone->is_floating
&& $rd_secs > 86399 && $rd_secs <= DateTimeX::Lite::LeapSecond::day_length($rd_days) )
{
lib/DateTimeX/Lite.pm view on Meta::CPAN
Please also note that internally, this module is a complete rip-off of the original DateTime.pm module. The author simply copied and pasted about 90% of the code, tweaked it and repackaged it. All credits go to the original DateTime.pm's authors.
=head1 RATIONALE
The aim of this module is as follows:
=over 4
=item (1) Target those who do not need the full feature of DateTime.pm.
In particular, I'm thinking of people who wants to simply grab a date, maybe do some date arithmetic on it, and print the year/month/date or store those values somewhere. These people do not use advanced date logic, sets, or calendars.
=item (2) Target the newbies who are afraid of XS code.
Let's face it, /we/ the developers know how to deal with XS. But we can't expect that out of everybody. DateTime.pm doesn't require XS, but to get decent performance it's sort of a requirement. We do our best to get there without XS.
=item (3) Get better performance.
In particular,
* Reduce the amount of memory consumed, and
lib/DateTimeX/Lite/Duration.pm view on Meta::CPAN
wantarray ? @ret{@units} : $ret{ $units[0] };
}
sub is_wrap_mode { $_[0]->{end_of_month} eq 'wrap' ? 1 : 0 }
sub is_limit_mode { $_[0]->{end_of_month} eq 'limit' ? 1 : 0 }
sub is_preserve_mode { $_[0]->{end_of_month} eq 'preserve' ? 1 : 0 }
sub end_of_month_mode { $_[0]->{end_of_month} }
sub calendar_duration
{
my $self = shift;
return
(ref $self)->new( map { $_ => $self->{$_} } qw( months days end_of_month ) )
}
sub clock_duration
{
my $self = shift;
lib/DateTimeX/Lite/Duration.pm view on Meta::CPAN
will return false for B<all> of these methods.
=item * is_wrap_mode, is_limit_mode, is_preserve_mode
Indicates what mode is used for end of month wrapping.
=item * end_of_month_mode
Returns one of "wrap", "limit", or "preserve".
=item * calendar_duration
Returns a new object with the same I<calendar> delta (months and days
only) and end of month mode as the current object.
=item * clock_duration
Returns a new object with the same I<clock> deltas (minutes, seconds,
and nanoseconds) and end of month mode as the current object.
=item * inverse
Returns a new object with the same deltas as the current object, but
lib/DateTimeX/Lite/TimeZone.pm view on Meta::CPAN
version of the current DateTimeX::Lite::TimeZone installation. If they do not
match it will issue a warning. This is useful because time zone names
may fall out of use, but you may have an old module file installed for
that time zone.
There are also several special values that can be given as names.
If the "name" parameter is "floating", then a
C<DateTimeX::Lite::TimeZone::Floating> object is returned. A floating time
zone does have I<any> offset, and is always the same time. This is
useful for calendaring applications, which may need to specify that a
given event happens at the same I<local> time, regardless of where it
occurs. See RFC 2445 for more details.
If the "name" parameter is "UTC", then a C<DateTimeX::Lite::TimeZone::UTC>
object is returned.
If the "name" is an offset string, it is converted to a number, and a
C<DateTimeX::Lite::TimeZone::OffsetOnly> object is returned.
=head3 The "local" time zone
use DateTimeX::Lite;
# test _ymd2rd and _rd2ymd for various dates
# 2 tests are performed for each date (on _ymd2rd and _rd2ymd)
# dates are specified as [rd,year,month,day]
for (# min and max supported days (for 32-bit system)
[-2 ** 31, -5879610, 6, 22],
[ 2 ** 31 - 1, 5879611, 7, 11],
# some miscellaneous dates (these are actually epoch dates for
# various calendars from Calendrical Calculations (1st ed) Table
# 1.1)
[-1721425,-4713,11,24],
[-1373427,-3760,9,7],
[-1137142,-3113,8,11],
[-1132959,-3101,1,23],
[-963099,-2636,2,15],
[-1,0,12,30],[1,1,1,1],
[2796,8,8,27],
[103605,284,8,29],
[226896,622,3,22],
t/11duration.t view on Meta::CPAN
weeks => 3,
days => 4,
hours => 6,
minutes => 7,
seconds => 8,
nanoseconds => 9,
);
my $dur = DateTimeX::Lite::Duration->new( %pairs, end_of_month => 'limit' );
my $calendar_dur = $dur->calendar_duration;
is( $calendar_dur->delta_months, 14, "date - delta_months is 14" );
is( $calendar_dur->delta_minutes, 0, "date - delta_minutes is 0" );
is( $calendar_dur->delta_seconds, 0, "date - delta_seconds is 0" );
is( $calendar_dur->delta_nanoseconds, 0, "date - delta_nanoseconds is 0" );
ok( $calendar_dur->is_limit_mode, "limit mode" );
my $clock_dur = $dur->clock_duration;
is( $clock_dur->delta_months, 0, "time - delta_months is 0" );
is( $clock_dur->delta_minutes, 367, "time - delta_minutes is 367" );
is( $clock_dur->delta_seconds, 8, "time - delta_seconds is 8" );
is( $clock_dur->delta_nanoseconds, 9, "time - delta_nanoseconds is 9" );
ok( $clock_dur->is_limit_mode, "limit mode" );
}
{
t/24from_object.t view on Meta::CPAN
is( $dt1->year, 1970, 'year is 1970' );
is( $dt1->hour, 1, 'hour is 1' );
is( $dt1->nanosecond, 100, 'nanosecond is 100' );
{
my $t1 =
DateTimeX::Lite::Calendar::_Test::WithoutTZ->new
( rd_days => 1, rd_secs => 0 );
# Tests creating objects from other calendars (without time zones)
my $t2 = DateTimeX::Lite->from_object( object => $t1 );
isa_ok( $t2, 'DateTimeX::Lite' );
is( $t2->iso8601, '0001-01-01T00:00:00', 'convert from object without tz');
ok( $t2->time_zone->is_floating, 'time_zone is floating');
}
{
my $tz = DateTimeX::Lite::TimeZone->load( name => 'America/Chicago');
my $t1 =
DateTimeX::Lite::Calendar::_Test::WithTZ->new
( rd_days => 1, rd_secs => 0, time_zone => $tz );
# Tests creating objects from other calendars (with time zones)
my $t2 = DateTimeX::Lite->from_object( object => $t1 );
isa_ok( $t2, 'DateTimeX::Lite' );
is( $t2->time_zone->name, 'America/Chicago', 'time_zone is preserved');
}
{
my $tz = DateTimeX::Lite::TimeZone->load( name => 'UTC' );
my $t1 =
DateTimeX::Lite::Calendar::_Test::WithTZ->new
t/38local-subtract.t view on Meta::CPAN
is( $deltas{nanoseconds}, 0, 'delta_nanoseconds is 0' );
is( DateTimeX::Lite->compare( $dt1->clone->add_duration($dur), $dt2 ), 0,
'dt1 + dur = dt2' );
# this are two examples from the docs
is( DateTimeX::Lite->compare( $dt2->clone->subtract_duration($dur),
$dt1->clone->add( hours => 1 ) ),
0,
'dt2 - dur != dt1 (not reversible)' );
is( DateTimeX::Lite->compare( $dt2->clone->subtract_duration( $dur->clock_duration )
->subtract_duration( $dur->calendar_duration ),
$dt1 ),
0,
'dt2 - dur->clock - dur->cal = dt1 (reversible when componentized)' );
my $dur2 = $dt1->subtract_datetime($dt2);
my %deltas2 = $dur2->deltas;
is( $deltas2{months}, 0, 'delta_months is 0' );
is( $deltas2{days}, -1, 'delta_days is 1' );
is( $deltas2{minutes}, -3, 'delta_minutes is 3' );
is( $deltas2{seconds}, 0, 'delta_seconds is 0' );
is( $deltas2{nanoseconds}, 0, 'delta_nanoseconds is 0' );
is( $dt2->clone->add_duration($dur2)->iso8601, '2003-04-05T02:58:00', 'dt2 + dur2 != dt1' );
is( DateTimeX::Lite->compare( $dt2->clone->add_duration( $dur2->clock_duration )
->add_duration( $dur2->calendar_duration ),
$dt1 ),
0,
'dt2 + dur2->clock + dur2->cal = dt1' );
is( DateTimeX::Lite->compare( $dt1->clone->subtract_duration($dur2), $dt2 ), 0,
'dt1 - dur2 = dt2' );
}
# These tests makes sure that days with DST changes are "normal" when
# they're the smaller operand
tools/lib/DateTimeX/Lite/Tool/Locale/Generator.pm view on Meta::CPAN
my $self = shift;
my $ldml = shift;
my $data = shift;
my $name = shift;
# This isn't well documented (or really documented at all) in the
# LDML spec, but the example seem to suggest that for the narrow
# form, the format type should "inherit" from the stand-alone
# type if possible, rather than the abbreviated type.
#
# See
# http://www.unicode.org/cldr/data/charts/by_type/calendar-gregorian.day.html
# for examples of the expected output. Note that the format narrow
# days for English are inherited from its stand-alone narrow form,
# not the root locale.
if ( $name =~ /format_narrow/ )
{
( my $to_name = $name ) =~ s/format/stand_alone/;
return 1
if $self->maybe_make_alias( $ldml, $data, $name, $to_name );
}
# It seems like the quarters should just inherit up the (Perl)
# inheritance chain, rather than from the next biggest size. See
# http://www.unicode.org/cldr/data/charts/by_type/calendar-gregorian.quarter.html
# for an example. Note that the English format narrow quarter is
# "1", not "Q1".
if ( $name =~ /quarter_(\w+)_narrow/ )
{
return;
}
( my $to_name = $name );
$to_name =~ s/abbreviated/wide/;
$to_name =~ s/narrow/abbreviated/;
tools/lib/DateTimeX/Lite/Tool/Locale/LDML.pm view on Meta::CPAN
default => sub { ( $_[0]->_parse_id() )[3] },
);
has 'parent_id' =>
( is => 'ro',
isa => 'Str',
lazy_build => 1,
);
class_type 'XML::LibXML::Node';
has '_calendar_node' =>
( is => 'ro',
isa => 'XML::LibXML::Node|Undef',
lazy => 1,
default => sub { $_[0]->_find_one_node( q{dates/calendars/calendar[@type='gregorian']} ) },
);
has 'has_calendar_data' =>
( is => 'ro',
isa => 'Bool',
lazy => 1,
default => sub { $_[0]->_calendar_node() ? 1 : 0 },
);
for my $thing ( { name => 'day',
length => 7,
order => [ qw( mon tue wed thu fri sat sun ) ],
},
{ name => 'month',
length => 12,
order => [ 1..12 ],
},
tools/lib/DateTimeX/Lite/Tool/Locale/LDML.pm view on Meta::CPAN
( join '/',
PL_N($name),
$name . 'Context' . q{[@type='} . $xml_context . q{']},
$name . 'Width' . q{[@type='} . $size . q{']},
$name
);
my $builder =
sub { my $self = shift;
return [] unless $self->has_calendar_data();
my @vals =
$self->_find_preferred_values
( ( scalar $self->_calendar_node()->findnodes($path) ),
'type',
$thing->{order},
);
return [] unless @vals == $thing->{length};
return \@vals;
};
__PACKAGE__->meta()->add_method( '_build_' . $attr => $builder );
tools/lib/DateTimeX/Lite/Tool/Locale/LDML.pm view on Meta::CPAN
my $path =
( join '/',
'eras',
'era' . $size->[1],
'era',
);
my $builder =
sub { my $self = shift;
return [] unless $self->has_calendar_data();
my @vals =
$self->_find_preferred_values
( ( scalar $self->_calendar_node()->findnodes($path) ),
'type',
[ 0, 1 ],
);
return [] unless @vals == 2;
return \@vals;
};
__PACKAGE__->meta()->add_method( '_build_' . $attr => $builder );
tools/lib/DateTimeX/Lite/Tool/Locale/LDML.pm view on Meta::CPAN
( join '/',
$type . 'Formats',
$type . q{FormatLength[@type='} . $length . q{']},
$type . 'Format',
'pattern',
);
my $builder =
sub { my $self = shift;
return unless $self->has_calendar_data();
return $self->_find_one_node_text( $path, $self->_calendar_node() );
};
__PACKAGE__->meta()->add_method( '_build_' . $attr => $builder );
}
}
has 'default_date_format_length' =>
( is => 'ro',
isa => 'Str|Undef',
lazy => 1,
default => sub { $_[0]->_find_one_node_attribute( 'dateFormats/default',
$_[0]->_calendar_node(),
'choice' )
},
);
has 'default_time_format_length' =>
( is => 'ro',
isa => 'Str|Undef',
lazy => 1,
default => sub { $_[0]->_find_one_node_attribute( 'timeFormats/default',
$_[0]->_calendar_node(),
'choice' )
},
);
has 'am_pm_abbreviated' =>
( is => 'ro',
isa => 'ArrayRef',
lazy_build => 1,
);
tools/lib/DateTimeX/Lite/Tool/Locale/LDML.pm view on Meta::CPAN
{
my $class = shift;
my $node = shift;
my $file = shift;
ALIAS:
for my $node ( $node->getElementsByTagName('alias') )
{
# Replacing all the aliases is slow, and we really don't care
# about most of the data in the file, just the
# localeDisplayNames and the gregorian calendar.
#
# We also end up skipping the case where the entire locale is an alias to some
# other locale. This is handled in the generated Perl code.
for ( my $p = $node->parentNode(); $p; $p = $p->parentNode() )
{
if ( $p->nodeName() eq 'calendar' )
{
if ( $p->getAttribute('type') eq 'gregorian' )
{
last;
}
else
{
next ALIAS;
}
}
tools/lib/DateTimeX/Lite/Tool/Locale/LDML.pm view on Meta::CPAN
my $class = shift;
my $node = shift;
my $file = shift;
my $source = $node->getAttribute('source');
my $target_file = $file->dir()->file( $source . q{.xml} );
my $doc = $class->_resolve_document_aliases($target_file);
# I'm not sure nodePath() will work, since it seems to return an
# array-based index like /ldml/dates/calendars/calendar[4]. I'm
# not sure if LDML allows this, but the target file might contain
# a different ordering or may just be missing something. This
# whole alias thing is madness.
#
# However, remote aliases seem to be a rare case outside of an
# alias for the entire file, so they can be investigated as
# needed.
my $path = $node->getAttribute('path') || $node->parentNode()->nodePath();
tools/lib/DateTimeX/Lite/Tool/Locale/LDML.pm view on Meta::CPAN
sub _az_hack
{
my $self = shift;
my $data = shift;
# The az.xml file appears to have a mistake in the wide day names,
# thursday and friday are the same for this locale
my $thu = $self->_find_one_node_text( q{days/dayContext[@type='format']/dayWidth[@type='wide']/day[@type='thu']},
$self->_calendar_node() );
my $fri = $self->_find_one_node( q{days/dayContext[@type='format']/dayWidth[@type='wide']/day[@type='fri']},
$self->_calendar_node() );
$fri->removeChildNodes();
$thu =~ s/ \w+$//;
$fri->appendChild( $self->document()->createTextNode($thu) );
}
sub _gaa_hack
{
my $self = shift;
my $data = shift;
my $path = q{days/dayContext[@type='format']/dayWidth[@type='abbreviated']/day[@type='sun']};
my $day_text = $self->_find_one_node_text( $path, $self->_calendar_node() );
return unless $day_text eq 'Ho';
# I am completely making this up, but the data is marked as
# unconfirmed in the locale file and making something up is
# preferable to having two days with the same abbreviation
my $day = $self->_find_one_node( $path, $self->_calendar_node() );
$day->removeChildNodes();
$day->appendChild( $self->document()->createTextNode('Hog') );
}
sub _ve_hack
{
my $self = shift;
my $data = shift;
my $path = q{months/monthContext[@type='format']/monthWidth[@type='abbreviated']/month[@type='3']};
my $day_text = $self->_find_one_node_text( $path, $self->_calendar_node() );
return unless $day_text eq 'á¹°ha';
# Again, making stuff up to avoid non-unique abbreviations
my $day = $self->_find_one_node( $path, $self->_calendar_node() );
$day->removeChildNodes();
$day->appendChild( $self->document()->createTextNode('á¹°hf') );
}
sub _build_version
{
my $self = shift;
my $version = $self->_find_one_node_attribute( 'identity/version', 'number' );
tools/lib/DateTimeX/Lite/Tool/Locale/LDML.pm view on Meta::CPAN
else
{
return $self->id() eq 'root' ? 'Base' : 'root';
}
}
sub _build_am_pm_abbreviated
{
my $self = shift;
my $am = $self->_find_one_node_text( 'am', $self->_calendar_node() );
my $pm = $self->_find_one_node_text( 'pm', $self->_calendar_node() );
return [] unless defined $am && defined $pm;
return [ $am, $pm ];
}
sub _build_datetime_format
{
my $self = shift;
return
$self->_find_one_node_text( 'dateTimeFormats/dateTimeFormatLength/dateTimeFormat/pattern',
$self->_calendar_node() );
}
sub _build_available_formats
{
my $self = shift;
return {} unless $self->has_calendar_data();
my @nodes = $self->_calendar_node()->findnodes('dateTimeFormats/availableFormats/dateFormatItem');
my %index;
for my $node (@nodes)
{
push @{ $index{ $node->getAttribute('id') } }, $node;
}
my %formats;
for my $id ( keys %index )
{
( run in 0.459 second using v1.01-cache-2.11-cpan-5dc5da66d9d )