#!/usr/bin/perl
#Copyright (c) 2008, Zane C. Bowers
#All rights reserved.
#
#Redistribution and use in source and binary forms, with or without modification,
#are permitted provided that the following conditions are met:
#
#   * Redistributions of source code must retain the above copyright notice,
#    this list of conditions and the following disclaimer.
#   * Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
#ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 
#WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
#IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
#INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 
#BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
#DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
#LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
#OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
#THE POSSIBILITY OF SUCH DAMAGE.

use strict;
use warnings;
use Getopt::Std;
use FreeBSD::Pkgs::FindUpdates;
use FreeBSD::Ports::INDEXhash qw/INDEXhash/;
use FreeBSD::Ports;
use File::Path;

$Getopt::Std::STANDARD_HELP_VERSION = 1;

#version function
sub main::VERSION_MESSAGE {
        print "pkg_findupdates 0.1.0\n".
		      "\n".
			  "-i  Interactively process them.\n".
			  "-r <regex>  Operate only on ports matching a specific regexp\n";
}

#print help
sub main::HELP_MESSAGE {
        print "\n";
}

#global vars
our %opts=();
our @requiredTypes=('Edeps', 'Bdeps', 'Pdeps', 'Rdeps', 'Fdeps');
our $portsdir='/usr/ports/';
our %index;
our %processed;
our %failed;
our %changes;
our $pkgdb;
our $packagedir;

#fetch a package
sub fetch{
	my $new=$_[0];
	my $portsdir='/usr/ports/';
	if (defined($ENV{PORTSDIR})) {
		$portsdir=$ENV{PORTSDIR};
	}

	my $packagedir=$portsdir.'packages/All';

	#get the release info
	my $release=`uname -r`;
	my @releaseA=split(/-/, $release);
	my $version=$releaseA[0];
	my $type=lc($releaseA[1]);
	my $arch=`uname -p`;
	chomp($type);
	chomp($arch);
	chomp($version);

	#if it is stable, we don't need the minor version for it...
	if ($type eq 'stable') {
		$version=~s/\..*//;
	}

	system('fetch ftp://ftp.freebsd.org/pub/FreeBSD/ports/'.$arch.'/packages-'.$version.'-'.$type.'/All/'.$new.'.tbz');
	if ($? ne '0') {
		warn('Fetching the package for the new port failed');
		return undef;
	}

	return 1;
}

#install a package
sub install{
	my $new=$_[0];

	if (!fetch($new)){
		return undef
	}

	system('pkg_add '.$new.'.tbz');
	if ($? ne '0') {
		warn('Could not add the new port, "'.$new.'",');
		return undef;
	}

	print "'".$new."' installed\n";

	return 1;
}

#update a port
#this just performs the removal and addition...
#bupdate performs the more important stuff...
sub update{
	my $old=$_[0];
	my $new=$_[1];

	if (!fetch($new)){
		return undef
	}

	system('pkg_delete -f '.$old);
	if ($? ne '0') {
		warn('Could not remove the old port, "'.$old.'",');
		return undef;
	}

	system('pkg_add '.$new.'.tbz');
	if ($? ne '0') {
		warn('Could not add the new port, "'.$new.'",');
		return undef;
	}

	print "'".$old."' updated to '".$new."'.\n";

	return 1;
}

sub bupdate{
	my $old=$_[0];
	my $new=$_[1];
	print "Updating '".$old."' to '".$new."'\n";

	if (defined($failed{$new})) {
		print "Skipping: Updating '".$old."' to '".$new."' because of previous failure.\n";
		return undef;
	}
	if (defined($failed{$old})) {
		print "Skipping: Updating '".$old."' to '".$new."' because of previous failure.\n";
		return undef;
	}
	if (defined($processed{$new})) {
		print "Skipping: Updating '".$old."' to '".$new."' already done.\n";		
		return 1;
	}
	if (defined($processed{$old})) {
		print "Skipping: Updating '".$old."' to '".$new."' already done.\n";		
		return 1;
	}

	#ask if it should process this port if interactive is turned on
	if ($opts{i}) {
		print "Update '".$old."' to '".$new."''? [y/n]  ";
		my $line=<STDIN>;
		
		if ($line ne "y\n") {
			if ($line ne "\n"){
				print "Skipping '".$old."'...\n";
				$failed{$old}=1;
				$failed{$new}=1;
				return undef;
			}
		}
	}

	#process all the requirements
	my $requiredTypesInt=0;
	while (defined($requiredTypes[$requiredTypesInt])) {
		my $rtype=$requiredTypes[$requiredTypesInt];
		my $rInt=0;
		print "checking ".$rtype."...\n";
		#process each requirement
		while (defined($index{$new}{$rtype}[$rInt])){
			my $requirement=$index{$new}{$rtype}[$rInt];
			#make sure the requirement is installed
			if (!defined($pkgdb->{packages}{$requirement})) {
				print "'".$requirement."' is not installed, but required.\n";
				my $installed=0;
				#this handles the backage if the requirement needs updating
				if (defined($changes{to}{$requirement})) {
					if (!bupdate($changes{to}{$requirement}, $requirement)){
						$failed{$old}=1;
						$failed{$new}=1;
						$failed{$requirement}=1;
						return undef
					}
					$installed=1;
				}
				#handles it if the requirement needs install
				if (!defined($changes{to}{$requirement})) {
					if (!rinstall($requirement)){
						$failed{$old}=1;
						$failed{$new}=1;
						$failed{$requirement}=1;
						return undef
					}
					$installed=1;
				}
				if (!$installed) {
					warn('Was not able to figure out what to do with "'.$requirement.'" when'.
						 'updating "'.$old.'" to "'.$new.'"');
					return undef;
				}
			}
			else {
				print "'".$requirement."' installed...\n";
			}
			$rInt++;
		}
		
		$requiredTypesInt++;
	}
	
	if (!update($old, $new)){
		$failed{$old}=1;
		$failed{$new}=1;
		return undef;
	};
	print "Updated '".$old."' to '".$new."'.\n";
	$processed{$new}=1;
	$processed{$old}=1;

	return 1;
}

