File Coverage

blib/lib/Date/Hijri/Simple.pm
Criterion Covered Total %
statement 53 71 74.6
branch 6 20 30.0
condition 5 21 23.8
subroutine 17 20 85.0
pod 6 11 54.5
total 87 143 60.8


line stmt bran cond sub pod time code
1             package Date::Hijri::Simple;
2              
3             $Date::Hijri::Simple::VERSION = '0.24';
4             $Date::Hijri::Simple::AUTHORITY = 'cpan:MANWAR';
5              
6             =head1 NAME
7              
8             Date::Hijri::Simple - Represents Hijri date.
9              
10             =head1 VERSION
11              
12             Version 0.24
13              
14             =cut
15              
16 2     2   134173 use 5.006;
  2         15  
17 2     2   1214 use Data::Dumper;
  2         13595  
  2         132  
18 2     2   867 use Time::localtime;
  2         9344  
  2         110  
19 2     2   14 use List::Util qw/min/;
  2         4  
  2         215  
20 2     2   1029 use POSIX qw/floor ceil/;
  2         12777  
  2         13  
21 2     2   3796 use Date::Exception::InvalidDay;
  2         132220  
  2         66  
22              
23 2     2   14 use Moo;
  2         5  
  2         11  
24 2     2   620 use namespace::autoclean;
  2         5  
  2         11  
25              
26 2     2   140 use overload q{""} => 'as_string', fallback => 1;
  2         4  
  2         15  
