File Coverage

blib/lib/Date/Passover.pm
Criterion Covered Total %
statement 49 56 87.5
branch 7 16 43.7
condition 3 21 14.2
subroutine 10 10 100.0
pod 0 2 0.0
total 69 105 65.7


line stmt bran cond sub pod time code
1             #$Header: /home/cvs/date-passover/lib/Date/Passover.pm,v 1.10 2002/08/30 00:06:51 rbowen Exp $
2             package Date::Passover;
3 2     2   53692 use Date::GoldenNumber;
  2         4  
  2         128  
4 2     2   1711 use Date::DayOfWeek;
  2         4524  
  2         100  
5 2     2   1917 use Date::ICal;
  2         27245  
  2         61  
6 2     2   20 use Carp;
  2         4  
  2         118  
7 2     2   31 use strict;
  2         4  
  2         75  
8              
9             BEGIN {
10 2     2   10 use Exporter ();
  2         3  
  2         44  
11 2     2   10 use vars qw ($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  2         4  
  2         228  
12 2     2   5 $VERSION = (qw'$Revision: 1.10 $')[1];
13 2         30 @ISA = qw (Exporter);
14 2         6 @EXPORT = qw (passover roshhashanah);
15 2         2 @EXPORT_OK = qw ();
16 2         707 %EXPORT_TAGS = ();
17             }
18              
19             =head1 NAME
20              
21             Date::Passover - When is Passover? When is Rosh Hashanah?
22              
23             =head1 SYNOPSIS
24              
25             use Date::Passover;
26              
27             ($month, $day ) = roshhashanah( 1997 );
28             $date_ical_obj = roshhashahah( 1997 );
29              
30             ( $month, $day ) = passover( 1997 );
31             $date_ical_obj = passover( 1997 );
32              
33             =head1 DESCRIPTION
34              
35             Calculate the date of Passover or Rosh Hashanah for any given year.
36              
37             =head1 BUGS
38              
39             None yet, but I expect I'll take care of that pretty soon.
40              
41             =head1 SUPPORT
42              
43             Email the author, or post to the datetime@perl.org mailing list.
44              
45             =head1 AUTHOR
46              
47             Rich Bowen
48             CPAN ID: RBOW
49             rbowen@rcbowen.com
50             http://www.rcbowen.com
51              
52             =head1 COPYRIGHT
53              
54             Copyright (c) 2001 Rich Bowen. All rights reserved.
55             This program is free software; you can redistribute
56             it and/or modify it under the same terms as Perl itself.
57              
58             The full text of the license can be found in the
59             LICENSE file included with this module.
60              
61             =head1 SEE ALSO
62              
63             perl(1)
64             Date::ICal
65             Date::Easter
66             Reefknot ( http://reefknot.org/ )
67              
68             =cut
69              
70             sub passover {
71 1     1 0 8 my $year = shift;
72 1         6 my $date = roshhashanah($year);
73              
74 1         180 my $m;
75 1 50       5 if ($date->month == 9) {
76 1         28 $m = $date->day;
77             } else {
78 0         0 $m = 30 + $date->day;
79             }
80              
81 1         17 my $passover = Date::ICal->new( month=>3, day=>21, year =>$year );
82 1         104 $passover ->add( day => $m );
83              
84              
85 1 50       24 if (wantarray) {
86 1         4 return ($passover->month, $passover->day);
87             } else {
88 0         0 return $passover;
89             }
90             }
91              
92             sub roshhashanah{
93 2     2 0 11 my $year = shift;
94              
95             # For the moment, we are limited to 1900 - 2099
96 2 50 33     17 if ( $year < 1900 || $year > 2099 ) {
97 0         0 carp "Can't calculate Rosh Hashanah for dates before 1900 or
98             after 2099. Please check back in a version or two";
99             }
100            
101 2         13 my $g = golden( $year );
102 2         6 my $y = $year - 1900;
103              
104 2         12 my $day = 6.057778996 + 1.554241797*((12 * $g )%19) + 0.25*($y%4)
105             - 0.003177794*$y;
106              
107             # Do we have to postpone?
108             # Warning: Many magic numbers
109 2         12 my $dow = dayofweek( $day, 9, $year );
110 2 50 33     107 if ( $dow == 0 || $dow == 3 || $dow == 5 ) {
    0 33        
    0 0        
      0        
      0        
      0        
111 2         5 $day ++;
112             } elsif ( ( $dow == 1 ) && ( ($day - (int($day))) >= 1367/2160 )
113             && ( ( (12 * $g )%19 ) > 11 ) ) {
114 0         0 $day ++;
115             } elsif ( ( $dow == 2 ) && ( $day - (int($day)) >= 1367/2160 )
116             && ( ( (12*$g) % 19) > 6 )) {
117 0         0 $day += 2;
118             }
119              
120 2         3 $day = int($day);
121 2         6 my $month = 9;
122 2 50       8 if ( $day > 30 ) {
123 0         0 $day -= 29;
124 0         0 $month++;
125             }
126              
127 2 100       25 if (wantarray) {
128 1         4 return ( $month, int($day) );
129             } else {
130 1         12 return Date::ICal->new( month => $month, day => $day, year =>
131             $year);
132             }
133             }
134              
135              
136             1;
137              
138