File Coverage

blib/lib/Calendar/Any.pm

Criterion	Covered	Total	%
statement	54	82	65.8
branch	6	18	33.3
condition	3	8	37.5
subroutine	17	32	53.1
pod	10	23	43.4
total	90	163	55.2

package Calendar::Any;
{
  $Calendar::Any::VERSION = '0.5';
}
use Carp;
use overload
    '<=>' => sub { $_[0]->absolute_date <=> (ref $_[1] ? $_[1]->absolute_date : $_[1]) },
    '+' => \&add,
    '-' => \&substract,
    '""' => \&date_string,
    '0+' => \&absolute_date;

sub new {
    my $_class = shift;
    my $class = ref $_class || $_class;
    my $self = {};
    bless $self, $class;
    if ( @_ ) {
        $self->{absolute} = shift;
    }
    return $self;
}

sub new_from_Astro {
    my ($self, $days) = @_;
    return $self->new($days - 1721424.5);
}

sub absolute_date {
    return shift->{absolute};
}

sub astro_date {
    return shift->absolute_date + 1721424.5;
}

sub today {
    my $self = shift;
    my @time = localtime;
    my $date = $self->new_from_Gregorian($time[4]+1, $time[3], $time[5]+1900);
    return $self->new($date->absolute_date);
}

#{{{  Format functions
our @weekday_name = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
our @month_name = qw(January February March April May June July August September October November December);
our $default_format = "%A";

sub year {
    return shift->{year};
}

sub month {
    return shift->{month};
}

sub day {
    return shift->{day};
}

sub weekday {
    return shift->{absolute} % 7;
}

sub weekday_name {
    return $weekday_name[shift->weekday];
}

sub month_name {
    return $month_name[shift->month-1];
}

sub date_string {
    my $self = shift;
    no strict;
    my $fmt = shift || ${(ref $self||$self)."::default_format"} || $default_format;
    $fmt =~ s/
              %(O?[%a-zA-Z])
             /
             ($self->can("format_$1") || sub { $1 })->($self);
             /sgeox;
    return $fmt;
}

sub format_d { sprintf("%02d", shift->day) }
sub format_m { sprintf("%02d", shift->month) }
sub format_A { shift->absolute_date }
sub format_w { shift->weekday }
sub format_W { shift->weekday_name }
sub format_M { shift->month_name }
sub format_Y { shift->year }
sub format_D {
    my $self = shift;
    return join("/", map { sprintf "%02d", $_ } $self->month, $self->day, $self->year);
}
sub format_F {
    my $self = shift;
    return join("-", map { sprintf "%02d", $_ } $self->year, $self->month, $self->day);
}
#}}}

#{{{  Overload Operators
sub substract {
    my ($self, $operand) = @_;
    if ( ref $operand ) {
        return $self->absolute_date - $operand->absolute_date;
    } else {
        return $self->new($self->absolute_date-$operand);
    }
}

sub add {
    my ($self, $operand) = @_;
    confess "operand must be numeric!\n" if ref $operand;
    $self->new($self->absolute_date + $operand);
}
#}}}

sub AUTOLOAD {
    no strict 'refs';
    our ($AUTOLOAD);
    (my $subname = $AUTOLOAD) =~ s/.*:://;
    if ( $AUTOLOAD =~ /::new_from_(\w+)/ ) {
        my $module = "Calendar::Any::" . $1;
        eval("require $module");
        if ( $@ ) {
            die "Can't load module $module: $@!\n"
        }
        my $sub = *{$subname} = sub {
            my $self = shift;
            return $module->new(@_);
        };
        goto &$sub;
    } elsif ( $AUTOLOAD =~ /::to_(\w+)/ ) {
        my $module = "Calendar::Any::" . $1;
        eval("require $module");
        if ( $@ ) {
            die "Can't load module $module: $@!\n"
        }
        my $sub = *{$subname} = sub {
            $_[0] = $module->new($_[0]->absolute_date);
            return $_[0];
        };
        goto &$sub;
    } elsif ( $AUTOLOAD =~ /DESTROY/) {
    } else {
        die "Unknown function $AUTOLOAD\n";
    }
}

1;

__END__