#this is used for installing requirements that are not installed.
sub rinstall{
	my $new=$_[0];

	if (defined($failed{$new})) {
		print "Skipping: Installing '".$new."' because of previous failure.\n";
		return undef;
	}
	if (defined($processed{$new})) {
		print "Skipping: Installing '".$new."' already done.\n";
		return 1;
	}

	#process all the requirements
	my $requiredTypesInt=0;
	while (defined($requiredTypes[$requiredTypesInt])) {
		my $rtype=$requiredTypes[$requiredTypesInt];
		my $rInt=0;
		#process each requirement
		print "checking ".$rtype."...\n";
		while (defined($index{$new}{$rtype}[$rInt])){
			my $requirement=$index{$new}{$rtype}[$rInt];
			#make sure the requirement is installed
			if (!defined($pkgdb->{packages}{$requirement})) {
				my $installed=0;
				print "'".$requirement."' is not installed, but required.\n";
				#this handles the backage if the requirement needs updating
				if (defined($changes{to}{$requirement})) {
					if (!bupdate($changes{to}{$requirement}, $requirement)){
						$failed{$new}=1;
						$failed{$requirement}=1;
						return undef
					}
					$installed=1;
				}
				#handles it if the requirement needs install
				if (!defined($changes{to}{$requirement})) {
					if (!rinstall($requirement)){
						$failed{$new}=1;
						$failed{$requirement}=1;
						return undef
					}
					$installed=1;
				}
				if (!$installed) {
					warn('Was not able to figure out what to do with "'.$requirement.'" when '.
						 'installing "'.$new.'"');
					return undef;
				}else {
					print "'".$requirement."' installed...\n";
				}
			}
			$rInt++;
		}
		$requiredTypesInt++;
	}

	if (!install($new)) {
		$failed{$new}=1;
		return undef;
	}
	print "Installed '".$new."'.\n";
	$processed{$new}=1;

	return 1;
}

#gets the options
getopts('ir:', \%opts);

#parse the installed packages
$pkgdb=FreeBSD::Pkgs->new;
$pkgdb->parseInstalled({files=>0});

#sets up the directory variables for later use
if (defined($ENV{PORTSDIR})) {
	$portsdir=$ENV{PORTSDIR};
}
$packagedir=$portsdir.'/packages/All';

#make the packages directory if needed
if (! -d $packagedir) {
	mkpath($packagedir);
	if ($? ne '0') {
		warn('pkg_bupdate: Unable to create "'.$packagedir.'"');
		exit 1;
	}
}

#Go to the directory as this will simplify the update stuff
chdir($packagedir);
if ($? ne '0') {
	warn('pkg_bupdate: Could not change to the package directory, "'.$packagedir.'",');
	exit 1;
}

#parse the ports index
%index=INDEXhash();

my $pkgsupdate = FreeBSD::Pkgs::FindUpdates->new(); #finds changes
%changes=$pkgsupdate->find(\%index, $pkgdb);

#prints downgraded ports if needed
while(our ($name, $pkg) = each %{$changes{upgrade}}){
	if (!defined($opts{r})) {
		bupdate($pkg->{old}, $pkg->{new});
	}else {
		if ($pkg->{old} =~ /$opts{r}/) {
			bupdate($pkg->{old}, $pkg->{new});
		}
	}
}

#prints downgraded ports if needed
while(our ($name, $pkg) = each %{$changes{downgrade}}){
	if (!defined($opts{r})) {
		bupdate($pkg->{old}, $pkg->{new});
	}else {
		if ($pkg->{old} =~ /$opts{r}/) {
			bupdate($pkg->{old}, $pkg->{new});
		}
	}
}

=head1 NAME

pkg_findupdates - Finds updated packages.

=head1 SYNOPSIS

pkg_findupdates -i [B<-r> regexp]

=head1 ARGUEMENTS

=head2 -i

Operate interactively.

=head2 -r

Only operate on packages that match this regexp. Currently this
only operates on that package and the stuff it requires. It will
not process packages requiring matched packages.

=head2 INDEX notes

This requires a up to date INDEX with where ever you are pulling packages
from. So far like RELENG_7, you would want to setup something like the
following and run it each time 

=cut

