At 3:42 pm -0600 2004-02-21, Dave Rolsky wrote:
I think the problem is that Data::Dumper has historically had two
orthogonal uses.  One was serializing data structures for persistence, ala
Storable, and the other was for debugging.

Nowadays, I'm guessing most people use Storable for the first, and so it's
probably used more for debugging.  But just dumping the structure as is
may not be ideal for debugging.

So I suspect what we really need is something like Data::DebugDumper or
something like that, which is _only_ used for debugging.  Is there already
something on CPAN that might be suitable for this?

But this is way OT for this list.


Back on Topic, below is the module I use for dumping ... if people are interested I don't mind releasing it. Basically I summarise some of the long parts of the dump as strings. If you pass it anything but a DateTime object the module just passes it onto Data::Dumper.



package DateTime::Util::Dumper;

# Dumper for DateTime objects

use strict;
use Data::Dumper qw//;


sub Dump { my $dt = shift; return Data::Dumper::Dumper($dt) unless (ref($dt)=~/DateTime/ and $dt->isa('DateTime'));

        my $dtdata = $dt->clone;
        $dtdata->{tz} = $dtdata->{tz}->name;

$dtdata->{locale} = $dtdata->{locale}->id;

        return Data::Dumper::Dumper($dtdata);
}

sub Dump_Locale {
        my $dt = shift;
        return Data::Dumper::Dumper($dt) unless
                (ref($dt)=~/DateTime/ and $dt->isa('DateTime'));

my $locale = $dt->clone->{locale};

        return Data::Dumper::Dumper($locale);
}

sub Dump_TZ {
        my $dt = shift;
        return Data::Dumper::Dumper($dt) unless
                (ref($dt)=~/DateTime/ and $dt->isa('DateTime'));

my $dtdata = $dt->clone->{tz};

$dtdata->{spans} = scalar( @{$dtdata->{spans}} ) . ' spans in original object';
$dtdata->{rules} = scalar( @{$dtdata->{rules}} ) . ' rules in original object';
$dtdata->{last_observance}->{local_start_datetime} = _render_observance($dtdata->{last_observance}->{local_start_datetime});
$dtdata->{last_observance}->{utc_start_datetime} = _render_observance($dtdata->{last_observance}->{utc_start_datetime});


        return Data::Dumper::Dumper($dtdata);
}

sub Dump_TZ_rules {
        my $dt = shift;
        return Data::Dumper::Dumper($dt) unless
                (ref($dt)=~/DateTime/ and $dt->isa('DateTime'));
        return Data::Dumper::Dumper( $dt->{tz}->{rules} );
}

sub Dump_TZ_spans {
        my $dt = shift;
        return Data::Dumper::Dumper($dt) unless
                (ref($dt)=~/DateTime/ and $dt->isa('DateTime'));

my $spans = $dt->clone->{tz}->{spans};

        foreach my $span (@$spans) {
                $span = _render_span($span);
        }

        return Data::Dumper::Dumper( $spans );
}



sub _render_observance {
        my $obs = shift;

    if ( $obs->{tz}->is_utc || $obs->{tz}->is_floating )
    {
        $obs->{local_rd_days} = $obs->{utc_rd_days};
        $obs->{local_rd_secs} = $obs->{utc_rd_secs};
    }
    else
    {
        $obs->{local_rd_days} = $obs->{utc_rd_days};
        $obs->{local_rd_secs} = $obs->{utc_rd_secs} + $obs->offset;

# intentionally ignore leap seconds here
$obs->_normalize_tai_seconds( $obs->{local_rd_days}, $obs->{local_rd_secs} );
}


$obs->_calc_local_components;
return $obs->datetime;
}


sub _render_span {
my $span = shift;
my ($utc_start, $utc_end, $local_start, $local_end, $offset, $is_dst, $shortname) = @$span;


        return {
                utc_start   => _render_rd($utc_start),
                utc_end     => _render_rd($utc_end),
                local_start => _render_rd($local_start),
                local_end   => _render_rd($local_end),
                is_dst      => $is_dst,
                shortname   => $shortname,
        }
}

sub _render_rd {
        my $rd = shift;

        my $days = int($rd / (24*60*60));
        my $secs = $rd - ($days * 24*60*60);

        my $obj = bless( {
                local_rd_days => $days,
                local_rd_secs => $secs,
                utc_rd_days => $days,
                utc_rd_secs => $secs,
                tz => DateTime::TimeZone->new(name=>'floating'),
        }, 'DateTime');

        return _render_observance($obj);
}

__END__


-- -------------------------------------------------------- There are 10 kinds of people: those that understand binary, and those that don't. -------------------------------------------------------- The day Microsoft makes something that doesn't suck is the day they start selling vacuum cleaners -------------------------------------------------------- "Write a wise proverb and your name will live forever." -- Anonymous --------------------------------------------------------

Reply via email to