view release on metacpan or  search on metacpan

Pcalendar.pm  view on Meta::CPAN

###############################################################################
##                                                                           ##
##    Copyright (c) 2000 - 2009 by Steffen Beyer.                            ##
##    All rights reserved.                                                   ##
##                                                                           ##
##    This package is free software; you can redistribute it                 ##
##    and/or modify it under the same terms as Perl itself.                  ##
##                                                                           ##
###############################################################################

package Date::Pcalendar;

BEGIN { eval { require bytes; }; }
use strict;
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );

require Exporter;

@ISA = qw(Exporter);

@EXPORT = qw();

@EXPORT_OK = qw();

$VERSION = '6.1';

use Carp::Clan qw(^Date::);
use Date::Pcalc::Object qw(:ALL);
use Date::Pcalendar::Year qw( check_year empty_period );

sub new
{
    my($class)    = shift;
    my($profile)  = shift;
    my($language) = shift || 0;
    my($self);

    $self = [ ];
    $class = ref($class) || $class || 'Date::Pcalendar';
    bless($self, $class);
    $self->[0] = { };
    $self->[1] = $profile;
    $self->[2] = $language;
    $self->[3] = [@_];
    return $self;
}

sub year
{
    my($self) = shift;
    my($year) = shift_year(\@_);

    &check_year($year);
    if (defined $self->[0]{$year})
    {
        return $self->[0]{$year};
    }
    else
    {
        return $self->[0]{$year} =
            Date::Pcalendar::Year->new( $year, $self->[1], $self->[2], @{$self->[3]} );
    }
}

sub cache_keys
{
    my($self) = shift;

    return( sort {$a<=>$b} keys(%{$self->[0]}) );
}

sub cache_vals
{
    my($self) = shift;
    local($_);

    return( map $self->[0]{$_}, sort {$a<=>$b} keys(%{$self->[0]}) );
}

sub cache_clr
{
    my($self) = shift;

    $self->[0] = { };
}

sub cache_add
{
    my($self) = shift;
    my($year);

    while (@_)
    {
        $year = shift_year(\@_);
        $self->year($year);
    }
}

sub cache_del
{
    my($self) = shift;
    my($year);

    while (@_)
    {
        $year = shift_year(\@_);
        if (exists $self->[0]{$year})
        {
            delete $self->[0]{$year};
        }
    }
}

sub date2index
{
    my($self) = shift;
    my(@date) = shift_date(\@_);

    return $self->year($date[0])->date2index(@date);
}