#!/usr/env perl

use strict;

$|=1;

eval {
  require IO::Uncompress::Gunzip;
};

if ($@) {
  print "\nYou don't have IO::Uncompress:Gunzip, trying to install...\n";
  system('ppm install IO::Uncompress::Gunzip');
  require IO::Uncompress::Gunzip;
}

IO::Uncompress::Gunzip->import(qw(gunzip $GunzipError));

my @libs = (
  {
   'lib'       => 'libxml2.dll',
   'version'   => '2.6.27',
   'size'      => '927232',
   'size_comp' => '436823',
  },
);

eval { require Prompt::Timeout; };

if ($@) {
  print "\nYou don't have Prompt::Timeout for smooth installation. Using ExtUtils::MakeMaker::prompt() instead\n" .
        "Consider running:\n ppm install Prompt::Timeout\n\n";
  require ExtUtils::MakeMaker;
  ExtUtils::MakeMaker->import();
} else {
  Prompt::Timeout->import();
}

use ExtUtils::Command;
use Config;
use LWP::Simple qw(getstore $ua is_success);
use File::Spec;
use File::Basename;

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;
  $ua->proxy(['http'], $proxy);
}

my $guess = $Config{'binexp'};

                          
# Search libraries

foreach my $l (@libs) {
  my $lib = $l->{'lib'};
  my $version = $l->{'version'};
  my $size = $l->{'size'};
  my $size_comp = $l->{'size_comp'};

  my $libgz = $lib . '.gz';

  if (my $hit = search_for($lib, $guess)) {
    # Check size
    my $size_dll = -s $hit . '/' . $lib;
    if ($size_dll eq $size) {
      print "Using $lib from $hit\n";
      next;
    }

    print "The library $lib already exists in $hit, but it has different size.\n" . 
          " Existing: $size_dll bytes\n" .
          " Needed  : $size bytes\n\n" .
          "If it has the same version ($version), it is ok, " .
          "otherwise you may want to download version $version.\n";

    my $proceed = prompt("Fetch $lib? (y/N)", 'Y');
    next unless $proceed =~ /[Yy]/;

  }

  print "The library $lib is needed to complete the installation,\n" .
        "and should be placed in a directory somewhere in your PATH\n" .
        "environment variable. I will fetch and install this for you.\n";
  # Fetching 
  my $remote = 'http://trouchelle.com/ppm/scripts/dll/' . $libgz;
  print "Fetching $remote ($size_comp bytes) ... ";
  while (1) {
    if (is_success(getstore($remote, $libgz))) {
      print " done!\n";
      last;
    } else {
      print ' failed, trying again ... ';
    }
  }
  # Unpacking
  unless (IO::Uncompress::Gunzip::gunzip ($libgz => $lib, 'BinModeOut' => 1)) {
    print "gunzip failed: $IO::Uncompress::Gunzip::GunzipError\nAborting installation\n";
    next;
  }
  unlink $libgz;

  my $base = prompt("Where should $lib be placed?", $guess);

  $base =~ s/$lib$//i;
  $base =~ s!\\!/!g;
  $base =~ s!/$!!;
  unless (-d $base) {
    my $ans = prompt("$base does not exist. Create it? (Y/n)", 'Y');
    if ($ans =~ /^[Yy]/) {
      mkdir $base;
    } else {
      next;
    }
  }


  if (-f "$base/$lib") {
     my $ans = prompt("$base/$lib exists. Overwrite?", 'Y');
     if ($ans =~ /^[Nn]/) {
       next;
     }
  }

  use File::Copy;
  move($lib, "$base/$lib");
  unless (-f "$base/$lib") {
    print "Moving $lib to $base failed: $!", 'fatal';
    next;
  }
  print "$lib has been successfully installed to $base\n";
}
###

sub search_for {
  my ($lib, $guess) = @_;
  return $guess if (-e File::Spec->catfile($guess, $lib));
  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;
}

1;