"Fossies" - the Fresh Open Source Software Archive

Member "Date-Calc-6.4/lib/Date/Calendar.pm" (7 Mar 2015, 6519 Bytes) of package /linux/privat/Date-Calc-6.4.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Calendar.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 6.3_vs_6.4.

    1 
    2 ###############################################################################
    3 ##                                                                           ##
    4 ##    Copyright (c) 2000 - 2015 by Steffen Beyer.                            ##
    5 ##    All rights reserved.                                                   ##
    6 ##                                                                           ##
    7 ##    This package is free software; you can redistribute it                 ##
    8 ##    and/or modify it under the same terms as Perl itself.                  ##
    9 ##                                                                           ##
   10 ###############################################################################
   11 
   12 package Date::Calendar;
   13 
   14 BEGIN { eval { require bytes; }; }
   15 use strict;
   16 use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );
   17 
   18 require Exporter;
   19 
   20 @ISA = qw(Exporter);
   21 
   22 @EXPORT = qw();
   23 
   24 @EXPORT_OK = qw();
   25 
   26 $VERSION = '6.4';
   27 
   28 use Carp::Clan qw(^Date::);
   29 use Date::Calc::Object qw(:ALL);
   30 use Date::Calendar::Year qw( check_year empty_period );
   31 
   32 sub new
   33 {
   34     my($class)    = shift;
   35     my($profile)  = shift;
   36     my($language) = shift || 0;
   37     my($self);
   38 
   39     $self = [ ];
   40     $class = ref($class) || $class || 'Date::Calendar';
   41     bless($self, $class);
   42     $self->[0] = { };
   43     $self->[1] = $profile;
   44     $self->[2] = $language;
   45     $self->[3] = [@_];
   46     return $self;
   47 }
   48 
   49 sub year
   50 {
   51     my($self) = shift;
   52     my($year) = shift_year(\@_);
   53 
   54     &check_year($year);
   55     if (defined $self->[0]{$year})
   56     {
   57         return $self->[0]{$year};
   58     }
   59     else
   60     {
   61         return $self->[0]{$year} =
   62             Date::Calendar::Year->new( $year, $self->[1], $self->[2], @{$self->[3]} );
   63     }
   64 }
   65 
   66 sub cache_keys
   67 {
   68     my($self) = shift;
   69 
   70     return( sort {$a<=>$b} keys(%{$self->[0]}) );
   71 }
   72 
   73 sub cache_vals
   74 {
   75     my($self) = shift;
   76     local($_);
   77 
   78     return( map $self->[0]{$_}, sort {$a<=>$b} keys(%{$self->[0]}) );
   79 }
   80 
   81 sub cache_clr
   82 {
   83     my($self) = shift;
   84 
   85     $self->[0] = { };
   86 }
   87 
   88 sub cache_add
   89 {
   90     my($self) = shift;
   91     my($year);
   92 
   93     while (@_)
   94     {
   95         $year = shift_year(\@_);
   96         $self->year($year);
   97     }
   98 }
   99 
  100 sub cache_del
  101 {
  102     my($self) = shift;
  103     my($year);
  104 
  105     while (@_)
  106     {
  107         $year = shift_year(\@_);
  108         if (exists $self->[0]{$year})
  109         {
  110             delete $self->[0]{$year};
  111         }
  112     }
  113 }
  114 
  115 sub date2index
  116 {
  117     my($self) = shift;
  118     my(@date) = shift_date(\@_);
  119 
  120     return $self->year($date[0])->date2index(@date);
  121 }
  122 
  123 sub labels
  124 {
  125     my($self) = shift;
  126     my($year);
  127     my(@date);
  128     my(%result);
  129 
  130     if (@_)
  131     {
  132         @date = shift_date(\@_);
  133         return $self->year($date[0])->labels(@date);
  134     }
  135     else
  136     {
  137         local($_);
  138         %result = ();
  139         foreach $year (keys(%{$self->[0]}))
  140         {
  141             grep( $result{$_} = 0, $self->year($year)->labels() );
  142         }
  143         return wantarray ? (keys %result) : scalar(keys %result);
  144     }
  145 }
  146 
  147 sub search
  148 {
  149     my($self,$pattern) = @_;
  150     my($year);
  151     my(@result);
  152 
  153     @result = ();
  154     foreach $year (sort {$a<=>$b} keys(%{$self->[0]}))
  155     {
  156         push( @result, $self->year($year)->search($pattern) );
  157     }
  158     return wantarray ? (@result) : scalar(@result);
  159 }
  160 
  161 sub tags
  162 {
  163     my($self) = shift;
  164     my(%result) = ();
  165     my(@date);
  166 
  167     if (@_)
  168     {
  169         @date = shift_date(\@_);
  170         return $self->year($date[0])->tags(@date);
  171     }
  172     else { return \%result; }
  173 }
  174 
  175 sub delta_workdays
  176 {
  177     my($self)                   =  shift;
  178     my($yy1,$mm1,$dd1)          =  shift_date(\@_);
  179     my($yy2,$mm2,$dd2)          =  shift_date(\@_);
  180     my($including1,$including2) = (shift,shift);
  181     my($days,$empty,$year);
  182 
  183     $days = 0;
  184     $empty = 1;
  185     if ($yy1 == $yy2)
  186     {
  187         return $self->year($yy1)->delta_workdays(
  188             $yy1,$mm1,$dd1, $yy2,$mm2,$dd2, $including1,$including2);
  189     }
  190     elsif ($yy1 < $yy2)
  191     {
  192         unless (($mm1 == 12) && ($dd1 == 31) && (!$including1))
  193         {
  194             $days += $self->year($yy1)->delta_workdays(
  195                 $yy1,$mm1,$dd1, $yy1,12,31, $including1,1);
  196             $empty = 0;
  197         }
  198         unless (($mm2 ==  1) && ($dd2 ==  1) && (!$including2))
  199         {
  200             $days += $self->year($yy2)->delta_workdays(
  201                 $yy2, 1, 1, $yy2,$mm2,$dd2, 1,$including2);
  202             $empty = 0;
  203         }
  204         for ( $year = $yy1 + 1; $year < $yy2; $year++ )
  205         {
  206             $days += $self->year($year)->delta_workdays(
  207                 $year,1,1, $year,12,31, 1,1);
  208             $empty = 0;
  209         }
  210     }
  211     else
  212     {
  213         unless (($mm2 == 12) && ($dd2 == 31) && (!$including2))
  214         {
  215             $days -= $self->year($yy2)->delta_workdays(
  216                 $yy2,$mm2,$dd2, $yy2,12,31, $including2,1);
  217             $empty = 0;
  218         }
  219         unless (($mm1 ==  1) && ($dd1 ==  1) && (!$including1))
  220         {
  221             $days -= $self->year($yy1)->delta_workdays(
  222                 $yy1, 1, 1, $yy1,$mm1,$dd1, 1,$including1);
  223             $empty = 0;
  224         }
  225         for ( $year = $yy2 + 1; $year < $yy1; $year++ )
  226         {
  227             $days -= $self->year($year)->delta_workdays(
  228                 $year,1,1, $year,12,31, 1,1);
  229             $empty = 0;
  230         }
  231     }
  232     &empty_period() if ($empty);
  233     return $days;
  234 }
  235 
  236 sub add_delta_workdays
  237 {
  238     my($self)       = shift;
  239     my($yy,$mm,$dd) = shift_date(\@_);
  240     my($days)       = shift;
  241     my($date,$rest,$sign);
  242 
  243     if ($days == 0)
  244     {
  245         $rest = $self->year($yy)->date2index($yy,$mm,$dd); # check date
  246         $date = Date::Calc->new($yy,$mm,$dd);
  247         return wantarray ? ($date,$days) : $date;
  248     }
  249     else
  250     {
  251         $sign = ($days > 0) ? +1 : -1;
  252         ($date,$rest,$sign) = $self->year($yy)->add_delta_workdays($yy,$mm,$dd,$days,$sign);
  253         while ($sign)
  254         {
  255             ($date,$rest,$sign) = $self->year($date)->add_delta_workdays($date,$rest,$sign);
  256         }
  257         return wantarray ? ($date,$rest) : $date;
  258     }
  259 }
  260 
  261 sub is_full
  262 {
  263     my($self) = shift;
  264     my(@date) = shift_date(\@_);
  265     my($year) = $self->year($date[0]);
  266 
  267     return $year->vec_full->bit_test( $year->date2index(@date) );
  268 }
  269 
  270 sub is_half
  271 {
  272     my($self) = shift;
  273     my(@date) = shift_date(\@_);
  274     my($year) = $self->year($date[0]);
  275 
  276     return $year->vec_half->bit_test( $year->date2index(@date) );
  277 }
  278 
  279 sub is_work
  280 {
  281     my($self) = shift;
  282     my(@date) = shift_date(\@_);
  283     my($year) = $self->year($date[0]);
  284 
  285     return $year->vec_work->bit_test( $year->date2index(@date) );
  286 }
  287 
  288 1;
  289 
  290 __END__
  291