File Coverage

blib/lib/Date/Converter/Alexandrian.pm
Criterion Covered Total %
statement 29 39 74.3
branch 0 2 0.0
condition n/a
subroutine 6 7 85.7
pod 0 2 0.0
total 35 50 70.0


line stmt bran cond sub pod time code
1             package Date::Converter::Alexandrian;
2              
3 1     1   1602 use strict;
  1         2  
  1         48  
4 1     1   6 use base 'Date::Converter';
  1         2  
  1         617  
5              
6 1     1   7 use vars qw($VERSION);
  1         3  
  1         91  
7             $VERSION = 1.1;
8              
9             sub ymdf_to_jed {
10 0     0 0 0 my ($y, $m, $d, $f) = @_;
11              
12 0 0       0 $f = 0 unless defined $f;
13              
14 0         0 my ($y_prime, $m_prime, $d_prime);
15             {
16 1     1   993 use integer;
  1         11  
  1         6  
  0         0  
17            
18 0         0 $y_prime = $y + 4690 - (13 - $m) / 13;
19 0         0 $m_prime = ($m + 12) % 13;
20 0         0 $d_prime = $d - 1;
21             }
22              
23 0         0 my $jed = int ((1461 * $y_prime) / 4) + 30 * $m_prime + $d_prime - 124 - 0.5;
24 0         0 $jed += $f;
25              
26 0         0 return $jed;
27             }
28              
29             sub jed_to_ymdf {
30 33     33 0 26587 my ($jed) = @_;
31              
32 33         137 my $j = int ($jed + 0.5);
33 33         5520 my $f = ($jed + 0.5) - $j;
34            
35 33         59 my ($j_prime, $y_prime, $t_prime, $m_prime, $d_prime, $y, $m, $d);
36             {
37 1     1   175 use integer;
  1         2  
  1         3  
  33         41  
38            
39 33         45 $j_prime = $j + 124;
40            
41 33         46 $y_prime = (4 * $j_prime + 3) / 1461;
42 33         143 $t_prime = ((4 * $j_prime + 3) % 1461) / 4;
43 33         32 $m_prime = $t_prime / 30;
44 33         35 $d_prime = $t_prime % 30;
45              
46 33         35 $d = $d_prime + 1;
47 33         35 $m = ($m_prime % 13) + 1;
48 33         141 $y = $y_prime - 4690 + (13 - $m) / 13;
49             }
50            
51 33         378 return ($y, $m, $d, $f);
52             }
53              
54             1;