File Coverage

blib/lib/Geo/Coordinates/Converter/LV03.pm
Criterion Covered Total %
statement 41 41 100.0
branch n/a
condition n/a
subroutine 7 7 100.0
pod 2 2 100.0
total 50 50 100.0


line stmt bran cond sub pod time code
1              
2             #_{ Encoding and name
3             =encoding utf8
4             =head1 NAME
5              
6             Geo::Coordinates::Converter::LV03 - Convert Swiss LV03 coordinates to WSG84 and vice versa
7              
8             =cut
9             package Geo::Coordinates::Converter::LV03;
10              
11              
12 2     2   25312 use strict;
  2         4  
  2         52  
13 2     2   7 use warnings;
  2         2  
  2         53  
14 2     2   533 use utf8;
  2         13  
  2         9  
15             #_}
16             #_{ Version
17             =head1 VERSION
18              
19             Version 0.02
20              
21             =cut
22              
23             our $VERSION = '0.02';
24             #_}
25             #_{ Synopsis
26             =head1 SYNOPSIS
27              
28             use Geo::Coordinates::Converter::LV03;
29              
30             my ($x, $y) = Geo::Coordinates::Converter::LV03::lat_lng_2_y_x($φ, $λ);
31             my ($φ, $λ) = Geo::Coordinates::Converter::LV03::y_x_2_lat_lng($x, $y);
32            
33             =cut
34             #_}
35             #_{ Export
36             =head1 EXPORT
37              
38             On request, C and C are exported:
39              
40             use Geo::Coordinates::Converter::LV03 qw(lat_lng_2_y_x y_x_2_lat_lng);
41              
42             my ($x, $y) = lat_lng_2_y_x($φ, $λ);
43             my ($φ, $λ) = y_x_2_lat_lng($x, $y);
44              
45             =head1 SUBROUTINES/METHODS
46             =cut
47              
48 2     2   81 use Exporter qw(import);
  2         3  
  2         63  
49 2     2   6 use vars qw(@ISA @EXPORT_OK);
  2         2  
  2         682  
