#!/usr/bin/perl -w # # Go fishing for map data on Mapflow via myhome.ie # use LWP::UserAgent; use URI::Escape; use Getopt::Long; use MIME::Base64; use Tk; use HTTP::Cookies; use WWW::Mechanize; my $ua = LWP::UserAgent->new; $ua->agent( "Mozilla/4.0 (compatible; MSIE 5.0; Windows 98; DigExt)" ); $ua->env_proxy(); #$ua->cookie_jar(HTTP::Cookies->new(file => $ENV{'HOME'} . "/lwpcookies.txt", # autosave => 1)); my $main = new MainWindow( -title => "Map Widget" ); my $canvas = $main->Canvas( -width => 420, -height => 400, -relief => 'groove', -borderwidth => '2' )->pack(); my ( $cx, $cy ) = ( 0, 0 ); $main->Entry( -textvariable => \$cx )->pack(); $main->Entry( -textvariable => \$cy )->pack(); $main->bind( 'all', '', [ sub { shift; ( $cx, $cy ) = @_; }, Ev('x'), Ev('y')]); my @params; my $img; $main->bind( '', sub {exit();}); $main->bind( '', [ \&newmap, Ev('x'), Ev('y'), Ev('b')] ); $main->bind( '', [ \&newmap, Ev('x'), Ev('y'), Ev('b')] ); $main->bind( '', [ \&newmap, Ev('x'), Ev('y'), Ev('b')] ); MainLoop; sub newmap{ if ( @params ) { push @params, $_[1]; push @params, $_[2]; if ( $_[3] == 1 ) { # Zoom in push @params, "ZoomIn"; } elsif ( $_[3] == 3 ) { push @params, "ZoomOut"; } else { push @params, "Pan"; } } @params = getmap_mecha( @params ); drawmap( @params ); shift @params; } sub drawmap { my ( $url, $zoom, $x, $y ) = @_; my $req = new HTTP::Request GET => $url; print STDERR "Fetching map $url\n"; $res = $ua->request( $req ); if ( $res->is_success ) { my $imgdata = $res->content; `mkdir -p /var/tmp/mapflow`; # Honk. my $filename = "/var/tmp/mapflow/mapflow_$ {zoom}_$ {x}_$ {y}"; if ( $url =~ /gif/ ) { open( FROB, "|giftopnm > $filename" ); } else { open( FROB, "|jpegtopnm > $filename" ); } binmode( FROB ); print FROB $imgdata; close( FROB ); $img = $main->Photo( "map", -file => "$filename" ); $canvas->createImage( 211, 201, -image => "map", -tag => "map" ); } else { print STDERR "FAILED: " . $res->code . "\n"; } } my $agent; sub getmap_mecha { my ( $zoom, $mapx, $mapy, $geo, $leg, $x, $y, $action ) = @_; my ( $url ); my $res; if ( !defined( $zoom )) { $agent = WWW::Mechanize->new; $agent->env_proxy; $agent->agent_alias( 'Windows IE 6' ); $agent->get( 'http://geo.myhome.ie/myHomev1beta/jsp/content/search.jsp?' ); } else { my %fields = ( mapClick => lc( $action ), ); $res = $agent->submit_form( fields => \%fields, button => "map", x => $x, 'y' => $y, ); # you people suck while( $agent->content =~ /Zero Sized Reply/s ) { print STDERR "Suckage detected, retrying\n"; $agent->reload(); } } my $page = $agent->content; if ( $page =~ /dispatch/ ) { ( $url ) = $page =~ m{(http://dispatch[^"]*)"}i; ( $mapx ) = $page =~ m{name="x" value="(.*?)"}is; ( $mapy ) = $page =~ m{name="y" value="(.*?)"}is; ( $zoom ) = $page =~ m{name="z" value="(.*?)"}is; if ( !defined $mapx ) { print STDERR $page; die "Urk!"; } } elsif ( $page =~ /<.*?name="map"([^>]+)>/ ) { $page = $1; $page =~ s/^.*src="(.*?)".*$/$1/; $url = $page; if ( $url eq "../images/ireland.gif" ) { $url = "http://geo.myhome.ie/myHomev1beta/jsp/images/ireland.gif"; # urgh ( $mapx, $mapy ) = ( 226301.88679245283, 249562.5 ); $zoom = 1; } } else { print STDERR "Well, that got us nowhere\n"; print STDERR "We sent:\n"; print STDERR $agent->{req}->as_string; print STDERR "We got:\n"; print STDERR $agent->response()->as_string; } ($url, $zoom, $mapx, $mapy, $geo, $leg ); }