#!/Perl/bin/Perl.exe
use strict;
require File::Spec;
use File::Basename;
use ExtUtils::MakeMaker;
use LWP::Simple qw(getstore $ua is_success);
if ($ENV{HTTP_proxy_user} and $ENV{HTTP_proxy_pass}
    and $ENV{HTTP_proxy} =~ /^http:\/\/([^@]+)$/) {
       my $proxy ="http://$ENV{HTTP_proxy_user}:$ENV{HTTP_proxy_pass}\@" . $1;
       print "setting user/pass into proxy_env...\n";
       $ua->proxy(['http'], $proxy);
}
my $file = 'GeoIP.dat';
my $default = $ENV{programfiles} . '/GeoIP';
my $guess = $default;
my $recommended = 'yes';

if (my $hit = search_for($file, $guess)) {
  print <<"END";

A copy of the needed database file $file was found in
$hit. No further action is required, unless 
you want to fetch the copy of $file on this 
server, which may be more recent than your copy.

END
  $recommended = 'no';
}

if ($recommended eq 'yes') {
  print <<"END";

The database $file is needed to complete the installation,
and should be placed in the $default directory. I will
now fetch and install this for you, if you like.

END
}

my $proceed = prompt("Fetch $file?", $recommended);
suggest_manual("Aborting download of $file.", 'warn') 
  unless ($proceed =~ /^y/i);
my $remote = 'http://theoryx5.uwinnipeg.ca/ppms/scripts/' . $file;
print "Fetching $remote ... ";
die "Fetching file failed" unless (is_success(getstore($remote, $file)));
print " done!\n";
suggest_manual("Cannot find $file") unless -f $file;
my $base = $default;

$base =~ s/$file$//i;
$base =~ s!\\!/!g;
$base =~ s!/$!!;
unless (-d $base) {
  my $ans = prompt("$base does not exist. Create it?", 'no');
  if ($ans =~ /^y/i) {
    mkdir $base;
    suggest_manual("Could not create $base: $!") unless (-d $base);
  }
  else {
    suggest_manual("Will not create $base.");
  }
}

if (-f "$base/$file") {
   my $ans = prompt("$base/$file exists. Overwrite?", 'no');
   if ($ans =~ /^n/i) {
      suggest_manual("Will not overwrite $base/$file.");
   }
}

use File::Copy;
move($file, "$base/$file");
suggest_manual("Moving $file to $base failed: $!") unless (-f "$base/$file");
print "$file has been successfully installed to $base\n";
sleep(5);

sub suggest_manual {
  my $msg = shift;
  print $msg, "\n";
  print "Installation of $file not completed.\n";
  sleep(5);
  exit(0);
}

sub search_for {
  my ($lib, $guess) = @_;
  return $guess if (-e File::Spec->catfile($guess, $lib));
  $guess = 'Program Files';
  my $hit;
 SEARCH: {
    my $candidate;
    for (File::Spec->path) {
      $candidate = File::Spec->catfile($_, $lib);
      if (-e $candidate) {
        $hit = $candidate;
        last SEARCH;
      }
    }
    my @drives = drives();
    last SEARCH unless (@drives > 0);
    for (@drives) {
      $candidate = File::Spec->catfile($_, $guess, $lib);
      if (-e $candidate) {
        $hit = $candidate;
        last SEARCH;
      }
    }
  }
  return $hit ? dirname($hit) : undef;
}

sub drives {
  my @drives = ();
  eval{require Win32API::File;};
  return map {"$_:\\"} ('C' .. 'Z') if $@;
  my @r = Win32API::File::getLogicalDrives();
  return unless @r > 0;
  foreach (@r) {
    my $t = Win32API::File::GetDriveType($_);
    push @drives, $_ if ($t == 3 or $t == 4);
  }
  return @drives > 0 ? @drives : undef;
}