File Coverage

blib/lib/Date/Hebrew/Simple.pm
Criterion Covered Total %
statement 111 137 81.0
branch 35 64 54.6
condition 19 48 39.5
subroutine 24 25 96.0
pod 6 16 37.5
total 195 290 67.2


line stmt bran cond sub pod time code
1             package Date::Hebrew::Simple;
2              
3             $Date::Hebrew::Simple::VERSION = '0.14';
4             $Date::Hebrew::Simple::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Date::Hebrew::Simple - Represents Hebrew date.
9              
10             =head1 VERSION
11              
12             Version 0.14
13              
14             =cut
15              
16 2     2   137325 use 5.006;
  2         17  
17 2     2   1226 use Data::Dumper;
  2         13618  
  2         165  
18 2     2   876 use Time::localtime;
  2         9598  
  2         114  
19 2     2   1050 use POSIX qw/floor ceil/;
  2         12844  
  2         11  
20 2     2   3922 use Date::Calc qw/Delta_Days/;
  2         15973  
  2         170  
21 2     2   976 use Date::Exception::InvalidMonth;
  2         134911  
  2         80  
22              
23 2     2   17 use Moo;
  2         5  
  2         13  
24 2     2   676 use namespace::autoclean;
  2         4  
  2         11  
25              
26 2     2   161 use overload q{""} => 'as_string', fallback => 1;
  2         4  
  2         44  
