File Coverage

blib/lib/Astro/SunTime.pm
Criterion Covered Total %
statement 116 122 95.0
branch 15 32 46.8
condition 1 2 50.0
subroutine 21 21 100.0
pod 0 2 0.0
total 153 179 85.4


line stmt bran cond sub pod time code
1              
2             # Copyright (c) 1999-2017 Rob Fugina
3             # Distributed under the terms of the GNU Public License, Version 3.0
4              
5             package Astro::SunTime;
6 2     2   4614 use vars qw(@ISA @EXPORT $VERSION);
  2         3  
  2         140  
7             $VERSION = 0.05;
8             @ISA = qw(Exporter);
9             @EXPORT = qw(sun_time);
10              
11             # Results can be checked with: http://aa.usno.navy.mil/data/docs/RS_OneYear.php
12              
13             # 09/03/00 :: winter Make ParseDate optional. It is overkill and I could not get it to
14             # compile in perl2exe. It gave runaway comment errors :(
15             # 10/12/00 :: winter Change time_zone check to defined, to allow for time_zone 0
16              
17 2     2   892 use POSIX;
  2         10708  
  2         10  
18              
19 2     2   3833 use strict;
  2         5  
  2         1008  
20              
21             # sun_time takes:
22             # type => 'rise' | 'set'
23             # latitude
24             # longitude
25             # time_zone => hours from GMT
26             # date => date parsable by Time::ParseDate::parsedate()
27             # time => to feed to localtime
28              
29             sub sun_time
30             {
31 16     16 0 68 my %params = @_;
32              
33 16   50     36 my $type = $params{type} || 'rise';
34 16 50       23 my $latitude = (defined $params{latitude}) ? $params{latitude} : 38.74274;
35 16 50       25 my $longitude = (defined $params{longitude}) ? $params{longitude} : -90.560143;
36 16 50       21 my $time_zone = (defined $params{time_zone}) ? $params{time_zone} : -6;
37              
38 16         13 my $time;
39 16 50       22 if ($params{date}) {
    0          
40 16     1   827 eval 'use Time::ParseDate';
  1     1   632  
  1     1   8015  
  1     1   36  
  1     1   5  
  1     1   2  
  1     1   27  
  1     1   4  
  1     1   1  
  1     1   26  
  1     1   4  
  1     1   1  
  1     1   31  
  1     1   4  
  1     1   1  
  1     1   26  
  1         4  
  1         1  
  1         25  
  1         4  
  1         1  
  1         29  
  1         4  
  1         1  
  1         25  
  1         4  
  1         1  
  1         25  
  1         4  
  1         1  
  1         34  
  1         4  
  1         1  
  1         30  
  1         3  
  1         1  
  1         35  
  1         4  
  1         1  
  1         24  
  1         4  
  1         1  
  1         26  
  1         3  
  1         1  
  1         25  
  1         4  
  1         1  
  1         37  
41 16         41 $time = parsedate($params{date});
42             }
43             elsif ($params{time}) {
44 0         0 $time = $params{time};
45             }
46             else {
47 0         0 $time = time;
48             }
49 16         2969 my @suntime = localtime($time);
50              
51 16         26 my $yday = $suntime[7] + 1;
52              
53 16         11 my $A = 1.5708;
54 16         14 my $B = 3.14159;
55 16         13 my $C = 4.71239;
56 16         9 my $D = 6.28319;
57 16         15 my $E = 0.0174533 * $latitude;
58 16         10 my $F = 0.0174533 * $longitude;
59 16         14 my $G = 0.261799 * $time_zone;
60              
61             # For astronomical twilight, use R = -.309017
62             # For nautical twilight, use R = -.207912
63             # For civil twilight, use R = -.104528
64             # For sunrise or sunset, use R = -.0145439
65              
66 16         11 my $R = -.0145439;
67 16 50       32 if ($params{twilight}) {
68 0 0       0 if($params{twilight} eq 'astronomical') {
    0          
    0          
69 0         0 $R = -.309017;
70             }
71             elsif($params{twilight} eq 'nautical') {
72 0         0 $R = -.207912;
73             }
74             elsif($params{twilight} eq 'civil') {
75 0         0 $R = -.104528;
76             }
77             }
78              
79              
80 16 100       25 my $J = ($type eq 'rise') ? $A : $C;
81 16         27 my $K = $yday + (($J - $F) / $D);
82 16         12 my $L = ($K * .017202) - .0574039; # Solar Mean Anomoly
83 16         30 my $M = $L + .0334405 * sin($L); # Solar True Longitude
84 16         16 $M += 4.93289 + (3.49066E-04) * sin(2 * $L);
85 16         22 $M = &normalize($M, $D); # Quadrant Determination
86 16 50       32 $M += 4.84814E-06 if ($M / $A) - int($M / $A) == 0;
87 16         36 my $P = sin($M) / cos($M); # Solar Right Ascension
88 16         37 $P = atan2(.91746 * $P, 1);
89              
90             # Quadrant Adjustment
91 16 100       33 if ($M > $C)
    50          
92             {
93 8         8 $P += $D;
94             }
95             elsif ($M > $A)
96             {
97 8         4 $P += $B;
98             }
99              
100 16         14 my $Q = .39782 * sin($M); # Solar Declination
101 16         17 $Q = $Q / sqrt(-$Q * $Q + 1); # This is how the original author wrote it!
102 16         21 $Q = atan2($Q, 1);
103              
104 16         17 my $S = $R - (sin($Q) * sin($E));
105 16         15 $S = $S / (cos($Q) * cos($E));
106              
107 16 50       34 return 'none' if abs($S) > 1; # Null phenomenon
108              
109 16         15 $S = $S / sqrt(-$S * $S + 1);
110 16         17 $S = $A - atan2($S, 1);
111 16 100       29 $S = $D - $S if $type eq 'rise';
112              
113 16         16 my $T = $S + $P - 0.0172028 * $K - 1.73364; # Local apparent time
114 16         12 my $U = $T - $F; # Universal timer
115 16         11 my $V = $U + $G; # Wall clock time
116 16         18 $V = &normalize($V, $D);
117 16         9 $V = $V * 3.81972;
118              
119 16         12 my $hour = int($V);
120 16         18 my $min = int(($V - $hour) * 60 + 0.5);
121              
122 16         24 @suntime[2,1,0] = ($hour, $min, 0);
123              
124 16         351 @suntime = localtime(mktime(@suntime)); # normalize date structure
125              
126 16         117 return sprintf("%d:%02d", @suntime[2,1]);
127             }
128              
129             sub normalize
130             {
131 32     32 0 16 my $Z = shift;
132 32         22 my $D = shift;
133              
134 32 50       46 die "Trying to normalize with zero offset..." if ($D == 0);
135              
136 32         45 while ($Z < 0) {$Z = $Z + $D}
  4         9  
137 32         40 while ($Z >= $D) {$Z = $Z - $D}
  12         16  
138              
139 32         33 return $Z;
140             }
141              
142              
143              
144             1;
145              
146             __END__