source: subversion/applications/utils/import/csv2osm/csv2osm.pl @ 4349

Last change on this file since 4349 was 2311, checked in by nickburch, 13 years ago

Bug fix for perl not supporting -0, which meant that lat 0.xS and lon 0.xW were wrong

  • Property svn:eol-style set to native
  • Property svn:executable set to *
File size: 4.6 KB
Line 
1#!/usr/bin/perl
2# CSV to OSM converter - see README.txt for details
3
4eval {
5        require 'config';
6};
7if($!) {
8        die("You must copy config.sample to config, and customise\n");
9}
10
11use HTTP::Request;
12use LWP::UserAgent;
13my $ua = LWP::UserAgent->new;
14
15# URLs we'll use to do things
16my $new_node_url = 'http://www.openstreetmap.org/api/0.3/node/0';
17my $map_url = 'http://www.openstreetmap.org/api/0.3/map?bbox='; # bllong,bllat,trlong,trlat
18
19# Open the files we'll need
20open(CSV, "<$input_csv") or die ("Could not load csv '$input_csv'\n");
21open(WORKED, "> worked.osm");
22open(PROBLEM, "> problem.osm");
23
24# Output the headers
25my $xml_header = "<?xml version='1.0'?>\n";
26my $xml_osm_header = "$xml_header<osm version='0.3' generator='CSV2OSM'>\n";
27my $xml_osm_footer = "</osm>\n";
28print WORKED $xml_osm_header;
29print PROBLEM $xml_osm_header;
30
31# Process the file
32while(my $line = <CSV>) {
33        chomp $line;
34        unless($line) { next; }
35        my @tmp = split(/,/,$line);
36        my $csv_ref = \@tmp;   
37
38        # Let the custom processer tweak it
39        &csv_tweaker($csv_ref);
40
41        # Do substitutions in the output
42        my %data;
43        for(my $i=0; $i<@output_mapping; $i++) {
44                my $val = $output_mapping[$i];
45                while($val =~ /\$COL(\d+)/) {
46                        my $index = $1;
47                        my $subs = $csv_ref->[($index-1)];
48                        $val =~ s/\$COL$index/$subs/;
49                }
50                $val =~ /^(.*?)=(.*)$/;
51                $data{$1} = $2;
52        }
53
54        # Convert lat+long into useful formats
55        ($data{'latitude'},$data{'longitude'}) = 
56                format_latlong($data{'latitude'},$data{'longitude'});
57
58        # Build the XML
59        my $xml = "<node id='0' lat='".$data{'latitude'}."' lon='".$data{'longitude'}."'>\n";
60        foreach my $key (sort keys %data) {
61                unless($key eq "latitude" || $key eq "longitude") {
62                        $xml .= "  <tag k='$key' v='".$data{$key}."' />\n";
63                }
64        }
65        $xml .= "</node>\n";
66
67        print "\n\nPotential new node is:\n";
68        print "$xml\n";
69
70        # Do a fetch for the surrounding area
71        my ($min_lat,$min_long,$max_lat,$max_long) = 
72                build_search_latlong($data{'latitude'},$data{'longitude'});
73        # map?bbox=bllon,bllat,trlon,trlat
74        my $url = $map_url."$min_long,$min_lat,$max_long,$max_lat";
75        print "Doing search:\n  ";
76        print "$url\n";
77
78        my $resp = $ua->get( build_url($url) );
79        unless($resp->is_success) {
80                warn("Error fetching: ".$resp->status_line."\n");
81                print PROBLEM $xml;
82                next;
83        }
84        my $data = $resp->content;
85
86        # Check to see if we had a matching node or not
87        my @nodes = ($data =~ /(<node .*?<\/node>)/gs);
88        print "Found ".(scalar @nodes)." nodes in the search area.\n";
89
90        my $match = 0;
91        foreach my $node (@nodes) {
92                foreach my $attr (@search_attrs) {
93                        my ($key,$value) = split(/=/, $attr);
94                        if($node =~ /<tag k=['"]${key}['"] v=['"]${value}['"]/) {
95                                # Match
96                                warn("Found possible match for new node, not adding.\n");
97                                print "Match is:\n".$node."\n";
98                                $match = 1;
99                        }
100                }
101        }
102        if($match) {
103                print PROBLEM $xml;
104                next;
105        }
106        print "No nodes found with matching attributes, adding\n";
107       
108        # Add
109        my $upload_xml = $xml_osm_header.$xml.$xml_osm_footer;
110        my $request = HTTP::Request->new(
111                                        "PUT", build_url($new_node_url), undef, $upload_xml
112        );
113        $resp = $ua->request($request);
114        unless($resp->is_success) {
115                warn("Error uploading: ".$resp->status_line."\n");
116                print PROBLEM $xml;
117                next;
118        }
119        # Grab the ID
120        my $id = $resp->content;
121        chomp $id;
122
123        # Save
124        $xml =~ s/id='0'/id='$id'/;
125        print WORKED $xml;
126        print "\nAdded node, new id is $id\n";
127}
128
129# Close down
130print WORKED $xml_osm_footer;
131print PROBLEM $xml_osm_footer;
132close WORKED;
133close PROBLEM;
134
135
136sub format_latlong($,$) {
137        my @data = @_;
138        my @out;
139        foreach my $val (@data) {
140                my $sign = 1;
141                if($val =~ /([NE])$/i) {
142                        chop $val;
143                }
144                if($val =~ /([SW])$/i) {
145                        chop $val;
146                        $sign = -1;
147                }
148
149                if($val =~ /^(\-?\d+)[-:](\d+)[-:](\d+)$/) {
150                        my ($h,$m,$s) = (int($1),int($2),int($3));
151                        $val = $h + ($m/60) + ($s/60/60);       
152                        $val *= $sign;
153                } elsif($val =~ /^(\-?\d+\.\d+)$/) {
154                        # In right format already
155                } else {
156                        die("Unknown lat/long format '$val'\n");
157                }
158                push @out, $val;
159        }
160
161        return @out;   
162}
163
164sub build_search_latlong($,$) {
165        my ($lat,$long) = @_;
166
167        my $pi = atan2(1,1) * 4;
168
169        # The earth's radius, in meters, at the equator (should be close enough)
170        my $earth_radius_m = 6335.437 * 1000;
171
172        # What's the earth's radius at this latitude?
173        my $erl = cos($lat*$pi/360) * $earth_radius_m;
174
175        # Cheat a bit, this delta is only appropriate for one of lat or long
176        #  (can't remember which), but it'll do for short distances
177        my $delta = $search_distance / $erl * 360;
178        my $delta_lat = $delta;
179        my $delta_long = $delta;
180
181        return ($lat-$delta_lat,$long-$delta_long,$lat+$delta_lat,$long+$delta_long);
182}
183
184sub build_url($) {
185        my $url = shift;
186        $url =~ s/^http:\/\///;
187        $username =~ s/\@/\%40/g;
188
189        return "http://".$username.":".$password."@".$url;
190}
Note: See TracBrowser for help on using the repository browser.