27              
28             =head1 DESCRIPTION
29              
30             Represents the Hebrew date.
31              
32             =cut
33              
34             our $HEBREW_MONTHS = [
35             '',
36             'Nisan', 'Iyar', 'Sivan', 'Tammuz', 'Av', 'Elul',
37             'Tishrei', 'Cheshvan', 'Kislev', 'Tevet', 'Shevat', 'Adar',
38             ];
39              
40             our $HEBREW_DAYS = [
41             'Yom Rishon', 'Yom Sheni', 'Yom Shelishi', 'Yom Revil',
42             'Yom Hamishi', 'Yom Shishi', 'Shabbat',
43             ];
44              
45             has hebrew_epoch => (is => 'ro', default => sub { 347995.5 });
46             has days => (is => 'ro', default => sub { $HEBREW_DAYS });
47             has months => (is => 'ro', default => sub { $HEBREW_MONTHS });
48              
49             has year => (is => 'rw', predicate => 1);
50             has month => (is => 'rw', predicate => 1);
51             has day => (is => 'rw', predicate => 1);
52              
53             with 'Date::Utils';
54              
55             sub BUILD {
56 3     3 0 20 my ($self) = @_;
57              
58 3 50       22 $self->validate_year($self->year) if $self->has_year;
59 3 50       74 $self->validate_hebrew_month($self->month) if $self->has_month;
60 3 50       19 $self->validate_day($self->day) if $self->has_day;
61              
62 3 50 33     84 unless ($self->has_year && $self->has_month && $self->has_day) {
      33        
63 0         0 my $today = localtime;
64 0         0 my $year = $today->year + 1900;
65 0         0 my $month = $today->mon + 1;
66 0         0 my $day = $today->mday;
67 0         0 my $date = $self->from_gregorian($year, $month, $day);
68 0         0 $self->year($date->year);
69 0         0 $self->month($date->month);
70 0         0 $self->day($date->day);
71             }
72             }
73              
74             =head1 SYNOPSIS
75              
76             use strict; use warnings;
77             use Date::Hebrew::Simple;
78              
79             # prints today's Hebrew date.
80             print Date::Hebrew::Simple->new, "\n";
81              
82             my $date = Date::Hebrew::Simple->new({ year => 5778, month => 11, day => 1 });
83              
84             # prints the given Hebrew date
85             print $date->as_string, "\n";
86              
87             # prints the equivalent Julian day
88             print $date->to_julian, "\n";
89              
90             # prints the equivalent Gregorian date
91             print sprintf("%04d-%02d-%02d", $date->to_gregorian), "\n";
92              
93             # prints day of the week index (0 for Yom Rishon, 1 for Yom Sheni and so on).
94             print $date->day_of_week, "\n";
95              
96             # prints the Hebrew date equivalent of the Gregorian date (2018-02-12).
97             print $date->from_gregorian(2018, 02, 12), "\n";
98              
99             # prints the Hebrew date equivalent of the Julian day (2458134.5).
100             print $date->from_julian(2458134.5), "\n";
101              
102             =head1 METHODS
103              
104             =head2 to_julian()
105              
106             Returns julian day equivalent of the Hebrew date.
107              
108             =cut
109              
110             sub to_julian {
111 79     79 1 139 my ($self, $year, $month, $day) = @_;
112              
113 79 100       143 $day = $self->day unless defined $day;
114 79 100       138 $month = $self->month unless defined $month;
115 79 100       128 $year = $self->year unless defined $year;
116 79         134 my $months = $self->months_in_year($year);
117 79         169 my $julian_day = $self->hebrew_epoch + $self->delay_1($year) + $self->delay_2($year) + $day + 1;
118              
119 79 100       142 if ($month < 7) {
120 2         6 for (my $m = 7; $m <= $months; $m++) {
121 12         20 $julian_day += $self->days_in_month_year($m, $year);
122             }
123 2         8 for (my $m = 1; $m < $month; $m++) {
124 0         0 $julian_day += $self->days_in_month_year($m, $year);
125             }
126             }
127             else {
128 77         150 for (my $m = 7; $m < $month; $m++) {
129 40         72 $julian_day += $self->days_in_month_year($m, $year);
130             }
131             }
132              
133 79         222 return $julian_day;
134             }
135              
136             =head2 from_julian($julian_day)
137              
138             Returns Hebrew date as an object of type L equivalent of the
139             the Julian date C<$julian_day>.
140              
141             =cut
142              
143             sub from_julian {
144 2     2 1 8836 my ($self, $julian_day) = @_;
145              
146 2         7 $julian_day = floor($julian_day) + 0.5;
147              
148 2         11 my $count = floor((($julian_day - $self->hebrew_epoch) * 98496.0) / 35975351.0);
149 2         5 my $year = $count - 1;
150 2         7 for (my $i = $count; $julian_day >= $self->to_julian($i, 7, 1); $i++) {
151 4         10 $year++;
152             }
153              
154 2 50       5 my $first = ($julian_day < $self->to_julian($year, 1, 1)) ? (7) : (1);
155 2         3 my $month = $first;
156 2         7 for (my $m = $first; $julian_day > $self->to_julian($year, $m, $self->days_in_month_year($m, $year)); $m++) {
157 8         17 $month++;
158             }
159              
160 2         5 my $day = ($julian_day - $self->to_julian($year, $month, 1)) + 1;
161 2         59 return Date::Hebrew::Simple->new({ year => $year, month => $month, day => $day });
162             }
163              
164             =head2 to_gregorian()
165              
166             Returns gregorian date as list (yyyy,mm,dd) equivalent of the Hebrew date.
167              
168             =cut
169              
170             sub to_gregorian {
171 1     1 1 5 my ($self) = @_;
172              
173 1         3 return $self->julian_to_gregorian($self->to_julian);
174             }
175              
176             =head2 from_gregorian($year, $month, $day)
177              
178             Returns Hebrew date as an object of type L equivalent of the
179             given Gregorian date C<$year>, C<$month> and C<$day>.
180              
181             =cut
182              
183             sub from_gregorian {
184 1     1 1 1592 my ($self, $year, $month, $day) = @_;
185              
186 1         7 $self->validate_date($year, $month, $day);
187 1         50 my $julian_day = $self->gregorian_to_julian($year, $month, $day) + (floor(0 + 60 * (0 + 60 * 0) + 0.5) / 86400.0);
188 1         17 return $self->from_julian($julian_day);
189             }
190              
191             =head2 day_of_week()
192              
193             Returns day of the week, starting 0 for Yom Rishon, 1 for Yom Sheni and so on.
194              
195             +-------+---------------+---------------------------------------------------+
196             | Index | Hebrew Name | English Name |
197             +-------+---------------+---------------------------------------------------+
198             | 0 | Yom Rishon | Sunday |
199             | 1 | Yom Sheni | Monday |
200             | 2 | Yom Shelishi | Tuesday |
201             | 3 | Yom Revil | Wednesday |
202             | 4 | Yom Hamishi | Thursday |
203             | 5 | Yom Shishi | Friday |
204             | 6 | Shabbat | Saturday |
205             +-------+---------------+---------------------------------------------------+
206              
207             =cut
208              
209             sub day_of_week {
210 1     1 1 3 my ($self) = @_;
211              
212 1         4 my $dow = $self->jwday($self->to_julian);
213 1 50       11 if ($dow > 0) {
    0          
214 1         5 return --$dow;
215             }
216             elsif ($dow == 0) {
217 0         0 return 6;
218             }
219             }
220              
221             =head2 is_leap_year($year)
222              
223             Returns 0 or 1 if the given Hebrew year C<$year> is a leap year or not.
224              
225             =cut
226              
227             sub is_leap_year {
228 86     86 1 127 my ($self, $year) = @_;
229              
230 86         249 return ((($year * 7) + 1) % 19) < 7;
231             }
232              
233             sub days_in_year {
234 28     28 0 46 my ($self, $year) = @_;
235              
236 28         63 return $self->to_julian($year + 1, 7, 1) - $self->to_julian($year, 7, 1);
237             }
238              
239             sub months_in_year {
240 79     79 0 121 my ($self, $year) = @_;
241              
242 79 100       125 return $self->is_leap_year($year) ? (13) : (12);
243             }
244              
245             sub delay_1 {
246 316     316 0 466 my ($self, $year) = @_;
247              
248 316         572 my $months = floor(((235 * $year) - 234) / 19);
249 316         486 my $parts = 12084 + (13753 * $months);
250 316         556 my $day = ($months * 29) + floor($parts / 25920);
251              
252 316 100       635 if (((3 * ($day + 1)) % 7) < 3) {
253 81         106 $day++;
254             }
255              
256 316         565 return $day;
257              
258             }
259              
260             sub delay_2 {
261 79     79 0 129 my ($self, $year) = @_;
262              
263 79         130 my $last = $self->delay_1($year - 1);
264 79         130 my $present = $self->delay_1($year);
265 79         142 my $next = $self->delay_1($year + 1);
266              
267 79 50       157 if (($next - $present) == 356) {
268 0         0 return 2;
269             }
270             else {
271 79 50       145 if (($present - $last) == 382) {
272 0         0 return 1;
273             }
274             else {
275 79         171 return 0;
276             }
277             }
278             }
279              
280             sub days_in_month_year {
281 63     63 0 1741 my ($self, $month, $year) = @_;
282              
283             # First of all, dispose of fixed-length 29 day months
284 63 100 33     380 if (($month == 2) || ($month == 4) || ($month == 6) || ($month == 10) || ($month == 13)) {
      33        
      66        
      66        
285 11         30 return 29;
286             }
287              
288             # If it's not a leap year, Adar has 29 days
289 52 100 66     105 if (($month == 12) && !$self->is_leap_year($year)) {
290 2         8 return 29;
291             }
292              
293             # If it's Cheshvan, days depend on length of year
294 50 100 66     99 if (($month == 8) && !(($self->days_in_year($year) % 10) == 5)) {
295 15         38 return 29;
296             }
297              
298             # Similarly, Kislev varies with the length of year
299 35 100 66     67 if (($month == 9) && !(($self->days_in_year($year) % 10) == 3)) {
300 13         34 return 29;
301             }
302              
303             # Nope, it's a 30 day month
304 22         56 return 30;
305             }
306              
307             sub validate_hebrew_month {
308 3     3 0 7 my ($self, $month, $year) = @_;
309              
310 3 50       9 $year = $self->year unless defined $year;
311 3 50 33     22 if (defined $month && ($month !~ /^[-+]?\d+$/)) {
312 0         0 return $self->validate_hebrew_month_name($month, $year);
313             }
314              
315 3         16 my @caller = caller(0);
316 3 50       10 @caller = caller(2) if $caller[3] eq '(eval)';
317              
318 3 0 33     26 Date::Exception::InvalidMonth->throw({
    50 33        
      33        
      33        
319             method => __PACKAGE__."::validate_hebrew_month",
320             message => sprintf("ERROR: Invalid month [%s].", defined($month)?($month):('')),
321             filename => $caller[1],
322             line_number => $caller[2] })
323             unless (defined($month)
324             && ($month =~ /^\+?\d+$/)
325             && ($month >= 1)
326             && (($self->is_leap_year($year) && $month <= 13)
327             || ($month <= 12)));
328             }
329              
330             sub validate_hebrew_month_name {
331 0     0 0 0 my ($self, $month_name, $year) = @_;
332              
333 0         0 my @caller = caller(0);
334 0 0       0 @caller = caller(2) if $caller[3] eq '(eval)';
335              
336 0 0       0 $year = $self->year unless defined $year;
337 0         0 my $months = $self->months;
338 0 0       0 if ($self->is_leap_year($year)) {
339 0         0 $months->[12] = 'Adar I';
340 0         0 $months->[13] = 'Adar II';
341             }
342              
343             Date::Exception::InvalidMonth->throw({
344             method => __PACKAGE__."::validate_hebrew_month_name",
345             message => sprintf("ERROR: Invalid month name [%s].", defined($month_name)?($month_name):('')),
346             filename => $caller[1],
347             line_number => $caller[2] })
348 0 0 0     0 unless (defined($month_name) && ($month_name !~ /^[-+]?\d+$/) && (grep /$month_name/i, @{$months}[1..$#$months]));
  0 0 0     0  
349             }
350              
351             sub get_month_name {
352 1     1 0 4 my ($self, $month, $year) = @_;
353              
354 1 50       5 $year = $self->year unless defined $year;
355 1 50       3 if (defined $month) {
356 0         0 $self->validate_hebrew_month($month, $year);
357             }
358             else {
359 1         3 $month = $self->month;
360             }
361              
362 1         4 my $months = $self->months;
363 1 50       4 if ($self->is_leap_year($year)) {
364 0         0 $months->[12] = 'Adar I';
365 0         0 $months->[13] = 'Adar II';
366             }
367              
368 1         11 return $months->[$month];
369             }
370              
371             sub as_string {
372 1     1 0 9 my ($self) = @_;
373              
374 1         6 return sprintf("%d, %s %d", $self->day, $self->get_month_name, $self->year);
375             }
376              
377             =head1 AUTHOR
378              
379             Mohammad S Anwar, C<< >>
380              
381             =head1 REPOSITORY
382              
383             L
384              
385             =head1 SEE ALSO
386              
387             =over 4
388              
389             =item L
390              
391             =item L
392              
393             =item L
394              
395             =item L
396              
397             =item L
398              
399             =back
400              
401             =head1 BUGS
402              
403             Please report any bugs / feature requests to C,
404             or through the web interface at L.
405             I will be notified, and then you'll automatically be notified of progress on your
406             bug as I make changes.
407              
408             =head1 SUPPORT
409              
410             You can find documentation for this module with the perldoc command.
411              
412             perldoc Date::Hebrew::Simple
413              
414             You can also look for information at:
415              
416             =over 4
417              
418             =item * RT: CPAN's request tracker
419              
420             L
421              
422             =item * AnnoCPAN: Annotated CPAN documentation
423              
424             L
425              
426             =item * CPAN Ratings
427              
428             L
429              
430             =item * Search CPAN
431              
432             L
433              
434             =back
435              
436             =head1 LICENSE AND COPYRIGHT
437              
438             Copyright (C) 2017 Mohammad S Anwar.
439              
440             This program is free software; you can redistribute it and / or modify it under
441             the terms of the the Artistic License (2.0). You may obtain a copy of the full
442             license at:
443              
444             L
445              
446             Any use, modification, and distribution of the Standard or Modified Versions is
447             governed by this Artistic License.By using, modifying or distributing the Package,
448             you accept this license. Do not use, modify, or distribute the Package, if you do
449             not accept this license.
450              
451             If your Modified Version has been derived from a Modified Version made by someone
452             other than you,you are nevertheless required to ensure that your Modified Version
453             complies with the requirements of this license.
454              
455             This license does not grant you the right to use any trademark, service mark,
456             tradename, or logo of the Copyright Holder.
457              
458             This license includes the non-exclusive, worldwide, free-of-charge patent license
459             to make, have made, use, offer to sell, sell, import and otherwise transfer the
460             Package with respect to any patent claims licensable by the Copyright Holder that
461             are necessarily infringed by the Package. If you institute patent litigation
462             (including a cross-claim or counterclaim) against any party alleging that the
463             Package constitutes direct or contributory patent infringement,then this Artistic
464             License to you shall terminate on the date that such litigation is filed.
465              
466             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
467             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
468             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
469             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
470             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
471             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
472             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
473              
474             =cut
475              
476             1; # End of Date::Hebrew::Simple