File Coverage

blib/lib/Geo/Converter/dms2dd.pm
Criterion Covered Total %
statement 92 98 93.8
branch 51 58 87.9
condition 16 24 66.6
subroutine 12 12 100.0
pod 0 1 0.0
total 171 193 88.6


line stmt bran cond sub pod time code
1             # package to convert degrees minutes seconds values to decimal degrees
2             # also does some simple validation of decimal degree values as a side effect
3             package Geo::Converter::dms2dd;
4            
5 1     1   33694 use strict;
  1         2  
  1         35  
6 1     1   4 use warnings;
  1         2  
  1         25  
7 1     1   19 use 5.010;
  1         7  
  1         52  
8            
9             our $VERSION = '0.03';
10            
11 1     1   5 use Carp;
  1         2  
  1         88  
12            
13 1     1   975 use Readonly;
  1         3698  
  1         53  
14 1     1   926 use Regexp::Common;
  1         5376  
  1         5  
15 1     1   95102 use English qw { -no_match_vars };
  1         2  
  1         17  
16            
17             require Exporter;
18 1     1   564 use base qw(Exporter);
  1         2  
  1         1802  
19             our @EXPORT_OK = qw( dms2dd );
20            
21             #############################################################
22             ## some stuff to handle values in degrees
23            
24             # some regexes
25             Readonly my $RE_REAL => qr /$RE{num}{real}/xms;
26             Readonly my $RE_INT => qr /$RE{num}{int} /xms;
27             Readonly my $RE_HEMI => qr {
28             # the hemisphere if given as text
29             \s*
30             [NESWnesw]
31             \s*
32             }xms;
33            
34             # a few constants
35             Readonly my $MAX_VALID_DD => 360;
36             Readonly my $MIN_VALID_DD => -180;
37             Readonly my $MAX_VALID_LAT => 90;
38             Readonly my $MAX_VALID_LON => 180;
39            
40             Readonly my $INVALID_CHAR_CONTEXT => 3;
41            
42             # how many distinct numbers we can have in a DMS string?
43             Readonly my $MAX_DMS_NUM_COUNT => 3;
44            
45             my $err_msg_pfx = 'DMS2DD Value error: ';
46            
47             # convert degrees minutes seconds values into decimal degrees
48             # e.g.;
49             # S23°32'09.567" = -23.5359908333333
50             # 149°23'18.009"E = 149.388335833333
51             sub dms2dd {
52 26     26 0 10125 my $args = shift;
53            
54 26         36 my $value = $args->{value};
55 26 100       248 croak "Argument 'value' not supplied\n"
56             if !defined $value;
57            
58 25         21 my $first_char_invalid;
59 25 100       75 if (not $value =~ m/ \A [\s0-9NEWSnews+-] /xms) {
60 2         7 $first_char_invalid = substr $value, 0, $INVALID_CHAR_CONTEXT;
61             }
62            
63 25 100       234 croak $err_msg_pfx . "Invalid string at start of value: $value\n"
64             if defined $first_char_invalid;
65            
66 23         44 my @nums = eval {
67 23         57 _dms2dd_extract_nums ( { value => $value } );
68             };
69 23 100       355 croak $EVAL_ERROR if ($EVAL_ERROR);
70            
71 20         23 my $hemi = eval {
72 20         51 _dms2dd_extract_hemisphere (
73             { value => $value },
74             );
75             };
76 20 100       265 croak $EVAL_ERROR if $EVAL_ERROR;
77            
78 18         20 my $multiplier = 1;
79 18 100       40 if ($hemi =~ / [SsWw-] /xms) {
80 9         10 $multiplier = -1;
81             }
82            
83             # now apply the defaults
84             # $deg is +ve, as hemispheres are handled separately
85 18   50     41 my $deg = abs ($nums[0] || 0);
86 18   100     41 my $min = $nums[1] || 0;
87 18   100     35 my $sec = $nums[2] || 0;
88            
89 18         48 my $dd = $multiplier
90             * ( $deg
91             + $min / 60
92             + $sec / 3600
93             );
94            
95 18         30 my $valid = eval {
96 18         83 _dms2dd_validate_dd_value ( {
97             %$args,
98             value => $dd,
99             hemisphere => $hemi,
100             } );
101             };
102 18 100       256 croak $EVAL_ERROR if $EVAL_ERROR;
103            
104             #my $res = join (q{ }, $value, $dd, $multiplier, $hemi, @nums) . "\n";
105            
106 16         47 return $dd;
107             }
108            
109             # are the numbers we extracted OK?
110             # must find three or fewer of which only the last can be decimal
111             sub _dms2dd_extract_nums {
112 23     23   27 my $args = shift;
113            
114 23         27 my $value = $args->{value};
115            
116 23         110 my @nums = $value =~ m/$RE_REAL/gxms;
117 23         343 my $deg = $nums[0];
118 23         32 my $min = $nums[1];
119 23         23 my $sec = $nums[2];
120            
121             # some verification
122 23         20 my $msg;
123            
124 23 50       79 if (! defined $deg) {
    100          
125 0         0 $msg = 'No numeric values in string';
126             }
127             elsif (scalar @nums > $MAX_DMS_NUM_COUNT) {
128 1         6 $msg = 'Too many numbers in string';
129             }
130            
131 23 100       161 if (defined $sec) {
132 19 100 33     54 if ($min !~ / \A $RE_INT \z/xms) {
    50          
133 1         9 $msg = 'Seconds value given, but minutes value is floating point';
134             }
135             elsif ($sec < 0 || $sec > 60) {
136 0         0 $msg = 'Seconds value is out of range';
137             }
138             }
139            
140 23 100       316 if (defined $min) {
141 22 100 33     69 if ($deg !~ / \A $RE_INT \z/xms) {
    50          
142 1         9 $msg = 'Minutes value given, but degrees value is floating point';
143             }
144             elsif ($min < 0 || $min > 60) {
145 0         0 $msg = 'Minutes value is out of range';
146             }
147             }
148            
149             # the valid degrees values depend on the hemisphere,
150             # so are trapped elsewhere
151            
152             #my $msg_pfx = 'DMS value error: ';
153 23         253 my $msg_suffix = qq{: '$value'\n};
154            
155 23 100       415 croak $err_msg_pfx . $msg . $msg_suffix
156             if $msg;
157            
158 20 50       147 return wantarray ? @nums : \@nums;
159             }
160            
161             sub _dms2dd_validate_dd_value {
162 18     18   19 my $args = shift;
163            
164 18         23 my $is_lat = $args->{is_lat};
165 18         19 my $is_lon = $args->{is_lon};
166            
167 18         19 my $dd = $args->{value};
168 18         20 my $hemi = $args->{hemisphere};
169            
170 18         19 my $msg_pfx = 'DMS2DD Coord error: ';
171 18         15 my $msg;
172            
173             # if we know the hemisphere then check it is in bounds,
174             # otherwise it must be in the interval [-180,360]
175 18 100 100     97 if ($is_lat // ($hemi =~ / [SsNn] /xms)) {
    100 100        
    50 33        
176 10 100       29 if ($is_lon) {
    100          
177 1         13 $msg = "Longitude specified, but latitude found: $dd\n"
178             }
179             elsif (abs ($dd) > $MAX_VALID_LAT) {
180 1         10 $msg = "Latitude out of bounds: $dd\n"
181             }
182             }
183             elsif ($is_lon // ($hemi =~ / [EeWw] /xms)) {
184 7 50       27 if ($is_lat) {
    50          
185 0         0 $msg = "Latitude specified, but longitude found\n"
186             }
187             elsif (abs ($dd) > $MAX_VALID_LON) {
188 0         0 $msg = "Longitude out of bounds: $dd\n"
189             }
190             }
191             elsif ($dd < $MIN_VALID_DD || $dd > $MAX_VALID_DD) {
192 0         0 $msg = "Coord out of bounds: $dd\n";
193             }
194 18 100       334 croak "$msg_pfx $msg" if $msg;
195            
196 16         29 return 1;
197             }
198            
199             sub _dms2dd_extract_hemisphere {
200 20     20   21 my $args = shift;
201            
202 20         28 my $value = $args->{value};
203            
204 20         19 my $hemi;
205             # can start with [NESWnesw-]
206 20 100       98 if ($value =~ m/ \A ( $RE_HEMI | [-] )/xms) {
207 14         153 $hemi = $1;
208             }
209             # cannot end with [-]
210 20 100       121 if ($value =~ m/ ( $RE_HEMI ) \z /xms) {
211 7         57 my $hemi_end = $1;
212            
213 7 100 66     234 croak "Cannot define hemisphere twice: $value\n"
214             if (defined $hemi && defined $hemi_end);
215            
216 5         17 $hemi = $hemi_end;
217             }
218 18 100       139 if (! defined $hemi) {
219 1         2 $hemi = q{};
220             }
221            
222 18         51 return $hemi;
223             }
224            
225            
226             1;
227            
228            
229             =pod
230            
231             =head1 NAME
232            
233             Geo::Converter::dms2dd
234            
235             =head1 VERSION
236            
237             0.02
238            
239             =head1 SYNOPSIS
240            
241             use Geo::Converter::dms2dd qw { dms2dd };
242            
243             my $dms_value;
244             my $dd_value;
245            
246             $dms_value = q{S23°32'09.567"};
247             $dd_value = dms2dd ({value => $dms_value});
248             print $dms_value
249             # -23.5359908333333
250            
251             $dms_value = q{149°23'18.009"E};
252             $dd_value = dms2dd ({value => $dms_value});
253             print $dd_value
254             # 149.388335833333
255            
256             $dms_value = q{east 149°23'18.009};
257             $dd_value = dms2dd ({value => $dms_value});
258             print $dd_value
259             # 149.388335833333
260            
261            
262             # The following all croak with warnings:
263            
264             $dms_value = q{S23°32'09.567"};
265             $dd_value = dms2dd ({value => $dms_value, is_lon => 1});
266             # Coord error: Longitude specified, but latitude found
267            
268             $dms_value = q{149°23'18.009"E};
269             $dd_value = dms2dd ({value => $dms_value, is_lat => 1});
270             # Coord error: Latitude out of bounds: 149.388335833333
271            
272             $dms_value = q{149°23'18.009"25}; # extra number
273             $dd_value = dms2dd ({value => $dms_value});
274             # DMS value error: Too many numbers in string: '149°23'18.009"25'
275            
276            
277             =head1 DESCRIPTION
278            
279             Use this module to convert a coordinate value in degrees minutes seconds
280             to decimal degrees. It exports a single sub C which will
281             parse and convert a single value.
282            
283             A reasonable amount of location information is provided in
284             degrees/minutes/seconds (DMS) format, for example from Google Earth, GIS packages or
285             similar. For example, one might be given a location coordinate for just north east
286             of Dingo in Queensland, Australia. Four possible formats are:
287            
288             S23°32'09.567", E149°23'18.009"
289             23°32'09.567"S, 149°23'18.009"E
290             -23 32 9.567, +149 23 18.009
291             -23.535991, 149.388336
292            
293             The first three coordinates are in degrees/minutes/seconds while the fourth
294             is in decimal degrees. The fourth coordinate can be used in numeric
295             calculations, but the first three must first be converted to decimal degrees.
296            
297             The conversion process used in dms2dd is pretty generous in what it treats as DMS,
298             as there is a multitude of variations in punctuation and the like.
299             Up to three numeric values are extracted and any additional text is largely
300             ignored unless it could be interpreted as the hemisphere (see below).
301             It croaks if there are four or more numeric values.
302             If the hemisphere is known or the C or C arguments are specified then
303             values are validated (e.g. latitudes must be in the interval [-90, 90],
304             and longitudes with a hemisphere specified must be within [-180, 180]).
305             Otherwise values between [-180, 360] are accepted. If seconds are specified
306             and minutes have values after the radix (decimal point) then it croaks
307             (e.g. 35 26.5' 22"). Likewise, it croaks for cases like (35.2d 26').
308             It will also croak if you specify the hemisphere at the start and end of the
309             value, even if it is the same hemisphere.
310            
311             Note that this module only works on a single value.
312             Call it once each for latitude and longitude values to convert a full coordinate.
313            
314             =head1 AUTHOR
315            
316             Shawn Laffan S<(I)>.
317            
318             =head1 BUGS AND IRRITATIONS
319            
320             Hemispheres are very liberally interpreted. So long as the text component
321             starts with a valid character then it is used. This means that
322             (E 35 26') is treated the same as (Egregious 35 26').
323            
324             It also does not deal with non-English spellings of north, south, east or west.
325             Hemispheres need to satisfy qr/[NESWnesw+-]/. A solution could be to drop
326             in an appropriate regexp as an argument, or maybe there is an i18n
327             solution. Patches welcome.
328            
329             It could probably also give the parsed degrees, minutes and seconds rather
330             than convert them. They are pretty easy to calculate, though.
331            
332             Submit bugs, fixes and enhancement requests via the bug tracker
333             at L.
334            
335             =head1 LICENSE
336            
337             This library is free software; you can redistribute it and/or modify
338             it under the same terms as Perl itself, either Perl version 5.8.9 or,
339             at your option, any later version of Perl 5 you may have available.
340            
341             =head1 See also
342            
343             L, although it requires the
344             degrees, minutes and seconds values to already be parsed from the string.
345            
346             =cut
347            
348