eval 'exec perl -S $0 ${1+"$@"}' # -*-Perl-*- if 0; # File name: ''google2itn'' # Task: Conversion from Google Maps URL to TomTom Route # # State: under development # # DOC # - see help text # # Notes # - # # TODO # - Need to parse new geocode tag, see e.g. Aoste Trip in last Biking tour # # created: 2008-04-27 # Version: $LastChangedRevision: 323 $ # last change: $LastChangedDate: 2009-03-15 21:16:19 +0100 (Sun, 15 Mar 2009) $ # (c) by Robert Lange (robert.lange@s1999.tu-chemnitz.de) # # License # Google2itn # Copyright (C) 2008 Robert Lange # robert.lange@s1999.tu-chemnitz.de # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA # *** packes to use *** use warnings; use strict; use Getopt::Long; use FindBin; # Find local directory use Encode; # Write Text for ITN as latin1 # HTTP Requester use LWP::UserAgent; use HTTP::Request::Common; use URI::Escape; # -------------------------------------------------------------------------------- # *** Global settings *** # Program Name our $Program_Name="google2itn"; # -------------------------------------------------------------------------------- # *** Global Variables *** # Program Options my %opts = ( # *** Settings from Command line # ITN file name (command line) itnfile => '', # URL (command line) url => '', # Set to 1 for debug output (command line) debug => 0, # Set to 1 for reverse translation (ITN -> URL) reverse => 0, ); # ITN Entries: Array of Hashes # Format of each Hash: long->longitude, lat->latitude, text->text description # gc->geocode from URL (when available) my @itn; # -------------------------------------------------------------------------------- # *** subroutine declarations *** # Main routine without any arguments sub main (); # Reads the command line options sub read_commandline(); # Print help message # return: help string sub issue_help(); # Return version string from SVN revision & date sub versionstring(); # Get places from URL sub get_places(); # Parse point and put to hash # 1.P: Reference for Value Hash (put result into) # 2.P: string to parse sub put_point(\%$); # Convert coordinates to decimal format # 1.P: GPS coordinates in this form: N 49°38.111 E 013°44.888 # return: coordinates in decimal format (50.351750, 12.311600) sub gps_convert_to_dec($); # Rount number to integer sub round($); # Ask for unknown places via URL request sub fill_unknowns(); # Construct ITN sub write_itn(); # Construct Google Maps URL from ITN file sub write_url(); # Decode packed URL to readable format sub url_decode($); # -------------------------------------------------------------------------------- # *** "Body" of the program *** main(); # -------------------------------------------------------------------------------- # *** Main routine *** sub main() { # *** Variables # *** Read the command line read_commandline(); # *** Reverse Operation: Now Parse ITN file *** if ($opts{'reverse'}) { # Reverse translation requested # *** Do _URL construction write_url(); # *** Done print "Done!\n"; return 0; } # else ... # *** Normal Operation: Now Parse URL *** # *** Get places from URL get_places(); # Deep DEBUG # use Data::Dumper; # print Dumper(@itn); # exit 1; # *** Ask for unknown places via URL request fill_unknowns(); # Deep DEBUG # use Data::Dumper; # print Dumper(@itn); # *** Construct ITN write_itn(); # *** Done print "Done!\n"; return 0; } # -------------------------------------------------------------------------------- # *** Get places from URL *** sub get_places() { # *** local variables my $lurl; # local URL to work with my $val; # Value on parse my $has_to=0; # 1: URL has "to:" entries my %pt; # Next ITN Point from URL # Format of each Hash: long->longitude, lat->latitude, # text->text description, gc->geocode from URL (when available) my @gc; # Split geocodes from URL my $count = 0; # Counter variable # Template (line splits added) # http://maps.google.de/maps?f=d&hl=de&geocode=18250402486037030471,50.351750,12.311600\ # %3B8010596657672648298,50.536260,12.531730&saddr=selb&daddr=markneukirchen\ # +to:K7841+%4050.351750,+12.311600+to:Sch%C3%B6neck,+vogtland+to:klingenthal\ # +to:sch%C3%B6nheide+to:Auerbacher+Stra%C3%9Fe%2FB169+%4050.536260,+12.531730\ # +to:bad+schlema+to:l%C3%B6%C3%9Fnitz+to:chemnitz&mra=pe&mrcr=4,5&\ # via=2,6&dirflg=h&sll=50.585308,12.667236&sspn=0.080982,0.166855&\ # ie=UTF8&ll=50.394512,12.637024&spn=1.300937,2.669678&z=9 # # Only 2 items # http://maps.google.de/maps?f=d&hl=de&geocode=&saddr=markneukirchen&\ # daddr=50.289833,12.35919&mra=dme&mrcr=0&mrsp=1&sz=14&sll=50.302395,12.346265\ # &sspn=0.040624,0.048065&ie=UTF8&z=14 # # Geocode embedded example: # http://maps.google.com/maps?f=d&saddr=K4&daddr=K6%2FNonnfelder+Hof+\ # to:50.851908,6.297913+to:Gressenicher+Str.%2FL11+to:J%C3%A4gerhausstra\ # %C3%9Fe%2FL24+to:Gr%C3%BCnentalstra%C3%9Fe%2FK21+to:B266&hl=de&geocode=\ # FT5LCgMdoDRdAA%3BFW7zCQMdyNheAA%3B%3BFWT2BgMdIO5fAA%3BFYDCBQMdWN5fAA%3B\ # FX6PAwMdVrNfAA%3BFZaVAwMdTEJiAA&mra=dpe&mrcr=0&mrsp=2&sz=10&via=1,2,3,4,5\ # &sll=50.776585,6.083613&sspn=0.613091,0.932465&ie=UTF8&z=10 print "Parsing URL ...\n"; # Shortcut $lurl = $opts{'url'}; # *** saddr $lurl =~ /saddr=(.+)&daddr=/ or die "Could not find saddr in URL!"; put_point(%pt, $1); # Parse point and put to hash push @itn, { %pt }; # Put anonymous copy into resulting hash # *** daddr # Until next to: point? if ($lurl =~ /daddr=(.+?)\+to:/) { # Yes $has_to = 1; put_point(%pt, $1); # Parse point and put to hash push @itn, { %pt }; # Put anonymous copy into resulting hash } else { # No to: points here $lurl =~ /daddr=(.+?)&/ or die "Could not find daddr in URL!"; put_point(%pt, $1); # Parse point and put to hash push @itn, { %pt }; # Put anonymous copy into resulting hash } # *** Point-by-point "to:" parsing $lurl =~ /\+to:/g; # First, wind to initial "to:" if ($has_to) { # Yes, items are there while ($lurl =~ /(.+?)(\+to:|&)/g) { # For each match put_point(%pt, $1); # Parse point and put to hash push @itn, { %pt }; # Put anonymous copy into resulting hash last if $2 eq "&"; # Abort condition } } # Now, when available, add geocode values also here # Template for geocode: # &geocode=\ # FT5LCgMdoDRdAA%3BFW7zCQMdyNheAA%3B%3BFWT2BgMdIO5fAA%3BFYDCBQMdWN5fAA%3B\ # FX6PAwMdVrNfAA%3BFZaVAwMdTEJiAA&<...> undef $_; # Empty before assignment $_ = $1 if $opts{'url'} =~ /&geocode=([^&]+)&/; if (defined $_ and $_ ne "") { # Yes, we found a geocode print "DEBUG: get_places Got geocode \"$_\"\n" if $opts{'debug'}; @gc = split(/%3B/, $_, -1); # Split by separator # -1: Do not strip trailing empty fields die "Mitmatch in route point count for names and " . # Sanitiy check "geocode (ITN=$#itn vs. GC=$#gc)!? Please inform author." if $#itn ne $#gc; foreach (@gc) { # Append geocode to all route points $itn[$count]->{gc} = $_; $count++; } } # Done with work return; } # *** Parse point and put to hash *** # 1.P: Reference for Value Hash (put result into) # 2.P: string to parse sub put_point(\%$) { # *** local variables my ($ptref, $in) = @_; my ($txt, $cord); # Text and coordinates print "DEBUG: put_points: Got text \"$in\"\n" if $opts{'debug'}; # Clear up hash first undef %$ptref; # Convert URL strings to readable text $in = url_decode($in); print "DEBUG: put_points: Converted text \"$in\"\n" if $opts{'debug'}; # Following text prototypes are needed: # (A) # New since E/2008: N 49°38.111 E 013° 44.888 # (B) # K7841 woauchimmer @50.351750, 12.311600 # markneukirchen woauchimmer # 50.289833,12.35919 $txt = ''; $cord = ''; # Fill empty if ( $in =~ /^[NS]\s+\d+°\s*[\d\.]+\s+[EW]\s+\d+°\s*[\d\.]+$/ ) { # (A) Parsing for normal geocoordinates $txt = ""; # No text found # Convert coordinates to standard format $cord = gps_convert_to_dec($in); # Convert coordinates to decimal format } else { # (B) Default parsing $in =~ /^(.*?)\s*\@?([\d\.]+,\s*[\d\.]+)?$/; $txt = $1; $cord = $2; } if (! $txt ) { $txt = 'Unknown'; # Assign "empty" text } if ( ! $txt and ! $cord ) { die "Could not understand waypoint \"$in\""; } # Fill fields: Text $$ptref{'text'} = $txt if $txt; # Fill fields: Coordinates (when available) if ($cord) { $cord =~ /^\s*([\d\.]+),\s*([\d\.]+)\s*$/ or die "Could not understand coordinates \"$cord\""; $$ptref{'lat'} = round($1 * 100000); # In TomTom format $$ptref{'long'} = round($2 * 100000); # In TomTom format } # Over and out return; } # Convert coordinates to decimal format # 1.P: GPS coordinates in this form: N 49°38.111 E 013°44.888 # return: coordinates in decimal format (50.351750, 12.311600) sub gps_convert_to_dec($) { # *** Parameters and variables my ($in) = @_; my ($ns, $longD, $longM, $ew, $latD, $latM); # Store values from input my ($long, $lat); # Calculated values # Fetch all values $in =~ /^([NS])\s+(\d+)°\s*([\d.]+)\s+([EW])\s+(\d+)°\s*([\d.]+)$/ or die "Cound not understand degrees-minute format \"$in\""; $ns = $1; $longD = $2; $longM = $3; $ew = $4; $latD = $5; $latM = $6; # Calculate Longitude $long = $longD + 1.0*$longM/60; if ( $ns eq "S") { $long *= -1; } # Calculate Latitude $lat = $latD + 1.0*$latM/60; if ( $ew eq "W") { $lat *= -1; } print "DEBUG: gps_convert_to_dec: Converted coordinates \"$long, $lat\"\n" if $opts{'debug'}; # Return $long . ", " . $lat; } # *** Rount number to integer *** sub round($) { my ($number) = @_; return int($number + .5 * ($number <=> 0)); } # -------------------------------------------------------------------------------- # *** Ask for unknown places via URL request *** sub fill_unknowns() { # *** local variables my ($txt, $gc); # Text, Geocode my ($src, $dest, $geo, $gurlgc); # For request with geocode my $ua = new LWP::UserAgent; # New HTTP request object my $google_url; # Use same google url as given on command line my $google_url_gc; # Use same google request my $try_geocode; # True: Try geocode processing my $greq; # Googe Request result my ($long, $lat); # Coordinates my $kml_string; # KML string (separate from $greq to allow multiple matching) my ($pmk, $pmk_pre); # Placemark - tag parsing (current and last value) print "Fetching unknown coordinates ...\n"; # Get google URL for normal request $opts{'url'} =~ m|^\s*((:?http://)?[^/]+)/| or die "Could not isolate google URL from input URL?!?"; $google_url = $1; # Get google URL for geocode request, with blanked saddr, daddr and geocode $google_url_gc = $opts{'url'}; $google_url_gc =~ s/&saddr=[^&]*&/&saddr=&/; # blank saddr $google_url_gc =~ s/&daddr=[^&]*&/&daddr=&/; # blank daddr $google_url_gc =~ s/&geocode=[^&]*&/&geocode=&/; # blank geocode # For all missing coordinates fetch them via google foreach my $ptref (@itn) { if (! defined( ${$ptref}{'long'} ) or ! defined(${$ptref}{'lat'}) ) { # Fetch it $txt = $$ptref{'text'}; # Shortcut $gc = $$ptref{'gc'}; # Shortcut 2 $try_geocode = 0; # Reset flag undef $long; undef $lat; # Reset result variables print " $txt"; print " (Geocode $gc)" if $gc; print "\n"; print "$google_url/maps?f=q&hl=de&geocode=&q=". uri_escape($txt) . "&ie=UTF8&output=kml\n" if $opts{'debug'}; $greq = $ua->request(GET "$google_url/maps?f=q&hl=de&geocode=&q=" . uri_escape($txt) . "&ie=UTF8&output=kml"); die "Could not fetch Data from google:" . $greq->error_as_HTML unless $greq->is_success; # Error check # Try to extract values from KML file the traditional way (w/o geocode) if ( $greq->content =~ m|(-?[\d\.]+)| ) { $long = $1; } else { # Fail, need to try geocode decoding $try_geocode = 1; } if ( $greq->content =~ m|(-?[\d\.]+)| ) { $lat = $1; } else { # Fail, need to try geocode decoding $try_geocode = 1; } if ( $try_geocode ) { # Failure? Try with geocode as 2nd option if ( $opts{'debug'} ) { print "Failing location parsing in KML, "; print "re-try with geocode KML\n"; } # For this trial, take input URL, replace source, destination and geocode $gurlgc = $google_url_gc; # Make copy, to replace values inside # saddr: Just take first point $src=$itn[0]->{'text'}; # daddr: Our target $dest=$txt; # geocode of s+daddr $geo = $itn[0]->{'gc'} . "%3B" . $gc; # Insert values into URL $gurlgc =~ s/&saddr=&/&saddr=$src&/; $gurlgc =~ s/&daddr=&/&daddr=$dest&/; $gurlgc =~ s/&geocode=&/&geocode=$geo&/; $gurlgc .= "&output=kml"; # Request kml output $greq = $ua->request(GET $gurlgc); print "$gurlgc\n" if $opts{'debug'}; die "Could not fetch Data from google (2): " . $greq->error_as_HTML unless $greq->is_success; # Final failure # Now decode $dest, for coordinate extraction $dest = url_decode($txt); # There are another special replacements - do them $_ = $dest; s/Ö/O/g; s/Ä/a/g; s/Ü/u/g; s/ö/o/g; s/ä/a/g; s/ü/u/g; # German Umlauts s/ß/ss/g; # ß $dest =$_; print "Decoded address to look for: $dest\n" if $opts{'debug'}; # Extract coordinates # Template # Ankommen in: Gressenicher Str./L11\ #
Gressenicher Str./L11
\ # root://styleMaps#default+nicon=0x467+hicon=0x477\ # 6.286880,50.787940,0 # Separate by tags $kml_string = $greq->content; # Save, otherwise m|||g will loop at 1st match #pmk = ""; # Initially empty while ( $kml_string =~ m|(.*?)|ig ) { $pmk_pre = $pmk; # Save last fetched value $pmk = $1; if ( $pmk =~ m|
$dest
|i ) { # We found the address $pmk =~ m|\s*(-?[\d\.]+)\s*,\s*(-?[\d\.]+)\s*(?:,\d+)?|i or die "Could not extract data (3) from KML for \"$dest\":\n" . $greq->content; $long = $1; $lat = $2; last; # Now we can exit here } } if ( !$lat or !$long ) { # Sometimes, out of whatever stupid reason, the name in the
# tag is changed from the initial name :-(( # In this case, as a last resort, try to fetch the second-last # entry and hope it is what we're looking for if ($pmk_pre =~ m|\s*([\d\.]+)\s*,\s*([\d\.]+)\s*(?:,\d+)?|i ) { # Just take the match we found $long = $1; $lat = $2; print "WARNING - Guessing decoding value in KML file because address tag was not found!\n" } } # Final result check if ( !$lat or !$long ) { die "Could not extract data from google geocode request:\n" . $greq->content; } } # Assign back $$ptref{'long'} = round($long * 100000); # In TomTom format $$ptref{'lat'} = round($lat * 100000); # In TomTom format } } } # -------------------------------------------------------------------------------- # *** Construct ITN *** sub write_itn() { # *** local variables my $idx = 0; # thread first and last entry special print "Writing output file $opts{'itnfile'} ...\n"; open OUT, ">", $opts{'itnfile'} or die "Could not open output file $opts{'itnfile'}: $?"; # Parse ITN file for coordinates and locations foreach (@itn) { # Print Text - It must be in latin1 encoding print OUT "$$_{'long'}|$$_{'lat'}|" . encode("iso-8859-1", decode("utf-8", $$_{'text'})); # Last is type 2, others are type 0 if ($idx == $#itn) { print OUT "|2|\n"; } else { print OUT "|0|\n"; } # Increment index $idx++; } # Done close OUT; return; } # -------------------------------------------------------------------------------- # *** Construct Google Maps URL from ITN file *** sub write_url() { # *** local variables my @points; # ITN points in Format "K7841 woauchimmer @50.351750, 12.311600" my $idx = 0; # Special handling for first two my $url = ''; # Resulting URL print "Generate Google Maps URL from TomTom Route file $opts{itnfile} ...\n"; open IN, "<", $opts{'itnfile'} or die "Could not open input file $opts{'itnfile'}: $?"; # *** Read ITN foreach my $line () { # The text is in latin1 encoding, but UTF8 is expected $line = encode("utf-8", decode("iso-8859-1", $line) ); # Template: 602541|4404970|Avenue de Haute Provence/N85|0| $line =~ /^\s*(-?\d+)\|(-?\d+)\|(.*)\|\d+\|\s*$/ or die "Could not parse TomTom ITN line \"$line\""; push @points, "$3 \@" . $2/100000 . ", " . $1/100000; } # Deep debug # use Data::Dumper; # print Dumper(@points); # Error check: Single lines not supported if ($#points < 1) { die "Single line (or empty) ITN files not supported (yet)"; } # *** Construct URL Template: # http://maps.google.de/maps?f=d&source=s_d&saddr=Bad+M%C3%BCnstereifel+\ # %4050.55384,+6.75936&daddr=m%C3%B6nchengladbach++%4051.191260,6.442070&hl=en&\ # geocode=&mra=ls&sll=51.191394,6.442065&sspn=0.009844,0.009313&g=\ # m%C3%B6nchengladbach+&ie=UTF8&z=9 # Prefix $url = "http://maps.google.de/maps?f=d&source=s_d"; # Points foreach (@points) { if ($idx == 0) { # First Item $url .= "&saddr="; } elsif ($idx == 1) { # Second Item $url .= "&daddr="; } else { # All other items $url .= "+to:"; } # Encoded location string print "DEBUG: write_url: Parsed ITN item \"$_\"\n" if $opts{'debug'}; tr/ /+/; # Spaces to Plus s/@/\%40/g; # Encode @ # And all remaining special characters must be encoded s/([^A-Za-z0-9\%,\.\+])/sprintf("%%%02X", ord($1))/seg; print "DEBUG: write_url: Converted text \"$_\"\n" if $opts{'debug'}; $url .= $_; $idx++; # Next line is to be done } # Postfix $url .= "&hl=en&ie=UTF8"; # And print it print "\n$url\n\n"; # Done close IN; return; } # -------------------------------------------------------------------------------- # *** Decode packed URL to readable format *** sub url_decode($) { $_ = shift; $_ = uri_unescape($_); tr/+/ /; # Special: Decode spaces return $_; } # -------------------------------------------------------------------------------- # *** reads the command line options *** sub read_commandline() { # *** local variables my $help; # set to one if help screen is requested my $ver; # set to one if version is requested Getopt::Long::Configure ("bundling"); # enable bundling level 1 my $result = GetOptions(\%opts, 'debug|d!', 'reverse|r!', 'help|h|?' => \$help, 'version|V' => \$ver ); if (! $result ) { print STDERR "\nFailed to parse the command line options: Exiting\n"; exit 1; } if ( $ver ) { print "\n" . $Program_Name . ", revision " . versionstring() . "\n"; exit 0; } if ( $help ) { print issue_help(); exit 0; } if ($opts{'reverse'}) { # Reverse translation requested if (scalar(@ARGV) != 1) { # There were no arguments or too many print STDERR "Reverse Translation: Input file expected!\n" . "See Help message for information\n"; exit 1; } # assign arguments from @ARGV $opts{'itnfile'} = $ARGV[0]; } else { # Normal operation if (scalar(@ARGV) != 2) { # There were no arguments or too many print STDERR "Output file and URL expected! See Help message for information\n"; exit 1; } # assign arguments from @ARGV $opts{'itnfile'} = $ARGV[0]; $opts{'url'} = $ARGV[1]; } return; } # *** Return version string from SVN revision & Date *** sub versionstring() { # *** Vars my $rev = '$LastChangedRevision: 323 $'; my $date = '$LastChangedDate: 2009-03-15 21:16:19 +0100 (Sun, 15 Mar 2009) $'; # Filter revision $rev = $1 if $rev =~ /LastChangedRevision: (\d+)/; # Filter date $date = $1 if $date =~ /LastChangedDate: ([\d-]+)/; "$Program_Name revision $rev from $date \n" . 'Copyright (C) 2008,2009 Robert Lange (robert.lange@s1999.tu-chemnitz.de)' . "\n" . "Licensed under the GNU General Public License\n"; } # -------------------------------------------------------------------------------- # *** Print Help message *** # returns help string sub issue_help() { # *** Help Text my $Help_Documentation=< Homepage http://sethdepot.org/site/Main/Google2Itn EOF # return help string "\n" . versionstring() . "\n" . $Help_Documentation; };