File Coverage

blib/lib/Geo/Coordinates/Converter/LV03.pm
Criterion Covered Total %
statement 37 37 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod 2 2 100.0
total 45 45 100.0


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