Hi all,
I've been absent for a while, but I decided to take the last couple of
days to retry my efforts to XS-fy various DT components.
As you may recall, my previous attempt was a relatively straight forward
port of the underlying perl code to XS, and to my dismay this resulted
in no detectable change in memory footprint or speed. And so I kind of
gave up.
Much later, I've realized that using Singleton pattern consumes much
more memory than creating many instances of the same class, probably due
to the overhead of allocating a new stash for each new namespace.
So this time around I've changed my strategy, and did the following:
- port stuff to XS
- store each data in a C struct
- but the actual data resides in .pm files that gets
loaded in the C structure on demand.
- stop using singletons.
- means that most of the objects are now blessed to
DateTime::TimeZone, instead of, say,
DateTime::TimeZone::America::Chicago.
This may or may not bite you..
- use a package level %CACHE to store each instance
Because I've already been burnt the last time after spending a lot of
time, this time around I just hacked around code and haven't done any
extensive testing or benchmarking yet.
But anyway, with the attached patch (against latest svn), the tests
pass, and I think I've managed to reduce the memory footprint a bit:
# pure perl (BEFORE LOAD)
RSHRD RSIZE VSIZE
624K 1.51M 27.1M
# pure perl (AFTER LOAD)
RSHRD RSIZE VSIZE
784K 14.7M 39.8M
# XS (BEFORE LOAD)
RSHRD RSIZE VSIZE
832K 2.48M 28.5M
# XS (AFTER LOAD)
RSHRD RSIZE VSIZE
832K 8.96M 34.8M
I'll comeback to doing more extensive testing, but meanwhile if any of
you are willing to run more extensive tests, that would be great.
Regards,
--d
=== Build.PL
==================================================================
--- Build.PL (revision 3631)
+++ Build.PL (local)
@@ -3,7 +3,7 @@
use Module::Build;
use File::Spec;
-unless ( -e File::Spec->catfile( qw( lib DateTime TimeZone America Chicago.pm
) ) )
+unless ( -e File::Spec->catfile( qw(src tzone.h) ) ) #qw( lib DateTime
TimeZone America Chicago.pm ) ) )
{
warn <<'EOF';
@@ -30,5 +30,6 @@
},
build_requires => { 'Module::Build' => 0 },
sign => 1,
+ c_source => 'src',
create_makefile_pl => 'passthrough',
)->create_build_script;
=== lib/DateTime/TimeZone/Floating.pm
==================================================================
--- lib/DateTime/TimeZone/Floating.pm (revision 3631)
+++ lib/DateTime/TimeZone/Floating.pm (local)
@@ -1,23 +1,32 @@
package DateTime::TimeZone::Floating;
-
use strict;
-
use vars qw ($VERSION @ISA);
-$VERSION = 0.01;
-
use DateTime::TimeZone;
use base 'DateTime::TimeZone::OffsetOnly';
-sub new
+BEGIN
{
- my $class = shift;
+ $VERSION = 0.01;
- return bless { name => 'floating',
- offset => 0 }, $class;
+ if (&DateTime::TimeZone::LOADED_XS) {
+ no strict 'refs';
+ *new = sub {
+ my $class = shift;
+ return $class->xs_init('floating', 0);
+ };
+ } else {
+ no strict 'refs';
+ *new = sub {
+ my $class = shift;
+ bless { name => 'floating', offset => 0 }, $class;
+ };
+ }
}
sub is_floating { 1 }
+1;
+
__END__
=head1 NAME
=== lib/DateTime/TimeZone/OffsetOnly.pm
==================================================================
--- lib/DateTime/TimeZone/OffsetOnly.pm (revision 3631)
+++ lib/DateTime/TimeZone/OffsetOnly.pm (local)
@@ -24,17 +24,26 @@
return DateTime::TimeZone::UTC->new unless $offset;
- my $self = { name => DateTime::TimeZone::offset_as_string( $offset ),
- offset => $offset,
- };
+ my $self;
+ if (&DateTime::TimeZone::LOADED_XS) {
+ $self = $class->xs_init(
+ DateTime::TimeZone::offset_as_string( $offset ),
+ $offset,
+ );
+ } else {
+ $self = bless {
+ name => DateTime::TimeZone::offset_as_string( $offset ),
+ offset => $offset,
+ }, $class;
+ }
- return bless $self, $class;
+ return $self;
}
sub is_dst_for_datetime { 0 }
-sub offset_for_datetime { $_[0]->{offset} }
-sub offset_for_local_datetime { $_[0]->{offset} }
+sub offset_for_datetime { $_[0]->offset }
+sub offset_for_local_datetime { $_[0]->offset }
sub is_utc { 0 }
=== lib/DateTime/TimeZone/OlsonDB.pm
==================================================================
--- lib/DateTime/TimeZone/OlsonDB.pm (revision 3631)
+++ lib/DateTime/TimeZone/OlsonDB.pm (local)
@@ -241,7 +241,7 @@
}
else
{
- die "Invalid on spec for rule: $day\n";
+ Carp::confess "Invalid on spec for rule: $day\n";
}
}
@@ -482,13 +482,14 @@
use strict;
-use DateTime;
+# use DateTime;
use Params::Validate qw( validate SCALAR ARRAYREF UNDEF OBJECT );
sub new
{
my $class = shift;
+
my %p = validate( @_, { gmtoff => { type => SCALAR },
rules => { type => ARRAYREF },
format => { type => SCALAR },
@@ -708,9 +709,14 @@
# rule's offset to the UTC date. Otherwise we can end up with
# a UTC date in year X, and a rule that starts in _local_ year
# X + 1, where that rule really does apply to that UTC date.
+
+ my $utc = $self->offset_from_utc;
+ my $std = $rule->offset_from_std;
+ my $total = $utc + $std;
+
my $temp_year =
$date->clone->add
- ( seconds => $self->offset_from_utc + $rule->offset_from_std
)->year;
+ ( seconds => $total )->year;
# Save the highest value
$year = $temp_year if $temp_year > $year;
@@ -817,7 +823,7 @@
use strict;
-use DateTime;
+# use DateTime;
use DateTime::Duration;
use Params::Validate qw( validate SCALAR );
@@ -828,7 +834,7 @@
my %p = validate( @_, { name => { type => SCALAR },
from => { type => SCALAR },
to => { type => SCALAR },
- type => { type => SCALAR, default => undef },
+ type => { type => SCALAR, default => '' },
in => { type => SCALAR },
on => { type => SCALAR },
at => { type => SCALAR },
@@ -848,9 +854,19 @@
$p{offset_from_std} = 0;
}
- return bless \%p, $class;
+ if (&DateTime::TimeZone::LOADED_XS) {
+ return $class->xs_init(@p{ qw(name from to type in on at save letter
offset_from_std) });
+ } else {
+ return bless \%p, $class;
+ }
}
+BEGIN
+{
+ if (! &DateTime::TimeZone::LOADED_XS) {
+ eval <<'EOM';
+sub from { $_[0]->{from} }
+
sub name { $_[0]->{name} }
sub offset_from_std { $_[0]->{offset_from_std} }
sub letter { $_[0]->{letter} }
@@ -861,9 +877,19 @@
sub is_infinite { $_[0]->{to} eq 'max' ? 1 : 0 }
-sub month { $DateTime::TimeZone::OlsonDB::MONTHS{ $_[0]->{in} } }
sub on { $_[0]->{on} }
sub at { $_[0]->{at} }
+sub month { $DateTime::TimeZone::OlsonDB::MONTHS{ $_[0]->{in} } }
+EOM
+ die if $@;
+ } else {
+ *min_year = \&from;
+ eval <<'EOM';
+sub month { $DateTime::TimeZone::OlsonDB::MONTHS{ $_[0]->in } }
+EOM
+ die if $@;
+ }
+}
sub utc_start_datetime_for_year
{
@@ -933,15 +959,23 @@
$p{is_dst} = 1 if $p{rule} && $p{rule}->offset_from_std;
$p{is_dst} = 1 if $p{observance}->offset_from_std;
-
if ( $p{short_name} =~ m{(\w+)/(\w+)} )
{
$p{short_name} = $p{is_dst} ? $2 : $1;
}
- return bless \%p, $class;
+ if (&DateTime::TimeZone::LOADED_XS) {
+ my @args = @p{ qw(utc_start_datetime local_start_datetime observance
rule offset_from_std offset_from_utc is_dst short_name) };
+ return $class->xs_init(@args);
+ } else {
+ return bless \%p, $class;
+ }
}
+BEGIN
+{
+ if (! &DateTime::TimeZone::LOADED_XS) {
+ eval <<'EOM';
sub utc_start_datetime { $_[0]->{utc_start_datetime} }
sub local_start_datetime { $_[0]->{local_start_datetime} }
sub short_name { $_[0]->{short_name} }
@@ -951,6 +985,9 @@
sub offset_from_utc { $_[0]->{offset_from_utc} }
sub offset_from_std { $_[0]->{offset_from_std} }
sub total_offset { $_[0]->offset_from_utc + $_[0]->offset_from_std }
+EOM
+ }
+}
sub two_changes_as_span
{
@@ -971,14 +1008,15 @@
my $utc_end = $c2->utc_start_datetime->utc_rd_as_seconds;
my $local_end = $utc_end + $c1->total_offset;
- return { utc_start => $utc_start,
+ return {
+ utc_start => $utc_start,
utc_end => $utc_end,
local_start => $local_start,
local_end => $local_end,
short_name => $c1->short_name,
offset => $c1->total_offset,
is_dst => $c1->is_dst,
- };
+ };
}
sub _debug_output
=== lib/DateTime/TimeZone/UTC.pm
==================================================================
--- lib/DateTime/TimeZone/UTC.pm (revision 3631)
+++ lib/DateTime/TimeZone/UTC.pm (local)
@@ -1,18 +1,24 @@
package DateTime::TimeZone::UTC;
-
use strict;
-
use vars qw ($VERSION);
-$VERSION = 0.01;
-
use DateTime::TimeZone;
use base 'DateTime::TimeZone';
-sub new
+BEGIN
{
- my $class = shift;
-
- return bless { name => 'UTC' }, $class;
+ $VERSION = 0.01;
+ if (&DateTime::TimeZone::LOADED_XS) {
+ *new = sub {
+ my $class = shift;
+ DateTime::TimeZone->register(name => 'UTC');
+ return bless DateTime::TimeZone->find('UTC'), $class;
+ };
+ } else {
+ *new = sub {
+ my $class = shift;
+ return bless { name => 'UTC' }, $class;
+ }
+ }
}
sub is_dst_for_datetime { 0 }
=== lib/DateTime/TimeZone.pm
==================================================================
--- lib/DateTime/TimeZone.pm (revision 3631)
+++ lib/DateTime/TimeZone.pm (local)
@@ -2,14 +2,33 @@
use strict;
-use vars qw( $VERSION );
-$VERSION = '0.45';
+use vars qw( $VERSION @ISA %CACHE );
+BEGIN
+{
+ $VERSION = '0.45';
+ eval {
+ if ($] > 5.006) {
+ require XSLoader;
+ XSLoader::load(__PACKAGE__, $VERSION);
+ } else {
+ require DynaLoader;
+ @ISA = qw(DynaLoader);
+ __PACKAGE__->bootstrap;
+ }
+ };
+ if ($@) {
+ warn;
+ eval 'sub LOADED_XS { 0 }';
+ }
+}
+
use DateTime::TimeZoneCatalog;
use DateTime::TimeZone::Floating;
use DateTime::TimeZone::Local;
use DateTime::TimeZone::OffsetOnly;
use DateTime::TimeZone::UTC;
+use DateTime::TimeZone::OlsonDB;
use Params::Validate qw( validate validate_pos SCALAR ARRAYREF BOOLEAN );
use constant INFINITY => 100 ** 100 ** 100 ;
@@ -33,6 +52,9 @@
{ name => { type => SCALAR } },
);
+ my $obj = $DateTime::TimeZone::CACHE{$p{name}};
+ return $obj if $obj;
+
if ( exists $DateTime::TimeZone::LINKS{ $p{name} } )
{
$p{name} = $DateTime::TimeZone::LINKS{ $p{name} };
@@ -72,7 +94,9 @@
die "The timezone '$p{name}' in an invalid name.\n"
unless $real_class =~ /^\w+(::\w+)*$/;
- unless ( $real_class->can('instance') )
+ $obj = $class->find($p{name});
+ unless ($obj)
+# unless ( $real_class->can('LOADED') )
{
eval "require $real_class";
@@ -90,9 +114,14 @@
die $@;
}
}
+ return $class->find($p{name});
}
- return $real_class->instance( name => $p{name}, is_olson => 1 );
+ if ($obj) {
+ $CACHE{$p{name}} = $obj;
+ }
+ return $obj;
+# return $real_class->instance( name => $p{name}, is_olson => 1 );
}
sub _init
@@ -119,7 +148,40 @@
return $self;
}
+sub register
+{
+ my $class = shift;
+ my @args = @_;
+ local $SIG{__WARN__} = sub {
+ use Data::Dumper;
+ die Dumper([EMAIL PROTECTED]);
+ };
+
+ my %args = @_;
+
+ $class->xs_register(
+ $args{name},
+ $args{is_olson} || 0,
+ $args{last_offset} || 0,
+ $args{max_year} || 0,
+ $args{has_dst_changes} || 0,
+ $args{last_observance},
+ $args{spans},
+ $args{rules}
+ );
+}
+
+BEGIN
+{
+ if (! &DateTime::TimeZone::LOADED_XS) {
+ eval <<'EOM';
sub is_olson { $_[0]->{is_olson} }
+sub name { $_[0]->{name} }
+sub max_year { $_[0]->{max_year} }
+sub has_dst_changes { 0 }
+EOM
+ }
+}
sub is_dst_for_datetime
{
@@ -127,7 +189,7 @@
my $span = $self->_span_for_datetime( 'utc', $_[0] );
- return $span->[IS_DST];
+ return $span->is_dst;
}
sub offset_for_datetime
@@ -136,7 +198,7 @@
my $span = $self->_span_for_datetime( 'utc', $_[0] );
- return $span->[OFFSET];
+ return $span->offset;
}
sub offset_for_local_datetime
@@ -145,7 +207,7 @@
my $span = $self->_span_for_datetime( 'local', $_[0] );
- return $span->[OFFSET];
+ return $span->offset;
}
sub short_name_for_datetime
@@ -154,7 +216,7 @@
my $span = $self->_span_for_datetime( 'utc', $_[0] );
- return $span->[SHORT_NAME];
+ return $span->short_name;
}
sub _span_for_datetime
@@ -165,11 +227,13 @@
my $method = $type . '_rd_as_seconds';
- my $end = $type eq 'utc' ? UTC_END : LOCAL_END;
+# my $end = $type eq 'utc' ? UTC_END : LOCAL_END;
+ my $end = $type eq 'utc' ? 'utc_end' : 'local_end';
my $span;
my $seconds = $dt->$method();
- if ( $seconds < $self->max_span->[$end] )
+
+ if ( $seconds < $self->max_span->$end )
{
$span = $self->_spans_binary_search( $type, $seconds );
}
@@ -179,6 +243,12 @@
$span = $self->_generate_spans_until_match( $until_year, $seconds,
$type );
}
+# my @data = map { $span->$_ }
+# qw(utc_start utc_end local_start local_end offset is_dst short_name);
+# use Data::Dumper;
+# print STDERR "span for ", $self->name, " -> ",
+# Dumper([EMAIL PROTECTED]);
+
# This means someone gave a local time that doesn't exist
# (like during a transition into savings time)
unless ( defined $span )
@@ -201,19 +271,23 @@
my ( $start, $end ) = _keys_for_type($type);
+ my @spans = $self->spans;
my $min = 0;
- my $max = scalar @{ $self->{spans} } + 1;
+ my $max = scalar(@spans) + 1;
my $i = int( $max / 2 );
# special case for when there are only 2 spans
$i++ if $max % 2 && $max != 3;
- $i = 0 if @{ $self->{spans} } == 1;
+ $i = 0 if @spans == 1;
while (1)
{
- my $current = $self->{spans}[$i];
+ my $current = $spans[$i];
- if ( $seconds < $current->[$start] )
+# print STDERR "seconds = $seconds, start = ",
+# $current->$start, ", end = ", $current->$end, "\n";
+
+ if ( $seconds < $current->$start )
{
$max = $i;
my $c = int( ( $i - $min ) / 2 );
@@ -223,7 +297,7 @@
return if $i < $min;
}
- elsif ( $seconds >= $current->[$end] )
+ elsif ( $seconds >= $current->$end )
{
$min = $i;
my $c = int( ( $max - $i ) / 2 );
@@ -238,20 +312,21 @@
# Special case for overlapping ranges because of DST and
# other weirdness (like Alaska's change when bought from
# Russia by the US). Always prefer latest span.
- if ( $current->[IS_DST] && $type eq 'local' )
+ if ( $current->is_dst && $type eq 'local' )
{
- my $next = $self->{spans}[$i + 1];
+ my $next = $spans[$i + 1];
+
# Sometimes we will get here and the span we're
# looking at is the last that's been generated so far.
# We need to try to generate one more or else we run
# out.
$next ||= $self->_generate_next_span;
- die "No next span in $self->{max_year}" unless defined $next;
+ die "No next span in " . $self->max_year unless defined $next;
- if ( ( ! $next->[IS_DST] )
- && $next->[$start] <= $seconds
- && $seconds <= $next->[$end]
+ if ( ( ! $next->is_dst )
+ && $next->$start <= $seconds
+ && $seconds <= $next->$end
)
{
return $next;
@@ -267,7 +342,8 @@
{
my $self = shift;
- my $last_idx = $#{ $self->{spans} };
+ my @spans = $self->spans;
+ my $last_idx = $#spans;
my $max_span = $self->max_span;
@@ -277,9 +353,9 @@
# least one more span. Of course, I will no doubt be proved wrong
# and this will cause errors.
$self->_generate_spans_until_match
- ( $self->{max_year} + 2, $max_span->[UTC_END] + ( 366 * 86400 ), 'utc'
);
+ ( $self->max_year + 2, $max_span->utc_end + ( 366 * 86400 ), 'utc' );
- return $self->{spans}[ $last_idx + 1 ];
+ return $self->max_span;
}
sub _generate_spans_until_match
@@ -290,8 +366,8 @@
my $type = shift;
my @changes;
- my @rules = @{ $self->_rules };
- foreach my $year ( $self->{max_year} .. $generate_until_year )
+ my @rules = $self->rules;
+ foreach my $year ( $self->max_year .. $generate_until_year )
{
for ( my $x = 0; $x < @rules; $x++ )
{
@@ -316,11 +392,12 @@
my $next =
$rule->utc_start_datetime_for_year
- ( $year, $self->{last_offset}, $last_offset_from_std );
+ ( $year, $self->last_offset, $last_offset_from_std );
# don't bother with changes we've seen already
- next if $next->utc_rd_as_seconds < $self->max_span->[UTC_END];
+ next if $next->utc_rd_as_seconds < $self->max_span->utc_end;
+ my $observance = $self->last_observance;
push @changes,
DateTime::TimeZone::OlsonDB::Change->new
( type => 'rule',
@@ -328,17 +405,17 @@
local_start_datetime =>
$next +
DateTime::Duration->new
- ( seconds => $self->{last_observance}->total_offset +
+ ( seconds => $observance->total_offset +
$rule->offset_from_std ),
short_name =>
- sprintf( $self->{last_observance}->format, $rule->letter
),
- observance => $self->{last_observance},
+ sprintf( $observance->format, $rule->letter ),
+ observance => $observance,
rule => $rule,
);
}
}
- $self->{max_year} = $generate_until_year;
+ $self->_set_max_year($generate_until_year);
my @sorted = sort { $a->utc_start_datetime <=> $b->utc_start_datetime }
@changes;
@@ -348,28 +425,46 @@
for ( my $x = 1; $x < @sorted; $x++ )
{
my $last_total_offset =
- $x == 1 ? $self->max_span->[OFFSET] : $sorted[ $x - 2
]->total_offset;
+ $x == 1 ? $self->max_span->offset : $sorted[ $x - 2
]->total_offset;
my $span =
DateTime::TimeZone::OlsonDB::Change::two_changes_as_span
( @sorted[ $x - 1, $x ], $last_total_offset );
- $span = _span_as_array($span);
+# print STDERR "generated span: $span->{offset}\n";
+ my $a_span = _span_as_array($span);
+# print STDERR Dumper($a_span);
+ if (&DateTime::TimeZone::LOADED_XS) {
+ $self->_push_span($a_span);
+ $match = $self->max_span
+ if $seconds >= $span->{$start} && $seconds < $span->{$end};
- push @{ $self->{spans} }, $span;
-
- $match = $span
- if $seconds >= $span->[$start] && $seconds < $span->[$end];
+# if ($match) {
+# my @fields = qw( utc_start utc_end local_start local_end offset
is_dst short_name );
+#
+# print STDERR ">> got match\n";
+# foreach my $field (@fields) {
+# print STDERR " $field = ", $match->$field, "\n";
+# }
+# }
+ } else {
+ push @{ $self->{spans} }, $a_span;
+ $match = $a_span
+ if $seconds >= $span->{$start} && $seconds < $span->{$end};
+ }
}
return $match;
}
-sub max_span { $_[0]->{spans}[-1] }
+sub max_span {
+ my @spans = $_[0]->spans;
+ $spans[-1];
+}
sub _keys_for_type
{
- $_[0] eq 'utc' ? ( UTC_START, UTC_END ) : ( LOCAL_START, LOCAL_END );
+ $_[0] eq 'utc' ? qw(utc_start utc_end) : qw(local_start local_end);
}
sub _span_as_array
@@ -381,11 +476,8 @@
sub is_utc { 0 }
-sub has_dst_changes { 0 }
+sub category { (split /\//, shift->name, 2)[0] }
-sub name { $_[0]->{name} }
-sub category { (split /\//, $_[0]->{name}, 2)[0] }
-
sub is_valid_name
{
my $tz = eval { $_[0]->new( name => $_[1] ) };
@@ -423,7 +515,7 @@
# object. This shouldn't matter since we copy the underlying
# structures by reference here, so span generation in one object
# will be visible in another also in memory.
- %$self = %$obj;
+ $$self = $$obj;
return $self;
}
=== t/02basic.t
==================================================================
--- t/02basic.t (revision 3631)
+++ t/02basic.t (local)
@@ -21,7 +21,7 @@
foreach my $name (@names)
{
my $tz = DateTime::TimeZone->new( name => $name );
- isa_ok( $tz, 'DateTime::TimeZone' );
+ isa_ok( $tz, 'DateTime::TimeZone', "Testing $name isa DateTime::TimeZone");
is( $tz->name, $name, 'check ->name' );
@@ -90,7 +90,8 @@
day => 2,
time_zone => 'UTC',
);
- is( $tz->offset_for_datetime($dt), -18000, 'generated offset should be
-1800' );
+
+ is( $tz->offset_for_datetime($dt), -18000, 'generated offset should be
-18000' );
is( $tz->short_name_for_datetime($dt), 'CDT', 'generated name should be
CDT' );
}
@@ -110,12 +111,12 @@
# max year
my $tz = DateTime::TimeZone->new( name => 'America/Los_Angeles' );
- my $dt = eval { DateTime->new( year => $tz->{max_year} + 1,
+ my $dt = eval { DateTime->new( year => $tz->max_year + 1,
month => 5,
day => 20,
time_zone => $tz
) };
- ok( $dt, 'was able to create datetime object' );
+ ok( $dt, "was able to create datetime object: $@" );
}
{
=== t/04local.t
==================================================================
--- t/04local.t (revision 3631)
+++ t/04local.t (local)
@@ -51,7 +51,7 @@
my $tz;
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
is( $@, '', 'valid time zone name in $ENV{TZ} should not die' );
- isa_ok( $tz, 'DateTime::TimeZone::Africa::Kinshasa' );
+ isa_ok( $tz, 'DateTime::TimeZone' );
}
SKIP:
@@ -72,7 +72,7 @@
my $tz;
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
is( $@, '', 'valid time zone name in /etc/localtime should not die' );
- isa_ok( $tz, 'DateTime::TimeZone::America::New_York' );
+ isa_ok( $tz, 'DateTime::TimeZone' );
}
SKIP:
@@ -93,7 +93,7 @@
my $tz;
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
is( $@, '', 'valid time zone name in /etc/sysconfig/clock should not die'
);
- isa_ok( $tz, 'DateTime::TimeZone::America::New_York' );
+ isa_ok( $tz, 'DateTime::TimeZone' );
}
SKIP:
@@ -114,7 +114,7 @@
my $tz;
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
is( $@, '', 'valid time zone name in /etc/default/init should not die' );
- isa_ok( $tz, 'DateTime::TimeZone::America::New_York' );
+ isa_ok( $tz, 'DateTime::TimeZone' );
}
SKIP:
@@ -128,7 +128,7 @@
my $tz;
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
is( $@, '', 'valid time zone name in /etc/localtime should not die' );
- isa_ok( $tz, 'DateTime::TimeZone::America::Chicago' );
+ isa_ok( $tz, 'DateTime::TimeZone' );
}
{
@@ -139,7 +139,7 @@
my $tz;
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
is( $@, '', 'valid time zone name in /etc/timezone should not die' );
- isa_ok( $tz, 'DateTime::TimeZone::America::Chicago' );
+ isa_ok( $tz, 'DateTime::TimeZone' );
}
{
@@ -154,7 +154,7 @@
my $tz;
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
is( $@, '', '/etc/default/init contains TZ=Australia/Melbourne' );
- isa_ok( $tz, 'DateTime::TimeZone::Australia::Melbourne' );
+ isa_ok( $tz, 'DateTime::TimeZone' );
}
}
@@ -183,7 +183,7 @@
my $tz;
eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
is( $@, '', 'copy of zoneinfo file at /etc/localtime' );
- isa_ok( $tz, 'DateTime::TimeZone::Asia::Calcutta' );
+ isa_ok( $tz, 'DateTime::TimeZone' );
is( Cwd::cwd(), $cwd, 'cwd should not change after finding local time
zone' );
}
=== tools/parse_olson
==================================================================
--- tools/parse_olson (revision 3631)
+++ tools/parse_olson (local)
@@ -5,6 +5,7 @@
use lib './lib';
use Data::Dumper;
+use DateTime;
use DateTime::TimeZone::OlsonDB;
use File::Copy;
use File::Find::Rule;
@@ -101,7 +102,7 @@
open MAN, ">>MANIFEST" or die "Cannot write to MANIFEST: $!";
}
-my ( @zones, %categories, %links );
+my ( @zone_init, @zones, %categories, %links );
my $autogen_warning = <<"EOF";
# This file is auto-generated by the Perl DateTime Suite time zone
@@ -165,10 +166,23 @@
$spans =~ s/('(?:start|end)_date'\s+=>\s+)'(\d+)'/$1$2/g;
- my $generator = zone_generator($zone);
+# my $generator = zone_generator($zone);
+ my @rules = $zone->infinite_rules;
+ my $rules = @rules > 0 ?
+ serialize_rules(@rules) : 'undef';
- my $has_dst_changes = grep { $_->is_dst } $zone->sorted_changes;
+ my @changes = $zone->sorted_changes;
+ my $last_observance = 'undef';
+ my $last_offset = 0;
+ if (@rules) {
+ my $observance = $changes[-1]->observance;
+ $last_observance = serialize_last_observance($observance);
+ $last_offset = $observance->total_offset;
+ }
+ my $has_dst_changes =
+ scalar(grep { $_->is_dst } @changes) > 0 ? 1 : 0;
+
my $from = "Generated from $file.";
$from .= " Olson data version $opts{version}"
if defined $opts{version};
@@ -180,30 +194,33 @@
#
# Do not edit this file directly.
#
-package DateTime::TimeZone::$mod_name;
+# package DateTime::TimeZone::$mod_name;
use strict;
-
-use Class::Singleton;
use DateTime::TimeZone;
-use DateTime::TimeZone::OlsonDB;
[EMAIL PROTECTED]::TimeZone::${mod_name}::ISA = ( 'Class::Singleton',
'DateTime::TimeZone' );
+DateTime::TimeZone->register(
+ name => "$zone_name",
+ spans => $spans,
+ rules => $rules,
+ last_observance => $last_observance,
+ is_olson => 1,
+ last_offset => $last_offset,
+ max_year => $max_year,
+ has_dst_changes => $has_dst_changes,
+);
-my \$spans =
-$spans;
+# sub has_dst_changes { $has_dst_changes }
-sub has_dst_changes { $has_dst_changes }
+# sub _max_year { $max_year }
-sub _max_year { $max_year }
+# sub _new_instance
+#{
+# return shift->_init( [EMAIL PROTECTED], spans => \$spans );
+#}
-sub _new_instance
-{
- return shift->_init( [EMAIL PROTECTED], spans => \$spans );
-}
+# \$generator
-$generator
-
1;
EOF
@@ -353,7 +370,6 @@
for ( my $x = 1; $x < @changes; $x++ )
{
my $last_total_offset = $x > 1 ? $changes[ $x - 2 ]->total_offset :
undef;
-
my $span =
DateTime::TimeZone::OlsonDB::Change::two_changes_as_span
( @changes[ $x - 1, $x ], $last_total_offset );
@@ -403,6 +419,7 @@
my $span = shift;
# must correspond to constants in DT::TZ, and short_name is always last
my @keys = qw( utc_start utc_end local_start local_end offset is_dst );
+
my $string = " [\n";
$string .= join ",\n", @[EMAIL PROTECTED];
$string .= ",\n'$span->{short_name}'";
@@ -411,6 +428,56 @@
return $string;
}
+sub serialize_rules
+{
+ my @rules = @_;
+
+ if ([EMAIL PROTECTED]) {
+ return 'undef';
+ }
+
+ my $string = "[\n # name from to type in on at save letter
offset_from_std\n";
+ $string .= join "\n", map { serialize_rule($_) } @rules;
+ $string .= "\n]";
+
+ return $string;
+}
+
+sub serialize_rule
+{
+ my $rule = shift;
+
+ my %rule = %$rule;
+ my @keys = qw(name from to type in on at save letter offset_from_std);
+ my $string = " [ ";
+ $string .= join ", ", map { length($_) ? (/\S/ ? "'$_'" : $_) : "''" }
@[EMAIL PROTECTED];
+ $string .= " ],";
+
+ return $string;
+}
+
+sub serialize_last_observance
+{
+ my $observance = shift;
+
+ # hack to trim size of dumped object
+ use Storable qw(dclone);
+ my $last = dclone($observance);
+ delete $last->{utc_start_datetime}{locale};
+ delete $last->{local_start_datetime}{locale};
+ delete $last->{utc_start_datetime}{local_c};
+ delete $last->{local_start_datetime}{local_c};
+ delete $last->{rules};
+ delete $last->{first_rule};
+
+ my $string = Dumper($last);
+
+ $string =~ s/'tz' => .+DateTime::TimeZone::Floating' \),/'tz' =>
DateTime::TimeZone::Floating->new,/sm;
+ $string =~
s/\$VAR1->{'local_start_datetime'}{'tz'}/DateTime::TimeZone::Floating->new/;
+
+ return $string;
+}
+
sub zone_generator
{
my $zone = shift;
