#!/usr/bin/perl -w

#
# MapServer package using MapQuest.
#
# Note that the scale on mapquest maps actually lies; it's based on
# what you ask for, not what you get. Or at least that seems to be my
# experience while playing with Irish maps, anyway.

# Waider 2001
# August 2002: URLs and such appear to have changed, coping.
# hmm. does this work?
# http://www.mapquest.com/maps/map.adp?latlongtype=decimal&latitude=37.26617&longitude=-121.85858
# it does!
package MapServer::MapQuest;

use MapServer;
our @ISA = "MapServer";

use LWP::UserAgent;
use URI::Escape;
use HTTP::Cookies;

use WWW::Mechanize;

# Grab a map from mapquest at a given lat/long
my $MAPCACHE = "mq-cache";

# Scaling factors to get a pixel::gridpoint mapping in Tk.
#
# @ scale 8:
# x: 181px = 0.01
# y: 233px = 0.01
my @xscale = (
			  6000,
			  6000,
			  6000,
			  6000,
			  6000,
			  6000,
			  6000,
			  6000,
			  18100,
			  6000,
			 );

# why are these negative? what drugs was I on?
my @yscale = (
			  -6500,
			  -6500,
			  -6500,
			  -6500,
			  -6500,
			  -6500,
			  -6500,
			  -6500,
			  -23300,
			  -6500,
			 );

# Magnification.
my $MAG = 8;

# There seem to be a few magnification arrays, damn them.
my %mag = ( '@' => {
					'9' => '1', # street
					'8' => 'y',
					'7' => 't',
					'6' => 'z',
					'5' => '8',
					'4' => 'r',
					'3' => 'b',
					'2' => 'a',
					'1' => '2',
					'0' => 'c', # country
				   },
			'whatever' => {
						   '9' => 'f', # '270ft',
						   '8' => 'r', # '600ft',
						   '7' => 'z', # '1500ft',
						   '6' => 'y', # '1mi',
						   '5' => '4', # '3mi',
						   '4' => 'w', # '10mi',
						   '3' => 'a', # '30mi',
						   '2' => '0', # '80mi',
						   '1' => 'u', # '300mi',
						   '0' => 'b', # 'unscaled',
						  },
		  );

my $ua;
# FIXME this should be an option
my $debug = 1;

# Methods, madness, etc.
sub mag() {
    my $obj = shift;
    $MAG = shift if @_;
    $MAG;
}

sub xscale() {
    my $obj = shift;
    return $xscale[ $MAG ];
}

sub yscale() {
    my $obj = shift;
    return $yscale[ $MAG ];
}

sub xfringe() {
    my $obj = shift;
    return 0.01;
}

sub yfringe() {
    my $obj = shift;
    return 0.01;
}

