File Coverage

blib/lib/DateTime/LazyInit.pm

Criterion	Covered	Total	%
statement	87	124	70.1
branch	14	40	35.0
condition			n/a
subroutine	34	45	75.5
pod	15	27	55.5
total	150	236	63.5

package DateTime::LazyInit;

use strict;
use warnings;

use DateTime;
use vars qw/$AUTOLOAD $VERSION $VERBOSE/;


# DEVELOPER NOTE:
# We have to force these methods to inflate as the overloads were only forcing
# $_[0] to inflate properly.

use overload (
	'fallback' => 1,
	'<=>'      => sub {
						$_[0]->inflate() if ref($_[0]) =~ /^DateTime::LazyInit/;
						$_[1]->inflate() if ref($_[1]) =~ /^DateTime::LazyInit/;
						shift->_compare_overload(@_);
					},
	'cmp'      => sub {
						$_[0]->inflate() if ref($_[0]) =~ /^DateTime::LazyInit/;
						$_[1]->inflate() if ref($_[1]) =~ /^DateTime::LazyInit/;
						shift->_compare_overload(@_);
					},
	'""'       => sub {
						$_[0]->inflate() if ref($_[0]) =~ /^DateTime::LazyInit/;
						$_[1]->inflate() if ref($_[1]) =~ /^DateTime::LazyInit/;
						shift->_stringify(@_);
					},
	'-'        => sub {
						$_[0]->inflate() if ref($_[0]) =~ /^DateTime::LazyInit/;
						$_[1]->inflate() if ref($_[1]) =~ /^DateTime::LazyInit/;
						shift->_subtract_overload(@_)
					},
	'+'        => sub {
						$_[0]->inflate() if ref($_[0]) =~ /^DateTime::LazyInit/;
						$_[1]->inflate() if ref($_[1]) =~ /^DateTime::LazyInit/;
						shift->_add_overload(@_)
					},
);


$VERSION = '1.0200';

$VERBOSE = 0; # Set to non-0 to 'warn' every time an object inflates

sub new {
	my $class = shift;

	# NO VALIDATION
	# We'll accept your grandmother if you pass her to us.
	my %args = @_;

	return bless \%args, 'DateTime::LazyInit::Constructor_new';
}

{
	package DateTime::LazyInit::Constructor_new;
	use vars qw/@ISA/;
	@ISA = qw/DateTime::LazyInit/;
}

sub from_epoch {
	my $class = shift;

	# NO VALIDATION
	# We'll accept your grandmother if you pass her to us.
	my %args = @_;

	return bless \%args, 'DateTime::LazyInit::Constructor_from_epoch';
}

{
	package DateTime::LazyInit::Constructor_from_epoch;
	use vars qw/@ISA/;
	@ISA = qw/DateTime::LazyInit/;
}

sub now {
	my $class = shift;

	# NO VALIDATION
	# We'll accept your grandmother if you pass her to us.
	my %args = @_;

	return bless \%args, 'DateTime::LazyInit::Constructor_now';
}

{
	package DateTime::LazyInit::Constructor_now;
	use vars qw/@ISA/;
	@ISA = qw/DateTime::LazyInit/;
}

sub today {
	my $class = shift;

	# NO VALIDATION
	# We'll accept your grandmother if you pass her to us.
	my %args = @_;

	return bless \%args, 'DateTime::LazyInit::Constructor_today';
}

{
	package DateTime::LazyInit::Constructor_today;
	use vars qw/@ISA/;
	@ISA = qw/DateTime::LazyInit/;
}

sub from_object {
	my $class = shift;

	# NO VALIDATION
	# We'll accept your grandmother if you pass her to us.
	my %args = @_;

	return bless \%args, 'DateTime::LazyInit::Constructor_from_object';
}

{
	package DateTime::LazyInit::Constructor_from_object;
	use vars qw/@ISA/;
	@ISA = qw/DateTime::LazyInit/;
}

sub last_day_of_month {
	my $class = shift;

	# NO VALIDATION
	# We'll accept your grandmother if you pass her to us.
	my %args = @_;

	return bless \%args, 'DateTime::LazyInit::Constructor_last_day_of_month';
}

{
	package DateTime::LazyInit::Constructor_last_day_of_month;
	use vars qw/@ISA/;
	@ISA = qw/DateTime::LazyInit/;
}

sub from_day_of_year {
	my $class = shift;

	# NO VALIDATION
	# We'll accept your grandmother if you pass her to us.
	my %args = @_;

	return bless \%args, 'DateTime::LazyInit::Constructor_from_day_of_year';
}

{
	package DateTime::LazyInit::Constructor_from_day_of_year;
	use vars qw/@ISA/;
	@ISA = qw/DateTime::LazyInit/;
}


sub AUTOLOAD {

	my $attr = $AUTOLOAD;
	$attr =~ s/.*:://;
    return unless $attr =~ /[^A-Z]/;  # skip DESTROY and all-cap methods

	# Anything else, we need to inflate into a DateTime object.
	return shift->inflate($attr, @_);
}

# Simple set and get for year

sub set_year {
        $_[0]->{year} = $_[1];
        return $_[0];
}

sub year {
        return $_[0]->{year} if $_[0]->{year};
        return 0;
}



# Simple set and get for month

sub set_month {
        $_[0]->{month} = $_[1];
        return $_[0];
}

sub month {
        return $_[0]->{month} if $_[0]->{month};
        return 1;
}



# Simple set and get for day

sub set_day {
        $_[0]->{day} = $_[1];
        return $_[0];
}

sub day {
        return $_[0]->{day} if $_[0]->{day};
        return 1;
}



# Simple set and get for hour

sub set_hour {
        $_[0]->{hour} = $_[1];
        return $_[0];
}

sub hour {
        return $_[0]->{hour} if $_[0]->{hour};
        return 0;
}



# Simple set and get for minute

sub set_minute {
        $_[0]->{minute} = $_[1];
        return $_[0];
}

sub minute {
        return $_[0]->{minute} if $_[0]->{minute};
        return 0;
}



# Simple set and get for second

sub set_second {
        $_[0]->{second} = $_[1];
        return $_[0];
}

sub second {
        return $_[0]->{second} if $_[0]->{second};
        return 0;
}



# Simple set and get for nanosecond

sub set_nanosecond {
        $_[0]->{nanosecond} = $_[1];
        return $_[0];
}

sub nanosecond {
        return $_[0]->{nanosecond} if $_[0]->{nanosecond};
        return 0;
}



# Simple set for locale

sub set_locale {
        $_[0]->{locale} = $_[1];
        return $_[0];
}



# Simple set for time_zone

sub set_time_zone {
        $_[0]->{time_zone} = $_[1];
        return $_[0];
}



sub set {
	my $self = shift;
	my %attr = @_;
	foreach (keys %attr) {
		$self->{$_} = $attr{$_}
	}
	return $self;
}



sub clone {
	return ref($_[0])->new( %{$_[0]} );
}



# These methods inflate, they're just here so that UNVERSAL::can will work
# if you find any other methods that need to be here, please email
# the author  or the mailing list

sub utc_rd_values {
	shift->inflate('utc_rd_values',@_);
}


# This is the inflator
sub inflate {
	(my $constructor) = ref($_[0]) =~ /Constructor_(.+)$/;
	$_[0] = bless \%{DateTime->$constructor(%{$_[0]})}, 'DateTime';
	warn("Inflating $_[0].\n") if $VERBOSE;
	# And call the method on that
	my $self = shift;
	my ($method) = shift;
	return ($method) ? $self->$method( @_ ) : $self;
}


1;
__END__