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