File Coverage

blib/lib/DateTime/Calendar/CopticEthiopic.pm
Criterion Covered Total %
statement 61 70 87.1
branch 13 30 43.3
condition 2 12 16.6
subroutine 16 19 84.2
pod 0 6 0.0
total 92 137 67.1


line stmt bran cond sub pod time code
1             package DateTime::Calendar::CopticEthiopic;
2 1     1   10 use base (DateTime);
  1         2  
  1         1704  
3              
4             BEGIN
5             {
6 1     1   15 require 5.000;
7              
8 1     1   642107 use strict;
  1         2  
  1         19  
9 1     1   2 use warnings;
  1         3  
  1         52  
10 1         79 use vars qw(
11             $VERSION
12              
13             $true
14             $false
15              
16             @GregorianDaysPerMonth
17              
18             $n
19 1     1   4 );
  1         1  
20              
21 1         3 $VERSION = "0.05"; # based on Date::Ethiopic v0.13
22              
23 1         2 ($false,$true) = (0,1);
24              
25 1         781 @GregorianDaysPerMonth = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
26             }
27              
28              
29             #
30             #
31             # Calender System Conversion Methods Below Here:
32             #
33             #
34             sub _AbsoluteToEthiopic
35             {
36 1     1   2 my ( $self, $absolute ) = @_;
37              
38 1         3 my $year = quotient ( 4 * ( $absolute - $self->epoch ) + 1463, 1461 );
39 1         3 my $month = 1 + quotient ( $absolute - $self->_EthiopicToAbsolute ( 1, 1, $year ), 30 );
40 1         1 my $day = ( $absolute - $self->_EthiopicToAbsolute ( 1, $month, $year ) + 1 );
41              
42 1         7 ( $day, $month, $year );
43             }
44              
45              
46             sub fromGregorian
47             {
48 1     1 0 2 my $self = shift;
49              
50 1 50       5 die ( "Bogus Ethiopic Date!!" ) if ( $self->_isBogusGregorianDate ( @_ ) );
51              
52 1         3 $self->_AbsoluteToEthiopic ( $self->_GregorianToAbsolute ( @_ ) );
53             }
54              
55              
56             sub gregorian
57             {
58 1     1 0 6 my $self = shift;
59              
60 1         2 $self->_AbsoluteToGregorian ( $self->_EthiopicToAbsolute ( @_ ) );
61             }
62              
63              
64             sub _isBogusEthiopicDate
65             {
66 0     0   0 my $self = shift;
67              
68 0 0       0 my($day, $month, $year) = (@_) ? @_ : ($self->day, $self->month, $self->year);
69              
70 0 0 0     0 ( !( 1 <= $day && $day <= 30 )
71             || !( 1 <= $month && $month <= 13 )
72             || ( $month == 13 && $day > 6 )
73             || ( $month == 13 && $day == 6 && !$self->isLeapYear )
74             )
75             ?
76             $true : $false;
77              
78             }
79              
80              
81             sub _isBogusGregorianDate
82             {
83 1     1   1 my $self = shift;
84              
85 1 50       5 my($day, $month, $year) = (@_) ? @_ : ($self->day, $self->month, $self->year);
86              
87 1 50 33     13 ( !( 1 <= $month && $month <= 12 )
88             || !( 1 <= $day && $day <= $GregorianDaysPerMonth[$month-1] )
89             || ( $day == 29 && $month == 2 && !$self->_isGregorianLeapYear($year) )
90             )
91             ?
92             $true : $false;
93              
94             }
95              
96              
97             sub _EthiopicToAbsolute
98             {
99 5     5   7 my $self = shift;
100 5 100       14 my ( $date, $month, $year ) = ( @_ ) ? @_ : ($self->day,$self->month,$self->year);
101              
102 5         83 ( $self->epoch - 1 + 365 * ( $year - 1 ) + quotient ( $year, 4 ) + 30 * ( $month - 1 ) + $date );
103             }
104              
105              
106             sub _GregorianYear
107             {
108 1     1   2 my ( $a ) = @_;
109              
110 1         11 my $b = $a - 1;
111 1         2 my $c = quotient ( $b, 146097 );
112 1         3 my $d = mod ( $b, 146097 );
113 1         2 my $e = quotient ( $d, 36524 );
114 1         2 my $f = mod ( $d, 36524 );
115 1         2 my $g = quotient ( $f, 1461 );
116 1         3 my $h = mod ( $f, 1461 );
117 1         2 my $i = quotient ( $h, 365 );
118 1         2 my $j = ( 400 * $c ) + ( 100 * $e ) + ( 4 * $g ) + $i;
119              
120 1 50 33     6 ( ( $e == 4 ) || ( $i == 4 ) )
121             ? $j
122             : ( $j + 1 )
123             ;
124             }
125              
126              
127             sub _AbsoluteToGregorian
128             {
129 1     1   2 my ( $self, $absolute ) = @_;
130              
131 1         2 my $year = _GregorianYear ( $absolute );
132              
133 1         7 my $priorDays = ( $absolute - $self->_GregorianToAbsolute ( 1, 1, $year ) );
134              
135 1 50       3 my $correction
    50          
136             = ( $absolute < $self->_GregorianToAbsolute ( 1, 3, $year ) )
137             ? 0
138             : ( $self->_isGregorianLeapYear ( $year ) )
139             ? 1
140             : 2
141             ;
142              
143 1         2 my $month = quotient ( ( ( 12 * ( $priorDays + $correction ) + 373 ) / 367 ), 1 );
144 1         2 my $day = $absolute - $self->_GregorianToAbsolute ( 1, $month, $year ) + 1;
145              
146 1         4 ( $day, $month, $year );
147             }
148              
149              
150             sub _GregorianToAbsolute
151             {
152 4     4   5 my $self = shift;
153 4 50       8 my ( $date, $month, $year ) = ( @_ ) ? @_ : ($self->day,$self->month,$self->year);
154              
155 4 50       10 my $correction
    100          
156             = ( $month <= 2 )
157             ? 0
158             : ( $self->_isGregorianLeapYear ( $year ) )
159             ? -1
160             : -2
161             ;
162              
163 4         8 my $absolute =(
164             365 * ( $year - 1 )
165             + quotient ( $year - 1, 4 )
166             - quotient ( $year - 1, 100 )
167             + quotient ( $year - 1, 400 )
168             + ( 367 * $month - 362 ) / 12
169             + $correction + $date
170             );
171              
172 4         20 quotient ( $absolute, 1 );
173             }
174              
175              
176             sub _isGregorianLeapYear
177             {
178 4     4   5 shift;
179              
180             (
181 4 50 0     13 ( ( $_[0] % 4 ) != 0 )
182             || ( ( $_[0] % 400 ) == 100 )
183             || ( ( $_[0] % 400 ) == 200 )
184             || ( ( $_[0] % 400 ) == 300 )
185             )
186             ? 0
187             : 1
188             ;
189             }
190              
191              
192             #
193             # argument is an ethiopic year
194             #
195             sub isLeapYear
196             {
197 0     0 0 0 my $self = shift;
198 0 0       0 my ( $year ) = ( @_ ) ? shift : $self->year;
199              
200 0 0       0 ( ( $year + 1 ) % 4 ) ? 0 : 1 ;
201             }
202              
203              
204             sub quotient
205             {
206 31     31 0 41 $_ = $_[0] / $_[1];
207              
208 31         136 s/\.(.*)//;
209              
210 31         68 $_;
211             }
212              
213              
214             sub mod
215             {
216 3     3 0 4 ( $_[0] - $_[1] * quotient ( $_[0], $_[1] ) );
217             }
218              
219              
220             sub toGregorian
221             {
222 0     0 0   my $self = shift;
223              
224 0           my ($day,$month,$year) = $self->gregorian;
225              
226 0           new DateTime ( day => $day, month => $month, year => $year );
227             }
228              
229              
230             #########################################################
231             # Do not change this, Do not put anything below this.
232             # File must return "true" value at termination
233             1;
234             ##########################################################
235              
236             __END__
237              
238              
239              
240             =head1 NAME
241              
242             DateTime::Calendar::CopticEthiopic - DateTime Module for the Coptic/Ethiopic Calendar System.
243              
244             =head1 SYNOPSIS
245              
246             use DateTime::Calendar::CopticEthiopic;
247             #
248             # typical instantiation:
249             #
250             my $ethio = new DateTime::Calendar::CopticEthiopic ( day => 29, month => 6, year => 1995 );
251             $ethio = new DateTime::Calendar::CopticEthiopic ( ical => '19950629' ); # the same
252              
253             #
254             # Get Gregorian Date:
255             #
256             my ($d,$m,$y) = $ethio->gregorian;
257              
258             #
259             # instantiate with a Gregorian date, date will be converted.
260             #
261             $ethio = new DateTime::Calendar::CopticEthiopic ( ical => '20030308', calscale => 'gregorian' );
262              
263             #
264             # instantiate with a DateTime::ICal object, assumed to be in Gregorian
265             #
266             my $grego = new DateTime::ICal ( ical => '20030308' );
267             $ethio = new DateTime::Calendar::CopticEthiopic ( $grego );
268              
269             #
270             # get a DateTime::ICal object in the Gregorian calendar system
271             #
272             $grego = $ethio->toGregorian;
273              
274              
275             =head1 DESCRIPTION
276              
277             The DateTime::Calendar::CopticEthiopic module provides a base class for
278             DateTime::Calendar::Coptic and DateTime::Calendar::Ethiopic and handles
279             conversions to and from the Gregorian calendar system.
280              
281             =head2 Limitations
282              
283             In the Gregorian system the rule for adding a 29th day to February during
284             leap year follows as per; February will have a 29th day:
285              
286             (((((every 4 years) except every 100 years) except every 400 years) except every 2,000) except (maybe every 16,000 years))
287              
288             The Coptic/Ethiopic calendar gets an extra day at the end of the 13th month on leap
289             year (which occurs the year before Gregorian leap year).
290             It is not known however if the Coptic/Ethiopic calendar follows the 2,000 year rule.
291             If it does NOT follow the 2,000 year rule the consequence would be that the
292             difference between the two calendar systems will increase by a single day.
293             Hence if you reckon your birthday in the Coptic/Ethiopic system, that date in
294             Gregorian may change in five years. The algorithm here here assumes that
295             the Coptic/Ethiopic system will follow the 2,000 year rule.
296              
297             This may however become a moot point when we consider:
298              
299              
300             =head2 The Impending Calamity at the End of Time
301              
302             Well, it is more of a major reset. Recent reports from reliable sources
303             indicate that every
304             1,000 years the Coptic/Ethiopic calendar goes thru a major upheaval whereby
305             the calendar gets resyncronized with either September 1st or possibly
306             even October 1st. Accordingly Nehasse would then either end on the 25th
307             day or Pagumen would be extend to 25 days. Noone will know their birthday
308             any more, Christmas or any other date that ever once had meaning. Chaos
309             will indeed rule the world.
310              
311             Unless everyone gets little calendar converting applets running on their wrist
312             watches, that would rule. But before you start coding applets for future
313             embeded systems, lets get this clarified. Consider that the Gregorian
314             calendar system is less than 500 years old, so this couldn't have happend
315             a 1,000 years ago, perhaps with the Julian calendar. Since the Coptic/Ethiopic
316             calendar is still in sync with the Coptic, the Copts must have gone thru
317             the same upheaval.
318              
319             We are following this story closely, stay tuned to these man pages
320             for updates as they come in.
321              
322              
323             =head1 CREDITS
324              
325             =over
326              
327             =item Calendrical Calculations: L<http://www.calendarists.com/>
328              
329             =item Bahra Hasab: L<http://www.hmml.org/events/>
330              
331             =item LibEth: L<http://libeth.sourceforge.net/>
332              
333             =item Ethiopica: L<http://ethiopica.sourceforge.net/>
334              
335             =item Saint Gebriel Ethiopian Orthodox Church of Seattle: L<http://www.st-gebriel.org/>
336              
337             =item Aklile Birhan Wold Kirkos, Metsaheit Tibeb, Neged Publishers, Addis Ababa, 1955 (1948 EC).
338              
339             =back
340              
341             =head1 REQUIRES
342              
343             This module is intended as a base class for other classes and is not
344             intended for use on its own.
345              
346             =head1 COPYRIGHT
347              
348             The conversion algorithms are derived from the original work in Emacs
349             Lisp by Reingold, Dershowitz and Clamen which later grew into the
350             excellent reference Calendrical Calculations. The Emacs package carries
351             the following message:
352              
353             ;; The Following Lisp code is from ``Calendrical
354             ;; Calculations'' by Nachum Dershowitz and Edward
355             ;; M. Reingold, Software---Practice & Experience, vol. 20,
356             ;; no. 9 (September, 1990), pp. 899--928 and from
357             ;; ``Calendrical Calculations, II: Three Historical
358             ;; Calendars'' by Edward M. Reingold, Nachum Dershowitz,
359             ;; and Stewart M. Clamen, Software---Practice & Experience,
360             ;; vol. 23, no. 4 (April, 1993), pp. 383--404.
361              
362             ;; This code is in the public domain, but any use of it
363             ;; should publically acknowledge its source.
364              
365             Otherwise, this module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
366              
367             =head1 BUGS
368              
369             None presently known.
370              
371             =head1 AUTHOR
372              
373             Daniel Yacob, L<dyacob@cpan.org|mailto:dyacob@cpan.org>
374              
375             =head1 LICENSE AND COPYRIGHT
376              
377             Copyright (c) 2003-2025, Daniel Yacob C<< <dyacob@cpan.org> >>. All rights reserved.
378              
379             This module is free software; you can redistribute it and/or
380             modify it under the same terms as Perl itself. See L<perlartistic>.
381              
382             =head1 SEE ALSO
383              
384             Ethiopica L<http://ethiopica.sourceforge.net>
385              
386             =cut