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