27              
28             =head1 DESCRIPTION
29              
30             Represents the Hijri date.
31              
32             =cut
33              
34             our $HIJRI_MONTHS = [
35             undef,
36             q/Muharram/, q/Safar/ , q/Rabi' al-awwal/, q/Rabi' al-thani/,
37             q/Jumada al-awwal/, q/Jumada al-thani/, q/Rajab/ , q/Sha'aban/,
38             q/Ramadan/ , q/Shawwal/ , q/Dhu al-Qi'dah/ , q/Dhu al-Hijjah/
39             ];
40              
41             our $HIJRI_DAYS = [
42             'al-Ahad', 'al-Ithnayn', 'ath-Thulatha', 'al-Arbia',
43             'al-Khamis', 'al-Jumuah', 'as-Sabt'
44             ];
45              
46             our $HIJRI_LEAP_YEAR_MOD = [
47             2, 5, 7, 10, 13, 16, 18, 21, 24, 26, 29
48             ];
49              
50             has hijri_epoch => (is => 'ro', default => sub { 1948439.5 });
51             has days => (is => 'ro', default => sub { $HIJRI_DAYS });
52             has months => (is => 'ro', default => sub { $HIJRI_MONTHS });
53             has hijri_leap_year_mod => (is => 'ro', default => sub { $HIJRI_LEAP_YEAR_MOD });
54              
55             has year => (is => 'rw', predicate => 1);
56             has month => (is => 'rw', predicate => 1);
57             has day => (is => 'rw', predicate => 1);
58              
59             with 'Date::Utils';
60              
61             sub BUILD {
62 7     7 0 44 my ($self) = @_;
63              
64 7 50       40 $self->validate_year($self->year) if $self->has_year;
65 7 50       155 $self->validate_month($self->month) if $self->has_month;
66 7 50       141 $self->validate_day($self->day) if $self->has_day;
67              
68 7 50 33     73 unless ($self->has_year && $self->has_month && $self->has_day) {
      33        
69 0         0 my $today = localtime;
70 0         0 my $year = $today->year + 1900;
71 0         0 my $month = $today->mon + 1;
72 0         0 my $day = $today->mday;
73 0         0 my $date = $self->from_gregorian($year, $month, $day);
74 0         0 $self->year($date->year);
75 0         0 $self->month($date->month);
76 0         0 $self->day($date->day);
77             }
78             }
79              
80             =head1 SYNOPSIS
81              
82             use strict; use warnings;
83             use Date::Hijri::Simple;
84              
85             # prints today's Hijri date
86             print Date::Hijri::Simple->new, "\n";
87              
88             my $date = Date::Hijri::Simple->new({ year => 1436, month => 1, day => 1 });
89              
90             # prints the given Hijri date
91             print $date->as_string, "\n";
92              
93             # prints the equivalent Julian date
94             print $date->to_julian, "\n";
95              
96             # prints the equivalent Gregorian date
97             print sprintf("%04d-%02d-%02d", $date->to_gregorian), "\n";
98              
99             # prints day of the week index (0 for al-Ahad, 1 for al-Ithnayn and so on).
100             print $date->day_of_week, "\n";
101              
102             # prints the Hijri date equivalent of the Gregorian date (2014-10-25).
103             print $date->from_gregorian(2014, 10, 25), "\n";
104              
105             # prints the Hijri date equivalent of the Julian date (2456955.5).
106             print $date->from_julian(2456955.5), "\n";
107              
108             =head1 METHODS
109              
110             =head2 to_julian()
111              
112             Returns Julian date equivalent of the Hijri date.
113              
114             =cut
115              
116             sub to_julian {
117 7     7 1 775 my ($self) = @_;
118              
119 7         145 return ($self->day + ceil(29.5 * ($self->month - 1))
120             + ($self->year - 1) * 354
121             + floor((3 + (11 * $self->year)) / 30)
122             + $self->hijri_epoch) - 1;
123             }
124              
125             =head2 from_julian($julian_day)
126              
127             Returns Hijri date as an object of type L equivalent of the
128             given Julian day C<$julian_day>.
129              
130             =cut
131              
132             sub from_julian {
133 2     2 1 1581 my ($self, $julian_day) = @_;
134              
135 2         6 $julian_day = floor($julian_day) + 0.5;
136 2         11 my $year = floor(((30 * ($julian_day - $self->hijri_epoch)) + 10646) / 10631);
137 2         51 my $a_hijri = Date::Hijri::Simple->new({ year => $year, month => 1, day => 1 });
138 2         9 my $month = min(12, ceil(($julian_day - (29 + $a_hijri->to_julian)) / 29.5) + 1);
139 2         54 my $b_hijri = Date::Hijri::Simple->new({ year => $year, month => $month, day => 1 });
140 2         24 my $day = ($julian_day - $b_hijri->to_julian) + 1;
141              
142 2         44 return Date::Hijri::Simple->new({
143             year => $year,
144             month => $month,
145             day => $day });
146             }
147              
148             =head2 to_gregorian()
149              
150             Returns Gregorian date (yyyy, mm, dd) equivalent of the Hijri date.
151              
152             =cut
153              
154             sub to_gregorian {
155 1     1 1 539 my ($self) = @_;
156              
157 1         4 return $self->julian_to_gregorian($self->to_julian);
158             }
159              
160             =head2 from_gregorian($year, $month, $day)
161              
162             Returns Hijri date as an object of type L equivalent of the
163             Gregorian date C<$year>, C<$month> and C<$day>.
164              
165             =cut
166              
167             sub from_gregorian {
168 1     1 1 935 my ($self, $year, $month, $day) = @_;
169              
170 1         4 return $self->from_julian($self->gregorian_to_julian($year, $month, $day));
171             }
172              
173             =head2 day_of_week()
174              
175             Returns day of the week, starting 0 for al-Ahad, 1 for al-Ithnayn and so on.
176              
177             +--------------+------------------------------------------------------------+
178             | Arabic Name | English Name |
179             +--------------+------------------------------------------------------------+
180             | al-Ahad | Sunday |
181             | al-Ithnayn | Monday |
182             | ath-Thulatha | Tuesday |
183             | al-Arbia | Wednesday |
184             | al-Khamis | Thursday |
185             | al-Jumuah | Friday |
186             | as-Sabt | Saturday |
187             +--------------+------------------------------------------------------------+
188              
189             =cut
190              
191             sub day_of_week {
192 1     1 1 3 my ($self) = @_;
193              
194 1         8 return $self->jwday($self->to_julian);
195             }
196              
197             =head2 is_leap_year($year)
198              
199             Returns 0 or 1 if the given Hijri year C<$year> is a leap year or not.
200              
201             =cut
202              
203             sub is_leap_year {
204 0     0 1 0 my ($self, $year) = @_;
205              
206 0         0 my $mod = $year % 30;
207 0 0       0 return 1 if grep/$mod/, @{$self->hijri_leap_year_mod};
  0         0  
208 0         0 return 0;
209             }
210              
211             sub days_in_year {
212 0     0 0 0 my ($self, $year) = @_;
213              
214 0 0       0 ($self->is_leap_year($year))
215             ?
216             (return 355)
217             :
218             (return 354);
219             }
220              
221             sub days_in_month_year {
222 0     0 0 0 my ($self, $month, $year) = @_;
223              
224 0 0 0     0 return 30 if (($month % 2 == 1) || (($month == 12) && ($self->is_leap_year($year))));
      0        
225 0         0 return 29;
226             }
227              
228             sub validate_day {
229 7     7 0 13 my ($self, $day) = @_;
230              
231 7         29 my @caller = caller(0);
232 7 50       20 @caller = caller(2) if $caller[3] eq '(eval)';
233              
234 7 0 33     63 Date::Exception::InvalidDay->throw({
    50 33        
      33        
235             method => __PACKAGE__."::validate_day",
236             message => sprintf("ERROR: Invalid day [%s].", defined($day)?($day):('')),
237             filename => $caller[1],
238             line_number => $caller[2] })
239             unless (defined($day) && ($day =~ /^\d{1,2}$/) && ($day >= 1) && ($day <= 30));
240             }
241              
242             sub as_string {
243 1     1 0 7 my ($self) = @_;
244              
245 1         5 return sprintf("%d, %s %d", $self->day, $self->get_month_name, $self->year);
246             }
247              
248             =head1 AUTHOR
249              
250             Mohammad S Anwar, C<< >>
251              
252             =head1 REPOSITORY
253              
254             L
255              
256             =head1 SEE ALSO
257              
258             =over 4
259              
260             =item L
261              
262             =item L
263              
264             =item L
265              
266             =item L
267              
268             =item L
269              
270             =item L
271              
272             =back
273              
274             =head1 BUGS
275              
276             Please report any bugs / feature requests to C,
277             or through the web interface at L.
278             I will be notified, and then you'll automatically be notified of progress on your
279             bug as I make changes.
280              
281             =head1 SUPPORT
282              
283             You can find documentation for this module with the perldoc command.
284              
285             perldoc Date::Hijri::Simple
286              
287             You can also look for information at:
288              
289             =over 4
290              
291             =item * RT: CPAN's request tracker
292              
293             L
294              
295             =item * AnnoCPAN: Annotated CPAN documentation
296              
297             L
298              
299             =item * CPAN Ratings
300              
301             L
302              
303             =item * Search CPAN
304              
305             L
306              
307             =back
308              
309             =head1 LICENSE AND COPYRIGHT
310              
311             Copyright (C) 2015 - 2016 Mohammad S Anwar.
312              
313             This program is free software; you can redistribute it and / or modify it under
314             the terms of the the Artistic License (2.0). You may obtain a copy of the full
315             license at:
316              
317             L
318              
319             Any use, modification, and distribution of the Standard or Modified Versions is
320             governed by this Artistic License.By using, modifying or distributing the Package,
321             you accept this license. Do not use, modify, or distribute the Package, if you do
322             not accept this license.
323              
324             If your Modified Version has been derived from a Modified Version made by someone
325             other than you,you are nevertheless required to ensure that your Modified Version
326             complies with the requirements of this license.
327              
328             This license does not grant you the right to use any trademark, service mark,
329             tradename, or logo of the Copyright Holder.
330              
331             This license includes the non-exclusive, worldwide, free-of-charge patent license
332             to make, have made, use, offer to sell, sell, import and otherwise transfer the
333             Package with respect to any patent claims licensable by the Copyright Holder that
334             are necessarily infringed by the Package. If you institute patent litigation
335             (including a cross-claim or counterclaim) against any party alleging that the
336             Package constitutes direct or contributory patent infringement,then this Artistic
337             License to you shall terminate on the date that such litigation is filed.
338              
339             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND
340             CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
341             WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR
342             NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS
343             REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT,
344             INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE
345             OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
346              
347             =cut
348              
349             1; # End of Date::Hijri::Simple