#!/usr/bin/perl 
# -*-perl-*-

#use strict;
#use diagnostics;

use LWP::UserAgent;
use File::Path;

use HTTP::Date ();

# deal with arguments
my $vardir = $ARGV[0];
my $method = $ARGV[1];
my $option = $ARGV[2];

$| = 1;

if ($option eq "manual") {
    print "Enter package file names or a blank line to finish\n";
    while(1) {
	print "Enter package file name:";
	my $fn = <STDIN>;
	chomp $fn;
	if ( $fn == "") {
	    exit 0;
	}
	if ( -f $fn ) {
	    system ("dpkg", "--merge-avail", $fn);
	} else {
	    print "Could not find $fn, try again\n";
	}
    };
};

#print "vardir: $vardir, method: $method, option: $option\n";

my $arch=`dpkg --print-installation-architecture`;
$arch='i386' if $?;
chomp $arch;
my $exit = 0;
my $pass;


# get info from control file
do "$vardir/methods/http/vars" or die "Could not find state file (re-run Access method)";

if (($use_authorization_basic or $use_proxy_authorization)
    and $auth_passwd eq "?") {
	print "Enter proxy password: ";
	system ("stty", "-echo");
	$pass=<STDIN>;
	chomp $pass;
	print "\n";
	system ("stty", "echo");
} elsif ($use_authorization_basic or $use_proxy_authorization) {
	$pass = $auth_passwd;
}

chdir "$vardir/methods/http";

print "Getting Packages files...(stop with ^C)\n\n";

my @pkgfiles;

sub download {
    my $site;
    delete $ENV{ftp_proxy} unless $proxy_ftp;
    
    my $ua = new LWP::UserAgent;
    $ua->env_proxy;
    my $req;
    my $res;
    
    foreach $site (@site) {

	my $method = $1 if ($site =~ /^([^:]*):/);
	my $dir = $1 if ($site =~ m%://(.*)%);

	my @dists = split(/ +/, $distribs{$site});
	my $dist;

	foreach $dist (@dists) {
	    if (! -d "$dldir/$method/$dir$dist") {
		mkpath("$dldir/$method/$dir$dist",0,0755);
	    }
	    print "Getting $site$dist/Packages.gz... ";
	    $req = new HTTP::Request 'GET', "$site$dist/Packages.gz";
	    if ($use_authorization_basic) {
	    	$req->authorization_basic ($auth_user, $pass);
	    } elsif ($use_proxy_authorization) {
	        $req->proxy_authorization_basic ($auth_user, $pass);
	    }
	    if (-r "$dldir/$method/$dir$dist/Packages.gz") {
		my ($mtime) = (stat("$dldir/$method/$dir$dist/Packages.gz"))[9];
		$req->header('If-Modified-Since' =>
			   HTTP::Date::time2str($mtime));
	    };
	    $req->header('Cache-Control', 'max-age=0');
	    $res = $ua->request ($req, "$dldir/$method/$dir$dist/Packages.gz");
	    printf("%4.2lf days old",$res->current_age/3600/24);
	    if (! $res->is_error) {
		push(@pkgfiles,"$dldir/$method/$dir$dist/Packages.gz");
	    } else {
		print $res->message;
		$exit=13;
	    }
	    print "\n";
	}
    }
}

eval {
    local $SIG{INT} = sub {
	die "Interrupted!\n";
    };
    download();
};

my $ans;

if(!$exit) { # don't clear if we had an error
    print <<EOM;

It is a good idea to clear the available list of old packages.
However if you have only downloaded a Package files from non-main
distributions you might not want to do this.

EOM
    print "Do you want to clear available list [y]: ";
    $ans=<STDIN>;
    chomp $ans;
    if($ans eq "" or $ans =~ /^[Yy]/) {
	print "dpkg --clear-avail\n";
	if(system("dpkg", "--clear-avail")) {
	    print "dpkg --clear-avail failed.";
	    $exit=8;
	    die "error";
	}
    }
}

my $file;

foreach $file (@pkgfiles) {
    if (-r $file) {
	print "zcat $file | dpkg --merge-avail\n";
	if (system("gunzip < $file > Packages")) {
	    print "gunzip failed on $file\n";
	    $exit=12;
	} else {
	    if(system ("dpkg", "--merge-avail", "Packages")) {
		print "Dpkg merge available failed on $file";
		$exit = 9;
	    }
	}
    } else {
	print "$file unavailable for dpkg --merge-avail\n";
    }
}
unlink("Packages");

if (! $exit ) {
	print "dpkg --forget-old-unavail\n";
	if(system("dpkg", "--forget-old-unavail")) {
	    print "dpkg --forget-old-unavail failed";
	    die "error";
	}
}

exit $exit;
