line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Ham::Resources::Utils; |
2
|
|
|
|
|
|
|
|
3
|
10
|
|
|
10
|
|
269483
|
use 5.006; |
|
10
|
|
|
|
|
46
|
|
4
|
10
|
|
|
10
|
|
9710
|
use Math::Trig qw(great_circle_distance deg2rad great_circle_direction rad2deg pi asin acos tan); |
|
10
|
|
|
|
|
182818
|
|
|
10
|
|
|
|
|
1398
|
|
5
|
10
|
|
|
10
|
|
9117
|
use Ham::Locator; |
|
10
|
|
|
|
|
232219
|
|
|
10
|
|
|
|
|
73
|
|
6
|
10
|
|
|
10
|
|
499
|
use strict; |
|
10
|
|
|
|
|
17
|
|
|
10
|
|
|
|
|
330
|
|
7
|
10
|
|
|
10
|
|
58
|
use warnings; |
|
10
|
|
|
|
|
18
|
|
|
10
|
|
|
|
|
36998
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 NAME |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
Ham::Resources::Utils - Calculation of distance and course beetwen two points |
12
|
|
|
|
|
|
|
on Earth (through coordinates or grid locator), and Sunrise, Sunset and Midday time for these locations (in UTC). Also sexagesimal degrees and decimal degrees convertion and grid location. For use mainly for Radio Amateurs. |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 VERSION |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Version 0.04 |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
our $VERSION = '0.04'; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my %coordinates = ( |
23
|
|
|
|
|
|
|
long_1 => "", |
24
|
|
|
|
|
|
|
lat_1 => "", |
25
|
|
|
|
|
|
|
long_2 => "", |
26
|
|
|
|
|
|
|
lat_2 => "", |
27
|
|
|
|
|
|
|
); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $self = {}; |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 SYNOPSIS |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
This module calculates the distance and course between two points on the Earth. |
34
|
|
|
|
|
|
|
Also Sunrise, Sunset and Midday time for both locations. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
The data of the locations may be in terrestrial coordinates or through 'Maidenhead Locator System' (grid Locator) notacion. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
The module offer the possibility to access to some methods that uses it, for |
39
|
|
|
|
|
|
|
example conversions between sexagesimal degrees into decimal degrees or |
40
|
|
|
|
|
|
|
conversion between grid locator to sexagesimal degrees. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
Also access to convert decimal degrees to compass names, and more. |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
use Ham::Resources::Utils; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
my $foo = Ham::Resources::Utils->new(); |
47
|
|
|
|
|
|
|
... |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 SUBROUTINES/METHODS |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 new |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
This is the constructor. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
my $foo = Ham::Resources::Utils->new(); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
=cut |
59
|
|
|
|
|
|
|
|
60
|
9
|
|
|
9
|
1
|
1155569
|
sub new { bless {}, shift } |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=head2 data_by_coordinates |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Gets a string with the date and a hash with the coordinates in sexagesimal |
66
|
|
|
|
|
|
|
values from point A and point B and returns a hash with all previous |
67
|
|
|
|
|
|
|
data and Distance, course and compass values and Sunrise, Sunset and Midday |
68
|
|
|
|
|
|
|
times for both locations if needed. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
my $date = "14-03-2012"; |
71
|
|
|
|
|
|
|
my %coordinates = ( lat_1 => "41N23", |
72
|
|
|
|
|
|
|
long_1 => "2E11", |
73
|
|
|
|
|
|
|
lat_2 => "30S0", |
74
|
|
|
|
|
|
|
long_2 => "10W45"); |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
my %data = $foo->data_by_coordinates{$date, %coordinates}; |
77
|
|
|
|
|
|
|
print Dumper(%data); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
The $date argument is necessary for the Sun time calculations (Sunrise, Sunset and Midday). |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Distances are in kilometers (km) and Miles (mi). Times are in UTC (Universal Time). |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
An output example: |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
DATA_BY_COORDINATES() |
86
|
|
|
|
|
|
|
compass: S # compass direction to point B or destination |
87
|
|
|
|
|
|
|
course_dec: 190.94 # direction to destination in decimal degree |
88
|
|
|
|
|
|
|
course_sexag: 190.56 # direction to destination in sexagesimal degree |
89
|
|
|
|
|
|
|
date: 14-3-2012 # date of event (for Sun calculation porpouses) |
90
|
|
|
|
|
|
|
distance_km: 9377.83 # distance to destination in kilometers |
91
|
|
|
|
|
|
|
distance_mi: 17367.74 # distance to destination in miles |
92
|
|
|
|
|
|
|
lat_1: 41N23" # Latitude of point A or origin in sexagesinal notation |
93
|
|
|
|
|
|
|
lat_1_dec: 41.3833333333333 # Latitude of origin in decimal notation |
94
|
|
|
|
|
|
|
lat_2: 41S54" # Latitude of point B or destination in sexagesimal notation |
95
|
|
|
|
|
|
|
lat_2_dec: -41.9 # Latiude of destination in decimal notation |
96
|
|
|
|
|
|
|
locator_1: JN11cj # Grid Locator of origin point |
97
|
|
|
|
|
|
|
locator_2: IE38sc # Grid Locator of destination point |
98
|
|
|
|
|
|
|
long_1: 2E12" # Longitude of point A or origin in sexagesimal notation |
99
|
|
|
|
|
|
|
long_1_dec: 2.2 # Longitude of origin in decimal notation |
100
|
|
|
|
|
|
|
long_2: 12W30" # Longitude of point B or destination in sexagesimal notation |
101
|
|
|
|
|
|
|
long_2_dec: -12.5 # Longitude of destination in decimal notation |
102
|
|
|
|
|
|
|
midday_arrive: 12h 1m # Midday time on point B (destination) in UTC |
103
|
|
|
|
|
|
|
midday_departure: 12h 1m # Midday time on point A (origin) in UTC |
104
|
|
|
|
|
|
|
sunrise_arrive: 6h 5m # Sun rise time on point B (destination) in UTC |
105
|
|
|
|
|
|
|
sunrise_departure: 6h 5m # Sun rise time on point A (origin) in UTC |
106
|
|
|
|
|
|
|
sunset_arrive: 17h 58m # Sun set time on point B (destination) in UTC |
107
|
|
|
|
|
|
|
sunset_departure: 17h 58m # Sun set time on point A (origin) in UTC |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=cut |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub data_by_coordinates { |
113
|
1
|
|
|
1
|
1
|
673
|
my $self = shift; |
114
|
1
|
|
|
|
|
2
|
my $date = shift; |
115
|
1
|
|
|
|
|
4
|
my %coordinates = @_; |
116
|
1
|
|
|
|
|
5
|
my %data = data_constructor($self, $date, %coordinates); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=head2 data_by_locator |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
Gets a string with the date and a string with the locator of point 'A' and an |
122
|
|
|
|
|
|
|
string with a locator for point 'B'. Returns a hash with the data shown it in the |
123
|
|
|
|
|
|
|
previous method. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
my $date = "14-03-2012"; # date in 'dd-mm-yyyy' format |
126
|
|
|
|
|
|
|
my $locator_dep = "JN11cj"; |
127
|
|
|
|
|
|
|
my $locator_arr = "IJ90ca"; |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
my %data = $foo->data_by_locator($date,$locator_dep,$locator_arr); |
130
|
|
|
|
|
|
|
print Dumper(%data); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=cut |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub data_by_locator { |
135
|
1
|
|
|
1
|
1
|
759
|
my $self = shift; |
136
|
1
|
|
|
|
|
6
|
my $date = shift; |
137
|
1
|
|
|
|
|
6
|
my ($locator_dep, $locator_arr) = @_; |
138
|
1
|
|
|
|
|
5
|
my ($lat_dep, $long_dep, $lat_arr, $long_arr) = undef; |
139
|
1
|
50
|
|
|
|
30
|
($lat_dep, $long_dep) = loc2degree($self,$locator_dep) if ($locator_dep); |
140
|
1
|
50
|
|
|
|
20
|
($lat_arr, $long_arr) = loc2degree($self,$locator_arr) if ($locator_arr); |
141
|
|
|
|
|
|
|
|
142
|
1
|
50
|
|
|
|
14
|
$lat_dep =~ s/\./N/ if ($lat_dep !~ /^\s\d+/); |
143
|
1
|
50
|
|
|
|
8
|
$lat_dep =~ s/\./S/ if ($lat_dep =~ /^\s\d+/); |
144
|
1
|
50
|
|
|
|
7
|
$lat_arr =~ s/\./N/ if ($lat_arr !~ /^\s\d+/); |
145
|
1
|
50
|
|
|
|
9
|
$lat_arr =~ s/\./S/ if ($lat_arr =~ /^\s\d+/); |
146
|
|
|
|
|
|
|
|
147
|
1
|
50
|
|
|
|
11
|
$long_dep =~ s/\./E/ if ($long_dep !~ /^\s\d+/); |
148
|
1
|
50
|
|
|
|
7
|
$long_dep =~ s/\./W/ if ($long_dep =~ /^\s\d+/); |
149
|
1
|
50
|
|
|
|
7
|
$long_arr =~ s/\./E/ if ($long_arr !~ /^\s\d+/); |
150
|
1
|
50
|
|
|
|
9
|
$long_arr =~ s/\./W/ if ($long_arr =~ /^\s\d+/); |
151
|
|
|
|
|
|
|
|
152
|
1
|
|
|
|
|
10
|
my %coordinates = ( |
153
|
|
|
|
|
|
|
long_1 => $long_dep, |
154
|
|
|
|
|
|
|
lat_1 => $lat_dep, |
155
|
|
|
|
|
|
|
long_2 => $long_arr, |
156
|
|
|
|
|
|
|
lat_2 => $lat_arr, |
157
|
|
|
|
|
|
|
); |
158
|
|
|
|
|
|
|
|
159
|
1
|
|
|
|
|
6
|
my %data = data_constructor($self, $date, %coordinates); |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
sub data_constructor { |
163
|
2
|
|
|
2
|
1
|
4
|
my $self = shift; |
164
|
2
|
|
|
|
|
4
|
my $date = shift; |
165
|
2
|
|
|
|
|
5
|
my %coord = @_; |
166
|
2
|
|
|
|
|
31
|
my $error = ""; |
167
|
|
|
|
|
|
|
|
168
|
2
|
|
|
|
|
28
|
%coord = (%coord, sexag2dec($self, %coord)); |
169
|
2
|
|
|
|
|
16
|
%coord = check_error(%coord); |
170
|
|
|
|
|
|
|
|
171
|
2
|
|
|
|
|
14
|
my @DEPARTURE = NESW( $coord{long_1_dec}, $coord{lat_1_dec} ); |
172
|
2
|
|
|
|
|
61
|
my @ARRIVE = NESW( $coord{long_2_dec}, $coord{lat_2_dec} ); |
173
|
2
|
|
|
|
|
32
|
my $km = great_circle_distance(@DEPARTURE, @ARRIVE, 6371); # medium value for Earth radii |
174
|
2
|
|
|
|
|
177
|
$km = sprintf("%.2f",$km); |
175
|
2
|
|
|
|
|
10
|
my $mi = $km / 1.609344; # miles conversion |
176
|
2
|
|
|
|
|
12
|
$mi = sprintf("%.2f",$mi); |
177
|
2
|
|
|
|
|
12
|
my $rad = great_circle_direction(@DEPARTURE, @ARRIVE); |
178
|
2
|
|
|
|
|
90
|
my $sexag = dec2sexag($self, rad2deg($rad)); |
179
|
2
|
|
|
|
|
9
|
my $rad_round = sprintf("%.2f",(rad2deg($rad))); |
180
|
2
|
|
|
|
|
54
|
my $compass = compass($self, rad2deg($rad)); |
181
|
|
|
|
|
|
|
|
182
|
2
|
|
|
|
|
10
|
my $locator_dep = degree2loc($self, $coord{lat_1}, $coord{long_1}); |
183
|
2
|
|
|
|
|
523
|
my $locator_arr = degree2loc($self, $coord{lat_2}, $coord{long_2}); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
|
186
|
2
|
|
|
|
|
358
|
my %sun_departure = cicle_sun($self, $coord{lat_1_dec}, $coord{long_1_dec}, $date, "_departure"); |
187
|
2
|
|
|
|
|
11
|
my %sun_arrive = cicle_sun($self, $coord{lat_2_dec}, $coord{long_2_dec}, $date, "_arrive"); |
188
|
|
|
|
|
|
|
|
189
|
2
|
|
|
|
|
47
|
%coord = ( %coord, |
190
|
|
|
|
|
|
|
distance_km => $km, |
191
|
|
|
|
|
|
|
distance_mi => $mi, |
192
|
|
|
|
|
|
|
course_sexag => $sexag, |
193
|
|
|
|
|
|
|
course_dec => $rad_round, |
194
|
|
|
|
|
|
|
compass => $compass, |
195
|
|
|
|
|
|
|
date => $date, |
196
|
|
|
|
|
|
|
locator_1 => $locator_dep, |
197
|
|
|
|
|
|
|
locator_2 => $locator_arr, |
198
|
|
|
|
|
|
|
%sun_departure, %sun_arrive |
199
|
|
|
|
|
|
|
); |
200
|
2
|
50
|
|
|
|
14
|
if ($error) { return my %error = (_error => $error); } |
|
0
|
|
|
|
|
0
|
|
201
|
|
|
|
|
|
|
|
202
|
2
|
|
|
|
|
62
|
return %coord; |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 loc2degree |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Gets a string with grid locator value and returns an array with the latitude and |
208
|
|
|
|
|
|
|
longitude in sexagesimal degrees form. |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=cut |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub loc2degree { |
213
|
3
|
|
|
3
|
1
|
724
|
my ($self,$loc) = @_; |
214
|
3
|
|
|
|
|
48
|
my $grid = new Ham::Locator; |
215
|
3
|
|
|
|
|
76
|
my $set_loc = $grid->set_loc($loc); |
216
|
|
|
|
|
|
|
|
217
|
3
|
|
|
|
|
95
|
my ($latitude, $longitude) = $grid->loc2latlng; |
218
|
|
|
|
|
|
|
|
219
|
3
|
|
|
|
|
834
|
my $lat_sexag = dec2sexag($self, $latitude); |
220
|
3
|
|
|
|
|
11
|
my $long_sexag = dec2sexag($self, $longitude); |
221
|
|
|
|
|
|
|
|
222
|
3
|
100
|
|
|
|
16
|
$lat_sexag =~ tr/-/ / if($latitude < 0); |
223
|
3
|
100
|
|
|
|
13
|
$long_sexag =~ tr/S/W/ if($longitude < 0); |
224
|
3
|
100
|
|
|
|
13
|
$long_sexag =~ tr/N/E/ if($longitude > 0); |
225
|
3
|
100
|
|
|
|
10
|
$long_sexag =~ tr/-/ / if($longitude < 0); |
226
|
|
|
|
|
|
|
|
227
|
3
|
|
|
|
|
34
|
return ($lat_sexag, $long_sexag); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head2 degree2loc |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Gets a string with the latitude and a string with the longitude, in sexagesimal |
233
|
|
|
|
|
|
|
notation, of a point on Earth and returns a string with the grid locator notation. |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
my $lat = "41N23"; |
236
|
|
|
|
|
|
|
my $long = "2E11"; |
237
|
|
|
|
|
|
|
my $locator = $foo->degree2loc($lat, $long); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=cut |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
sub degree2loc { |
242
|
5
|
|
|
5
|
1
|
1093
|
my ($self, $lat, $long) = @_; |
243
|
5
|
|
|
|
|
24
|
my %deg_coord = ( |
244
|
|
|
|
|
|
|
lat_1 => $lat, |
245
|
|
|
|
|
|
|
long_1 => $long |
246
|
|
|
|
|
|
|
); |
247
|
5
|
|
|
|
|
47
|
my %dec_coord = sexag2dec($self, %deg_coord); |
248
|
5
|
|
|
|
|
26
|
my %check = check_error(%dec_coord); |
249
|
5
|
50
|
|
|
|
25
|
if ($check{_error}) { return "Error to convert degrees to locator."; } |
|
0
|
|
|
|
|
0
|
|
250
|
|
|
|
|
|
|
|
251
|
5
|
|
|
|
|
61
|
my $m = new Ham::Locator; |
252
|
5
|
|
|
|
|
85
|
$m->set_precision(6); |
253
|
5
|
|
|
|
|
144
|
$m->set_latlng($dec_coord{lat_1_dec}, $dec_coord{long_1_dec}); |
254
|
5
|
|
|
|
|
80
|
my $loc = $m->latlng2loc; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=head2 compass |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
Gets an integer with a decimal degree and returns a string with its |
260
|
|
|
|
|
|
|
equivalent value in a compass (North, East, ...). It uses a separation of 11.25 |
261
|
|
|
|
|
|
|
degrees for each position, 32 cardinal positions of total. |
262
|
|
|
|
|
|
|
Values range must be between 0 to 360 degrees. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
my $compass = $foo->compass("-90.0"); # returns "W" (west) |
265
|
|
|
|
|
|
|
my $compass = $foo->compass("270.0"); # returns "W" (west) |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=cut |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
sub compass { |
270
|
3
|
|
|
3
|
1
|
1035
|
my $self = shift; |
271
|
3
|
|
|
|
|
8
|
my $course = shift; |
272
|
3
|
|
|
|
|
15
|
my $pattern = qr/(\+?)(-?)\d{1,3}(\.?)(\d*)$/; |
273
|
3
|
|
|
|
|
7
|
my $error_msg = "Error value must be a integer between 0 to 360"; |
274
|
|
|
|
|
|
|
|
275
|
3
|
50
|
|
|
|
69
|
if ($course !~ $pattern) { |
276
|
0
|
|
|
|
|
0
|
return $error_msg; |
277
|
|
|
|
|
|
|
} else { |
278
|
3
|
50
|
33
|
|
|
68
|
if ($course < -360 or $course > 360) { return $error_msg; } |
|
0
|
|
|
|
|
0
|
|
279
|
3
|
|
|
|
|
36
|
my @rosa = ('NbE','NNE','NEbN','NE','NEbE','ENE','EbN','E','EbS','ESE','SEbE','SE','SEbS','SSE','SbE','S','SbW','SSW','SWbS','SW','SWbW','WSW','WbS','W','WbN','WNW','NWbW','NW','NWbN','NNW','NbW','N'); |
280
|
|
|
|
|
|
|
|
281
|
3
|
|
|
|
|
36
|
my $rosa_index = int((+$course / 11.25))-1; |
282
|
3
|
|
|
|
|
32
|
return $rosa[$rosa_index]; |
283
|
|
|
|
|
|
|
} |
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
=head2 dec2sexag |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
Gets an integer with a decimal degree value and returns a string with its |
289
|
|
|
|
|
|
|
equivalence to sexagesimal degree form. Only returns degrees and minutes. |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
=cut |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
sub dec2sexag{ |
294
|
9
|
|
|
9
|
1
|
748
|
my ($self, $course) = @_; |
295
|
9
|
|
|
|
|
103
|
my @degree_part = split(/\./, $course); |
296
|
9
|
|
|
|
|
81
|
my $decimal = (('0.'.$degree_part[1]) * 60); |
297
|
9
|
|
|
|
|
84
|
my $min = int((sprintf("%.2f",$decimal))); |
298
|
9
|
|
|
|
|
48
|
my $sexag = $degree_part[0].".".$min; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=head2 sexag2dec |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
Gets a hash with sexagesimal value (maximun four) and returns a hash with its |
304
|
|
|
|
|
|
|
decimal values. |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Range of values are -90 to 90 for latitudes, and -180 to 180 for longitudes. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
Values must be a pair, longitude and latitude. Two values for one point or |
309
|
|
|
|
|
|
|
four values (two pairs) for two points. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
There is not mandatory send a complete hash (4 values), but you will receive a |
312
|
|
|
|
|
|
|
hash with the four. |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
You can use it like this: |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
my %coord = ( |
317
|
|
|
|
|
|
|
Long_1 => "41N23.30", |
318
|
|
|
|
|
|
|
Lat_1 => "2E11.10" |
319
|
|
|
|
|
|
|
); |
320
|
|
|
|
|
|
|
my %sexag = $foo->sexag2dec(%coord); |
321
|
|
|
|
|
|
|
foreach my $key (sort keys %sexag) { |
322
|
|
|
|
|
|
|
say $key." = ".$sexag{$key} if ($sexag{$key}); |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
The index send it, you will receive with '_dec' suffix, ie, you send |
326
|
|
|
|
|
|
|
'latitude' and receive 'latitude_dec' |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
=cut |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
sub sexag2dec { |
331
|
9
|
|
|
9
|
1
|
1130
|
my $self = shift; |
332
|
9
|
|
|
|
|
30
|
my %coord = @_; |
333
|
|
|
|
|
|
|
|
334
|
9
|
|
|
|
|
19
|
my $error_msg_1 = "Error sexagesimal conversion. Out of range. (-90 to 90)"; |
335
|
9
|
|
|
|
|
19
|
my $error_msg_2 = "Error sexagesimal conversion. Out of range. (-180 to 180)"; |
336
|
|
|
|
|
|
|
|
337
|
9
|
|
|
|
|
87
|
my $grad_match = qr|(\d{1,3})([NSEOW+-\.])(\d{1,2})\.{0,1}(\d{0,2}){0,1}|i; |
338
|
9
|
|
|
|
|
49
|
my %coord_dec = ( |
339
|
|
|
|
|
|
|
lat_1_dec => '', |
340
|
|
|
|
|
|
|
lat_2_dec => '', |
341
|
|
|
|
|
|
|
long_1_dec => '', |
342
|
|
|
|
|
|
|
long_2_dec => '', |
343
|
|
|
|
|
|
|
); |
344
|
9
|
|
|
|
|
18
|
my $secs = undef; |
345
|
9
|
|
|
|
|
93
|
foreach my $key (sort keys %coord) { |
346
|
22
|
50
|
|
|
|
77
|
if ($4) {$secs = $4/3600;} else {$secs = 0} |
|
0
|
|
|
|
|
0
|
|
|
22
|
|
|
|
|
37
|
|
347
|
22
|
50
|
33
|
|
|
300
|
if ($key && ($coord{$key} =~ $grad_match)) { |
348
|
22
|
100
|
100
|
|
|
222
|
if ($2 eq 'S' || $2 eq 'W' || $2 eq '-') { |
|
|
|
66
|
|
|
|
|
349
|
10
|
|
|
|
|
56
|
$coord_dec{$key.'_dec'} = (-($1+(($3/60)+$secs))); |
350
|
10
|
50
|
66
|
|
|
68
|
if ($2 eq 'S' && $coord_dec{$key.'_dec'} < -90) { $coord_dec{$key.'_dec'} = $error_msg_1; } |
|
0
|
|
|
|
|
0
|
|
351
|
10
|
50
|
66
|
|
|
87
|
if ($2 eq 'W' && $coord_dec{$key.'_dec'} < -180) { $coord_dec{$key.'_dec'} = $error_msg_2; } |
|
0
|
|
|
|
|
0
|
|
352
|
|
|
|
|
|
|
} else { |
353
|
12
|
|
|
|
|
81
|
$coord_dec{$key.'_dec'} = ($1+(($3/60)+$secs)); |
354
|
12
|
50
|
66
|
|
|
76
|
if ($2 eq 'N' && $coord_dec{$key.'_dec'} > 90) { $coord_dec{$key.'_dec'} = $error_msg_1; } |
|
0
|
|
|
|
|
0
|
|
355
|
12
|
50
|
66
|
|
|
98
|
if ($2 eq 'E' && $coord_dec{$key.'_dec'} > 180) { $coord_dec{$key.'_dec'} = $error_msg_2; } |
|
0
|
|
|
|
|
0
|
|
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
} |
359
|
9
|
|
|
|
|
114
|
return %coord_dec; |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
=head2 cicle_sun |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
Gets three strings with latitude, longitude, in decimal degrees, and date, in |
365
|
|
|
|
|
|
|
'dd-mm-yyyy' format and returns a hash with Sunrise time, Sunset time and |
366
|
|
|
|
|
|
|
Midday time in hours and minutes format in Universal Time (UTC). |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
my %sun = $foo->cicle_sun($lat,$long,$date); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
=cut |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub cicle_sun { |
373
|
5
|
|
|
5
|
1
|
14
|
my $self = shift; |
374
|
5
|
|
|
|
|
26
|
my ($Lat, $Long, $date, $origin_point) = @_; |
375
|
|
|
|
|
|
|
|
376
|
5
|
100
|
|
|
|
33
|
$origin_point = "" if (!$origin_point); |
377
|
5
|
50
|
|
|
|
24
|
$date = "00-00-0000" if ($date =~ /Error/); |
378
|
5
|
50
|
|
|
|
55
|
$Lat = 0 if ($Lat =~ /Error/); |
379
|
5
|
50
|
|
|
|
38
|
$Long = 0 if ($Long =~ /Error/); |
380
|
|
|
|
|
|
|
|
381
|
5
|
|
|
|
|
16
|
my @date_ = date_split($self, $date); |
382
|
5
|
|
|
|
|
23
|
my $day = $date_[0]; |
383
|
5
|
|
|
|
|
9
|
my $month = $date_[1]; |
384
|
5
|
|
|
|
|
7
|
my $year = $date_[2]; |
385
|
5
|
|
|
|
|
6
|
my $UT = '0'; |
386
|
|
|
|
|
|
|
|
387
|
5
|
50
|
|
|
|
15
|
if ($day =~ /Error/) { |
388
|
0
|
|
|
|
|
0
|
return my %solar_cycle = (_error => $day); |
389
|
|
|
|
|
|
|
} |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# Julian data |
393
|
5
|
|
|
|
|
8
|
my $GGG = 1; |
394
|
5
|
|
|
|
|
7
|
my $S = 1; |
395
|
|
|
|
|
|
|
|
396
|
5
|
50
|
|
|
|
16
|
if ($year <= 1585) { $GGG = 0; } |
|
0
|
|
|
|
|
0
|
|
397
|
5
|
|
|
|
|
24
|
my $JD = -1 * int(7 * (int(($month + 9) / 12 ) + $year) / 4); |
398
|
5
|
50
|
|
|
|
20
|
if (($month - 9) < 0) { $S = -1; } |
|
5
|
|
|
|
|
9
|
|
399
|
5
|
|
|
|
|
8
|
my $A = abs($month - 9); |
400
|
5
|
|
|
|
|
11
|
my $J1 = int($year + $S * int($A / 7)); |
401
|
5
|
|
|
|
|
12
|
$J1 = -1 * int((int($J1 / 100) + 1) * 3 / 4); |
402
|
5
|
|
|
|
|
12
|
$JD = $JD + int(275 * $month / 9) + $day + ($GGG * $J1); |
403
|
5
|
|
|
|
|
11
|
$JD = $JD + 1721027 + 2 * $GGG + 367 * $year - 0.5; |
404
|
5
|
|
|
|
|
7
|
my $J2 = $JD; |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# Earth values |
407
|
5
|
|
|
|
|
5
|
my $RAD = 180 / pi; |
408
|
5
|
|
|
|
|
9
|
my $ET = 0.016718; |
409
|
5
|
|
|
|
|
6
|
my $VP = 8.22e-5; |
410
|
5
|
|
|
|
|
7
|
my $P = 4.93204; |
411
|
5
|
|
|
|
|
5
|
my $M0 = 2.12344; |
412
|
5
|
|
|
|
|
7
|
my $MN = 1.72019e-2; |
413
|
5
|
|
|
|
|
7
|
my $T0 = 2444000.5; |
414
|
5
|
|
|
|
|
10
|
$S = 2415020.5; |
415
|
5
|
|
|
|
|
10
|
$P = $P + ($J2 - $T0) * $VP / 100; |
416
|
5
|
|
|
|
|
9
|
my $AM = $M0 + $MN * ($J2 - $T0); |
417
|
5
|
|
|
|
|
19
|
$AM = $AM - 2 * pi * int($AM / (2 * pi)); |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
# Kepler equation for the Earth |
420
|
5
|
|
|
|
|
36
|
my $V = $AM + 2 * $ET * sin($AM) + 1.25 * $ET * $ET * sin(2 * $AM); |
421
|
5
|
50
|
|
|
|
32
|
if ($V < 0) { |
422
|
0
|
|
|
|
|
0
|
$V = 2 * pi + $V; |
423
|
|
|
|
|
|
|
} |
424
|
5
|
|
|
|
|
9
|
my $L = $P + $V; |
425
|
5
|
|
|
|
|
10
|
$L = $L - 2 * pi * int($L / (2 * pi)); |
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
#AR and DEC calculus |
428
|
5
|
|
|
|
|
9
|
my $Z = ($J2 - 2415020.5) / 365.2422; |
429
|
5
|
|
|
|
|
10
|
my $OB = 23.452294 - (0.46845 * $Z + 0.00000059 * $Z * $Z) / 3600; |
430
|
5
|
|
|
|
|
19
|
$OB = $OB / $RAD; |
431
|
5
|
|
|
|
|
40
|
my $DC = asin(sin($OB) * sin($L)); |
432
|
5
|
|
|
|
|
82
|
my $AR = acos(cos($L) / cos($DC)); |
433
|
5
|
50
|
|
|
|
59
|
if ($L > pi) { |
434
|
0
|
|
|
|
|
0
|
$AR = 2 * pi - $AR; |
435
|
|
|
|
|
|
|
} |
436
|
5
|
|
|
|
|
13
|
$OB = $OB * $RAD; |
437
|
5
|
|
|
|
|
6
|
$L = $L * $RAD; |
438
|
5
|
|
|
|
|
12
|
$AR = $AR * 12 / pi; |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
# HH.MM to AR conversion |
441
|
5
|
|
|
|
|
9
|
my $H = int($AR); |
442
|
5
|
|
|
|
|
9
|
my $M = int(($AR - int($AR)) * 60); |
443
|
5
|
|
|
|
|
12
|
$S=(($AR - int($AR)) * 60 - $M) * 60; |
444
|
5
|
|
|
|
|
7
|
$DC = $DC * $RAD; |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# Degrees conversion from DEC |
447
|
5
|
|
|
|
|
8
|
my $D = abs($DC); |
448
|
5
|
50
|
|
|
|
40
|
if ($DC > 0) { |
449
|
5
|
|
|
|
|
14
|
my $G1 = int($D); |
450
|
|
|
|
|
|
|
} else { |
451
|
0
|
|
|
|
|
0
|
my $G1 = (-1) * int($D); |
452
|
|
|
|
|
|
|
} |
453
|
5
|
|
|
|
|
29
|
my $M1 = int(($D - int($D)) * 60); |
454
|
5
|
|
|
|
|
12
|
my $S1 = (($D - int($D)) * 60 - $M1) * 60; |
455
|
5
|
50
|
|
|
|
14
|
if ($DC < 0) { |
456
|
0
|
|
|
|
|
0
|
$M1 = -$M1; |
457
|
0
|
|
|
|
|
0
|
$S1 = -$S1; |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
# Time equation |
461
|
5
|
|
|
|
|
8
|
my $MR = 0.04301; |
462
|
5
|
|
|
|
|
6
|
my $F = 13750.987; |
463
|
5
|
|
|
|
|
20
|
my $C = 2 * $ET * $F * sin($AM) + 1.25 * $ET * $ET * $F * sin(2 * $AM); |
464
|
5
|
|
|
|
|
17
|
my $R = -$MR * $F * sin(2 * ($P + $AM)) + $MR * $MR * $F * sin(4 * ($P + $AM)) / 2; |
465
|
5
|
|
|
|
|
7
|
$ET = $C + $R; |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
# Semi-diurn arc calculus |
468
|
5
|
|
|
|
|
26
|
my $H0 = acos(-tan($Lat / $RAD) * tan($DC / $RAD)); |
469
|
5
|
|
|
|
|
199
|
$H0 = $H0 * $RAD; |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
# DEC variations |
472
|
5
|
|
|
|
|
22
|
my $VD = 0.9856 * sin($OB / $RAD) * cos($L / $RAD) / cos($DC / $RAD); |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# Sun rise calculus |
475
|
5
|
|
|
|
|
11
|
my $VDOR = $VD * (-$H0 + 180) / 360; |
476
|
5
|
|
|
|
|
12
|
my $DCOR = $DC + $VDOR; |
477
|
5
|
|
|
|
|
19
|
my $HORTO = -acos(-tan($Lat / $RAD) * tan($DCOR / $RAD)); |
478
|
5
|
|
|
|
|
136
|
my $VHORTO = 5 / (6 * cos($Lat / $RAD) * cos($DCOR / $RAD) * sin($HORTO)); |
479
|
5
|
|
|
|
|
15
|
$HORTO = ($HORTO * $RAD + $VHORTO) / 15; |
480
|
5
|
|
|
|
|
15
|
my $TUORTO = $HORTO + $ET / 3600 - $Long / 15 + 12; |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
# Sun rise value conversion to HH.MM |
483
|
5
|
|
|
|
|
10
|
my $HOR = int($TUORTO); |
484
|
5
|
|
|
|
|
27
|
my $MOR = int(($TUORTO - $HOR) * 60 + 0.5); |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
# AZ calculation |
487
|
5
|
|
|
|
|
12
|
my $TUC = 12 + $ET / 3600 - $Long / 15; |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
# AZ value conversion to HH.MM |
490
|
5
|
|
|
|
|
9
|
my $HC = int($TUC); |
491
|
5
|
|
|
|
|
13
|
my $MC = int(($TUC - $HC) * 60 + 0.5); |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# Sunset calculus |
494
|
5
|
|
|
|
|
11
|
my $VDOC = $VD * ($H0 + 180) / 360; |
495
|
5
|
|
|
|
|
9
|
my $DCOC = $DC + $VDOC; |
496
|
5
|
|
|
|
|
18
|
my $HOC = acos(-tan($Lat / $RAD) * tan($DCOC / $RAD)); |
497
|
5
|
|
|
|
|
135
|
my $VHOC = 5 / (6 * cos($Lat / $RAD) * cos($DCOC / $RAD) * sin($HOC)); |
498
|
5
|
|
|
|
|
11
|
$HOC = ($HOC * $RAD + $VHOC) / 15; |
499
|
5
|
|
|
|
|
11
|
my $TUOC = $HOC + $ET / 3600 - $Long / 15 + 12; |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# Sunset conversion to HH.MM |
502
|
5
|
|
|
|
|
9
|
$HOC = int($TUOC); |
503
|
5
|
|
|
|
|
10
|
my $MOC = int(($TUOC - $HOC) * 60 + 0.5); |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# Altitude of AZ |
506
|
5
|
|
|
|
|
12
|
my $HCUL = 90 - $Lat + ($DCOR + $DCOC) / 2; |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
# Degree conversion from altitude |
509
|
5
|
|
|
|
|
9
|
my $GCUL = int($HCUL); |
510
|
5
|
|
|
|
|
14
|
my $MCUL = int (($HCUL - $GCUL) * 60 + 0.5); |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
# AZ from Sunrise and Sunset |
513
|
5
|
|
|
|
|
25
|
my $ACOC = acos(-sin($DCOC / $RAD) / cos($Lat / $RAD)) * $RAD; |
514
|
5
|
|
|
|
|
49
|
my $ACOR = 360 - acos(-sin($DCOR / $RAD) / cos($Lat / $RAD)) * $RAD; |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# AZ conversion to degrees |
517
|
5
|
|
|
|
|
76
|
my $GACOC = int($ACOC); |
518
|
5
|
|
|
|
|
13
|
my $MACOC = int(($ACOC - $GACOC) * 60 + 0.5); |
519
|
5
|
|
|
|
|
8
|
my $GACOR = int($ACOR); |
520
|
5
|
|
|
|
|
11
|
my $MACOR = int(($ACOR - $GACOR) * 60 + 0.5); |
521
|
|
|
|
|
|
|
|
522
|
5
|
|
|
|
|
21
|
my $sunrise = $HOR."h ".$MOR."m"; |
523
|
5
|
|
|
|
|
11
|
my $sunset = $HOC."h ".$MOC."m"; |
524
|
5
|
|
|
|
|
10
|
my $midday = $HC."h ".$MC."m"; |
525
|
|
|
|
|
|
|
|
526
|
5
|
|
|
|
|
13
|
my $k_sunrise = "sunrise".$origin_point; |
527
|
5
|
|
|
|
|
8
|
my $k_sunset = "sunset".$origin_point; |
528
|
5
|
|
|
|
|
7
|
my $k_midday = "midday".$origin_point; |
529
|
|
|
|
|
|
|
|
530
|
5
|
|
|
|
|
23
|
my %solar_cycle = ( |
531
|
|
|
|
|
|
|
$k_sunrise => $sunrise, |
532
|
|
|
|
|
|
|
$k_sunset => $sunset, |
533
|
|
|
|
|
|
|
$k_midday => $midday, |
534
|
|
|
|
|
|
|
); |
535
|
|
|
|
|
|
|
|
536
|
5
|
50
|
|
|
|
17
|
if ($day =~ /Error/) { |
537
|
0
|
|
|
|
|
0
|
return my %solar_cycle = (_error => $day); |
538
|
|
|
|
|
|
|
} |
539
|
5
|
50
|
33
|
|
|
52
|
if ($Lat == 0 || $Long == 0) { |
540
|
0
|
|
|
|
|
0
|
%solar_cycle = (_error => "Error sexagesimal conversion. Out of range."); |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
5
|
|
|
|
|
58
|
return %solar_cycle; |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
=head2 date_split |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
Gets a string with date in format 'dd-mm-yyyy' and check it if value is a valid date. |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
Returns an array with the day, month and year ... or error message. |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=cut |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
sub date_split { |
555
|
6
|
|
|
6
|
1
|
410
|
my ($self, $date) = @_; |
556
|
6
|
|
|
|
|
12
|
my @part_of_date; |
557
|
6
|
|
|
|
|
18
|
my $check = is_date($date); |
558
|
6
|
50
|
|
|
|
30
|
if ($check !~ /Error/) { |
559
|
6
|
|
|
|
|
48
|
return @part_of_date = split(/-/,$date); |
560
|
|
|
|
|
|
|
} else { |
561
|
0
|
|
|
|
|
0
|
return $part_of_date[0] = $check; |
562
|
|
|
|
|
|
|
} |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
# --------------- |
566
|
|
|
|
|
|
|
# INTERNAL SUBS |
567
|
|
|
|
|
|
|
# --------------- |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
=head1 Internals subs |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=head2 data_constructor |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
Internal function used by data_by_coordinates() and data_by_locator() to call the others functions and create a response. |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
=head2 NESW |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
Internal function to convert degrees to radians. |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
=head2 check_error |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
Internal function to check errors in data_by_coordinates() or data_by_locator(). |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head2 is_date |
584
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
Internal function to check if a date is valid. |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
=cut |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
sub NESW { |
590
|
4
|
|
|
4
|
1
|
22
|
deg2rad($_[0]), deg2rad(90 - $_[1]) |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
sub is_date { |
594
|
6
|
|
|
6
|
1
|
10
|
my $date = shift; |
595
|
6
|
|
|
|
|
28
|
my $pattern = qr/\d{1,2}(-)\d{1,2}(-)\d{4}/; |
596
|
|
|
|
|
|
|
|
597
|
6
|
50
|
|
|
|
75
|
if ($date !~ $pattern) { |
598
|
0
|
|
|
|
|
0
|
return "Error date format. Must be dd-mm-yyyy"; |
599
|
|
|
|
|
|
|
} else { |
600
|
6
|
|
|
|
|
26
|
my @part_of_date = split(/-/,$date); |
601
|
|
|
|
|
|
|
|
602
|
6
|
50
|
|
|
|
66
|
my $intDay = ($part_of_date[0] <= 9) ? sprintf("%02d", $part_of_date[0]) : sprintf("%2d", $part_of_date[0]); |
603
|
6
|
50
|
|
|
|
31
|
my $intMonth = ($part_of_date[1] <= 9) ? sprintf("%02d", $part_of_date[1]) : sprintf("%2d", $part_of_date[1]); |
604
|
6
|
|
|
|
|
11
|
my $intYear = $part_of_date[2]; |
605
|
|
|
|
|
|
|
|
606
|
6
|
|
|
|
|
66
|
my %array_month = ( |
607
|
|
|
|
|
|
|
'01' => 31, |
608
|
|
|
|
|
|
|
'02' => 0, |
609
|
|
|
|
|
|
|
'03' => 31, |
610
|
|
|
|
|
|
|
'04' => 30, |
611
|
|
|
|
|
|
|
'05' => 31, |
612
|
|
|
|
|
|
|
'06' => 30, |
613
|
|
|
|
|
|
|
'07' => 31, |
614
|
|
|
|
|
|
|
'08' => 31, |
615
|
|
|
|
|
|
|
'09' => 30, |
616
|
|
|
|
|
|
|
'10' => 31, |
617
|
|
|
|
|
|
|
'11' => 30, |
618
|
|
|
|
|
|
|
'12' => 31, |
619
|
|
|
|
|
|
|
); |
620
|
|
|
|
|
|
|
|
621
|
6
|
50
|
|
|
|
28
|
if ($intMonth > 12) { return "Error in date format. This must be a valid dd-mm-yyyy." } |
|
0
|
|
|
|
|
0
|
|
622
|
|
|
|
|
|
|
|
623
|
6
|
50
|
33
|
|
|
67
|
if ($array_month{$intMonth} != 0 && $part_of_date[0] <= $array_month{$intMonth}) { |
624
|
6
|
|
|
|
|
46
|
return 1; |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
0
|
0
|
|
|
|
0
|
if ($intMonth == 0) { |
628
|
0
|
0
|
0
|
|
|
0
|
if ($intDay > 0 && $intDay < 29) { |
|
|
0
|
|
|
|
|
|
629
|
0
|
|
|
|
|
0
|
return 1; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
elsif ($intDay == 29) { |
632
|
0
|
0
|
0
|
|
|
0
|
if (($intYear % 4 == 0) && ($intYear % 100 != 0) || ($intYear % 400) == 0) { |
|
|
|
0
|
|
|
|
|
633
|
0
|
|
|
|
|
0
|
return 1; |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
} |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
|
638
|
0
|
|
|
|
|
0
|
return "Error in date format. This must be a valid dd-mm-yyyy."; |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
sub check_error { |
643
|
7
|
|
|
7
|
1
|
27
|
my %coord = @_; |
644
|
7
|
|
|
|
|
54
|
foreach my $key (sort keys %coord) { |
645
|
36
|
50
|
|
|
|
197
|
if ($coord{$key} =~ /Error/) { |
646
|
0
|
|
|
|
|
0
|
$coord{_error} = $coord{$key}; |
647
|
0
|
|
|
|
|
0
|
$coord{$key} = 0; |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
} |
650
|
7
|
|
|
|
|
52
|
return %coord; |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=head1 Cheking Errors |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
In functions that return only a string or an array, errors will detect to match /Error/ word. |
657
|
|
|
|
|
|
|
In complex functions, like data_by_coordinates, that responses with a hash, you check the '_error' index, i.e: |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
%data = $foo->data_by_locator($date,$locator_1,$locator_2); |
660
|
|
|
|
|
|
|
if (!$data{_error}) { |
661
|
|
|
|
|
|
|
foreach my $key (sort keys %data) { |
662
|
|
|
|
|
|
|
say $key.": ".$data{$key}; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
} else { |
665
|
|
|
|
|
|
|
say $data{_error}; |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
... or something like this :p |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
=cut |
671
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
=head1 AUTHOR |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
CJUAN, C<< >> |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=head1 BUGS |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
Please report any bugs or feature requests to C, or through |
680
|
|
|
|
|
|
|
the web interface at L. I will be notified, and then you'll |
681
|
|
|
|
|
|
|
automatically be notified of progress on your bug as I make changes. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=head1 SUPPORT |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
perldoc Ham::Resources::Utils |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
You can also look for information at: |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
=over 4 |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
L |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
L |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
=item * CPAN Ratings |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
L |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=item * Search CPAN |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
L |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
=back |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
=head1 TODO |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
=over 4 |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
=item * Add long path course and distances from point A to B |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=item * Add a function to calculate X and Y coordinates based on real coordinates for use it on a geographical projection (or Plate Carree) |
722
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
=back |
724
|
|
|
|
|
|
|
|
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
Copyright 2012-2016 CJUAN. |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
731
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
732
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
See http://dev.perl.org/licenses/ for more information. |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
=cut |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
1; # End of Ham::Resources::Utils |