File Coverage

blib/lib/Geo/Converter/dms2dd.pm
Criterion Covered Total %
statement 92 97 94.8
branch 52 58 89.6
condition 16 24 66.6
subroutine 12 12 100.0
pod 0 1 0.0
total 172 192 89.5


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