50             @ISA = 'Exporter';
51             @EXPORT_OK = qw(lat_lng_2_y_x y_x_2_lat_lng);
52              
53             #_}
54              
55             sub lat_lng_2_y_x { #_{
56              
57             =head2 lat_lng_2_y_x($lat, $lng)
58              
59             Convert a latitude/longitude tuple to a Swiss LV03 datum.
60              
61             Note: the Swiss seem to name the east-west axis by B and the
62             the north-south axis by B. Hence the strangly order of C and C in the sub's name.
63              
64             =cut
65              
66             # https://www.swisstopo.admin.ch/content/swisstopo-internet/de/online/calculation-services/_jcr_content/contentPar/tabs/items/dokumente_und_publik/tabPar/downloadlist/downloadItems/7_1467103072612.download/ch1903wgs84de.pdf
67             #
68             # Note: $x is in north south direction, $y in east west direction!
69             # But they are returned as ($y, $x)...
70              
71 2     2 1 558 my $φ = shift; # Breite
72 2         3 my $λ = shift; # Länge
73              
74             # φ und λ sind in Sexagesimalsekunden umzuwandeln:
75 2         3 $φ *= 3600;
76 2         3 $λ *= 3600;
77              
78             # Hilfsgrössen (Breiten- und Längendifferenz gegenüber Bern in der Einheit [10000"]) berechnen:
79 2         3 my $φ_ = ($φ - 169_028.66) / 10_000;
80 2         2 my $λ_ = ($λ - 26_782.5 ) / 10_000;
81              
82 2         2 my $φ2 = $φ_ * $φ_;
83 2         3 my $λ2 = $λ_ * $λ_;
84 2         2 my $φ3 = $φ2 * $φ_;
85 2         2 my $λ3 = $λ2 * $λ_;
86              
87 2         4 my $y = 600_072.37 +
88             211_455.93 * $λ_ -
89             10_938.51 * $λ_ * $φ_ -
90             0.36 * $λ_ * $φ2 -
91             44.54 * $λ3;
92              
93 2         4 my $x = 200_147.07 +
94             308_807.95 * $φ_ +
95             3_745.25 * $λ2 +
96             76.63 * $φ2 -
97             194.56 * $λ2 * $φ_ +
98             119.79 * $φ3;
99              
100              
101            
102 2         4 return ($y, $x);
103             } #_}
104              
105             sub y_x_2_lat_lng { #_{
106              
107             =head2 y_x_2_lat_lng($y, $x)
108              
109             Convert a Swiss LV03 datum to a latitude and longitude tuple.
110              
111             Note: the Swiss seem to name the east-west axis by B and the
112             the north-south axis by B. Hence, the first argument is named C, the second C.
113              
114             =cut
115              
116 1     1 1 341 my $y = shift; # Rechtswert
117 1         2 my $x = shift; # Hochwert
118              
119             # Die Projektionskoordinaten y und x sind ins zivile System (Bern = 0 / 0) und in die Einheit [1000 km] umzuwandeln:
120              
121 1         3 my $y_ = ($y - 600_000) / 1_000_000;
122 1         2 my $x_ = ($x - 200_000) / 1_000_000;
123              
124             # Lange und Breite in der Einheit [10000"] berechnen:
125              
126 1         2 my $y2 = $y_*$y_;
127 1         2 my $y3 = $y2*$y_;
128              
129 1         1 my $x2 = $x_*$x_;
130 1         1 my $x3 = $x2*$x_;
131              
132 1         3 my $λ_ = 2.677_9094 +
133             4.728_982 * $y_ +
134             0.791_484 * $y_ * $x_ +
135             0.130_6 * $y_ * $x2 -
136             0.043_6 * $y3;
137              
138 1         3 my $φ_ = 16.902_3892 +
139             3.238_272 * $x_ -
140             0.270_978 * $y2 -
141             0.002_528 * $x2 -
142             0.044_7 * $y2 * $x_ -
143             0.014_0 * $x3;
144              
145             # Umrechnen in ° Einheit
146 1         2 my $φ = $φ_ * 100 / 36;
147 1         2 my $λ = $λ_ * 100 / 36;
148              
149 1         3 return ($φ, $λ);
150              
151             } #_}
152              
153             #_{ Warning, Why etc
154              
155             =head1 WARNING
156              
157             The document from which I derived the formulas (see LINKS) contains
158             this friendly warning; »I
159             vor allem für Navigationszwecke vorgesehen. Sie dürfen nicht für die amtliche Vermessung oder für geodätische Anwendungen verwendet werden!>« (that is: only to be used for navigational purposes,
160             not of exact (or even official) measurements or geodatic applications).
161              
162             =head1 WHY
163              
164             Why was I not using the already existing L?
165              
166             I tried, but that module's code seemed too hard and esoteric to extend. So I made this module a seperate one.
167              
168             =head1 AUTHOR
169              
170             René Nyffenegger, C<< >>
171              
172             =head1 BUGS
173              
174             Please report any bugs or feature requests to C, or through
175             the web interface at L. I will be notified, and then you'll
176             automatically be notified of progress on your bug as I make changes.
177              
178             =head1 LINKS
179              
180             L
181              
182             L
183              
184              
185             =head1 LICENSE AND COPYRIGHT
186              
187             Copyright 2017 René Nyffenegger.
188              
189             This program is free software; you can redistribute it and/or modify it
190             under the terms of the the Artistic License (2.0). You may obtain a
191             copy of the full license at:
192              
193             L
194              
195             Any use, modification, and distribution of the Standard or Modified
196             Versions is governed by this Artistic License. By using, modifying or
197             distributing the Package, you accept this license. Do not use, modify,
198             or distribute the Package, if you do not accept this license.
199              
200             If your Modified Version has been derived from a Modified Version made
201             by someone other than you, you are nevertheless required to ensure that
202             your Modified Version complies with the requirements of this license.
203              
204             This license does not grant you the right to use any trademark, service
205             mark, tradename, or logo of the Copyright Holder.
206              
207             This license includes the non-exclusive, worldwide, free-of-charge
208             patent license to make, have made, use, offer to sell, sell, import and
209             otherwise transfer the Package with respect to any patent claims
210             licensable by the Copyright Holder that are necessarily infringed by the
211             Package. If you institute patent litigation (including a cross-claim or
212             counterclaim) against any party alleging that the Package constitutes
213             direct or contributory patent infringement, then this Artistic License
214             to you shall terminate on the date that such litigation is filed.
215              
216             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
217             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
218             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
219             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
220             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
221             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
222             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
223             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
224              
225              
226             =cut
227             #_}
228              
229             'tq84';