sub fetchmap( @ ) {
    my $self = shift;
    my ( $latitude, $longitude ) = @_;
    my $filename;
    my $inputs;
    my $mag = $MAG;

    # round off the lat/long
    $latitude = sprintf( "%.2f", $latitude );
    $longitude = sprintf( "%.2f", $longitude );

    -d $MAPCACHE || mkdir $MAPCACHE, 0755;
    -d "$MAPCACHE/$MAG" || mkdir "$MAPCACHE/$MAG", 0755;
    $filename = "cache_$ {latitude}_$ {longitude}.gif";

    # First, check if we have a map that covers this area
    # Fixme - should go through various magnifications
    opendir( CACHEDIR, "$MAPCACHE/$MAG" );
    my @files = grep /^cache/, readdir( CACHEDIR );
    closedir( CACHEDIR );

    for my $f ( @files ) {
        my ( $lat, $long ) = $f =~ m/cache_(.*?)_(.*?)\.gif$/;
        if (( $latitude > ( $lat - $self->xfringe())) &&
            ( $latitude < ( $lat + $self->yfringe())) &&
            ( $longitude > ( $long - $self->xfringe())) &&
            ( $longitude < ( $long + $self->yfringe()))) {
            return "$MAPCACHE/$MAG/$f";
        }
    }

    # There should be a range of options here. It'd be nice to know
    # we're peripherally on a map, especially if we're offline and can't
    # download a 'local' one. The 4 is arbitrary, and should really be
    # derived from $MAG or something.
    if ( !$self->online ) {
        for my $f ( @files ) {
            my ( $lat, $long ) = $f =~ m/cache_(.*?)_(.*?)\.gif$/;
            if (( $latitude > ( $lat - $self->xfringe() * 4 )) &&
                ( $latitude < ( $lat + $self->yfringe() * 4 )) &&
                ( $longitude > ( $long - $self->xfringe() * 4 )) &&
                ( $longitude < ( $long + $self->yfringe() * 4 ))) {
                return "$MAPCACHE/$MAG/$f";
            }
        }
    }

    # Only fetch an image if we're online.
    return undef unless $self->online();

    print "Fetching a map from the server\n" if $debug;

    if ( !defined( $ua )) {
        $ua = new WWW::Mechanize( env_proxy => 1, autocheck => 1 );
        $ua->agent_alias( 'Windows IE 6' );
    }

    $filename = "$MAPCACHE/$MAG/$filename";

    my $res = $ua->get( 'http://www.mapquest.com/maps/map.adp?latlongtype=decimal&latitude=' . $latitude . '&longitude=' . $longitude . '&zoom=' . $mag );

    if ( !$res->is_success ) {
        if ( $res->as_string =~ /connection reset by peer/i ) {
            return undef;
        }
        print $res->as_string if $debug;
        return undef;
    }
    my $page = $res->content;

    my $parser = new HTML::TokeParser \$page;
    while ( my $tag = $parser->get_tag( "input" )) {
        next unless $tag->[1]{type};
        next unless $tag->[1]{type} eq "image";
        next unless $tag->[1]{name};
        next unless $tag->[1]{name} eq "mqmap";
        $url = $tag->[1]{src};
        last;
    }

    if ( !$url) {
        print STDERR "No Image found in retrieved data\n";
        print STDERR "=" x 79;
        print STDERR "\n";
        print STDERR $page if $debug;

        return undef;
    } else {
        print "Image: " . $url . "\n" if $debug;
    }

	my $spang;
	( $url, $spang ) = $url =~ /^(.*MQMapGenRequest=)(.*)$/i;
	$spang = uri_unescape( $spang );

	# Bang the magnification up
	my $magrange = 'whatever';
	if ( substr( $spang, 59, 1 ) eq '@' ) {
        $magrange = '@';
	}

	# This is just pure abuse, really.
	#substr( $spang, 59 + ( $magrange ne 'whatever' ), 1 ) =
    #$mag{$magrange}->{$MAG};

	# I don't recall writing this. It's evidently magic for frobbing
	# the image size.
	substr( $spang, 61 + ( $magrange ne 'whatever' ), 7 ) = '5hf$su6';

	# This basically stops the little star icon from appearing
	if ( substr( $spang, 84 + ( $magrange ne 'whatever' ), 1 ) eq 'a' ) {
        substr( $spang, 84 + ( $magrange ne 'whatever' ), 1 ) = 'b';
	} else {
        substr( $spang, 84 + ( $magrange ne 'whatever' ), 1 ) = 'a';
	}

	$spang = uri_escape( $spang, "^A-Za-z0-9\-_.!~*',:" );

	$url .= $spang;

    print "New URL: ", $url, "\n" if $debug;

    # Wait for it...
    return if $debug > 1;

    $res = $ua->get( $url );

    if ( $res->is_success ) {
        # drop out the countryside colour
        open( FILE, "| giftopnm | ppmchange '#dad0b4' '#ffffff' | ppmchange '#f0f0e4' '#ffffff' | ppmtogif -quiet -transparent '#ffffff' >$ {filename}" );
        binmode( FILE );
        syswrite( FILE, $res->content, length( $res->content ));
        close( FILE );
    } else {
        if ( $debug ) {
            print STDERR "Failed to get image\n";
            print $res->as_string;
            die;
        }
        return undef;
    }

    $filename;
}

1;