###
###  Copyright 2000-2004 University of Illinois Board of Trustees
###  All rights reserved. 
###
###  PSGConf::Action::PackageManager - Generic Package action type for psgconf
###
###
###  Campus Information Technologies and Educational Services
###  University of Illinois at Urbana-Champaign
###


package PSGConf::Action::PackageManager;

use strict;

use PSGConf::Action;

use version;
use POSIX;

our @ISA = qw(PSGConf::Action);


###############################################################################
###  indicates what packages should not have been installed.
###############################################################################

our $pkg_unselected_list;

###############################################################################
###  check method
###############################################################################

sub check
{
	my ($self, $psgconf) = @_;
	my ($pkg_installed_list, $pkg, $i, $cnt, @install_list, @unselected_list);

	print $0 . ": checking for Package updates...\n"
		if ($psgconf->{verbose});

	$self->{changed} = 0;

	# 1) Read in installed packages (pkg_installed_list)
	if ($self->can('pkg_get_installed'))
	{
		$pkg_installed_list = $self->pkg_get_installed($psgconf);
	}
	else
	{
		$pkg_installed_list = $self->{pkg_get_installed}($psgconf);
	}

	###
	### 1a) There is an assumption that the versions of packages are listed
	### in the array in ascending order, make sure it is that way.
	###
	map {
		@{$pkg_installed_list->{$_}} =
			sort {
				$self->ComparePkgs (
					$_ . $self->{seperator}->[0] . $a,
					$_ . $self->{seperator}->[0] . $b
				);
			} @{$pkg_installed_list->{$_}};
	} keys %$pkg_installed_list;

	# 2) Get current versions for all packages that do not have
	#	a default version.
	$self->_fill_install_list($psgconf, $pkg_installed_list);

	# 3) Compare pkg_installed_list with pkg_install_list
	foreach $pkg (keys %{$pkg_installed_list} )
	{
		# We found the package on the install list, now check the version
		if ( exists $self->{install_list}->{$pkg} ) {

			if ( ! length $self->{install_list}->{$pkg} ) {

				# We could not find the default version 
				# so delete from the install list.
				delete $self->{install_list}->{$pkg};

			} else {
				$cnt = scalar @{$pkg_installed_list->{$pkg}};

				for ($i = 0; $i < $cnt; $i++) {

					### If we have a version match, then 
					### remove the package from the install list
					if ( ! $self->ComparePkgs (
						$pkg . $self->{seperator}->[0] . $pkg_installed_list->{$pkg}->[$i],
						$pkg . $self->{seperator}->[0] . $self->{install_list}->{$pkg} )) {

						delete $self->{install_list}->{$pkg};

					} elsif ($self->{number_of_versions} == 1 ||
						$self->{number_of_versions} &&
						$i < $cnt - $self->{number_of_versions} ) {

						# We have a version mismatch.  Add all the 
						# number of packages greater than 
						# number_of_versions to the pkg_unselected_list,
						# or add them all if we have number_of_versions
						# set to 1 (meaning no update functionallity).

						$pkg_unselected_list->{ 
							$pkg . $self->{seperator}->[0] . $pkg_installed_list->{$pkg}->[$i]
						} = undef;
					}

				}

			}
		} else {

			# We have a package not on the install list for ANY version
			# so add it to the pkg_unselected_list.
			map	{ 
				$pkg_unselected_list->{
					$pkg .  $self->{seperator}->[0] . $_
				} = undef;
			} @{$pkg_installed_list->{$pkg}};
		}
	}

	# 4) order pkg_install_list based on dependencies
	$self->{install_list} = $self->_order_list (
							$psgconf, 
							$self->{install_list}, 
							$pkg_installed_list, 
							0);

	# 5) order pkg_unselected_list based on dependencies (inverted sort order).
	$pkg_unselected_list = $self->_order_list (
							$psgconf, 
							$pkg_unselected_list, 
							$pkg_installed_list, 
							1)
		if ( $self->{warn_unselected} );

	# on the pkg_unselected_list, then mark as changed.
	$self->{changed} = 1
		if ( ($self->{warn_unselected} && scalar @{$pkg_unselected_list}) ||
			scalar @{$self->{install_list}} );

	return $self->{changed};
}

###
### Package Comparsion routines.
###
sub AlphaBeta {
	my ($ival) = @_;
	my ($i, $key, @value);

	### If we have no alphabet in the string return right away.
	### Also handle the case where we might have mutilple _'s
	return $ival
		if ( $ival !~ /[[:alpha:]]|_/o );

	### Now translate some of the multi character special cases
	my $IB = {
		'RH'      => '0',
		'EL'      => '0',
		'dev'     => '.1',
		'beta'    => '.1',
		'rc'      => '.2',
		'pl'      => '.4',
		'_'       => '.'
	};

	foreach $key (keys %$IB) {
		$ival =~ s/$key/$IB->{$key}/g;
	}

	### Now handle the versions that start using letters, like
	### bison (1.875c) or openssl (0.9.7e)
	@value = split (//, $ival);

	for ($i = 0; $i < scalar @value; $i++) {

		### Make sure we are changing only single alpha characters
		### and not an entire word.
		if (isalpha($value[$i]) &&
			( $i+1 < scalar @value && !isalpha($value[${i}+1]) ||
				$i+1 == scalar @value)) {
			if ( uc($value[$i]) ) {
				$value[$i] = '.' . (ord($value[$i]) - ord('A') + 1);
			} else {
				$value[$i] = '.' . (ord($value[$i]) - ord('a') + 1);
			}
		}
	}

	return join('',@value);
}

sub ComparePkgs {
	my ($self, $pkga, $pkgb) = @_;
	my (@pa, @pb, $va, $vb, $max, $cnt, $res);

	###
	### Parse the package name
	###
	@pa = $self->Parse($pkga);
	@pb = $self->Parse($pkgb);

	###
	### Find who has more fields
	###
	$max = (scalar @pa > scalar @pb)? scalar @pa: scalar @pb;

	###
	### Now compare each field seperately. Precidence is determined
	### by the order the fields are in the array. Certain package
	### management systems will have to reorder this, ie
	### FreeBSD/Packages and FreeBSD/Ports.
	###
	### Start at the second array position because the first one has
	### the package name in it.
	###
	for ($cnt = 1; $cnt < $max; $cnt++) {
		$va = new version 'v' . &AlphaBeta($pa[$cnt]);
		$vb = new version 'v' . &AlphaBeta($pb[$cnt]);

		$res = $va->numify <=> $vb->numify;

		return $res
			if ( $res );
	}

	return $res;
}

sub Parse {
	my ($self, $pkg) = @_;
	my ($p, $rest, $rpkg, $sep, @res, $size);

	###
	### Look for the last $self->{seperator}->[X]
	### as the field seperator.
	###
	$size = scalar @{$self->{seperator}};
	$rpkg = reverse $pkg;
	foreach $sep ( reverse @{$self->{seperator}} ) {
		($p, $rest) = split (/$sep/, $rpkg, 2);

		### If we had more than one element,
		### then save off the first one (since
		### we reversed the string), iff
		### we pass the regexp expression test
		if ( length $rest &&
			( ! defined $self->{sep_regex}->[$size-1] ||
				$p =~ /^$self->{sep_regex}->[$size-1]$/ )) {
			$res[$size] = reverse $p;
			$rpkg = $rest;
		}
		$size--;
	}

	### Now save the package name itself
	$res[0] = reverse $rpkg;

	return (@res);
}

sub _fill_install_list {
	my ($self, $psgconf, $pkg_installed_list) = @_;
	my ($pkg);

	foreach $pkg ( keys %{$self->{install_list}} ) {
		if (!defined($self->{install_list}->{$pkg})) {
			if ($self->can('pkg_get_latest_version')) {
				$self->{install_list}->{$pkg} =
					$self->pkg_get_latest_version($psgconf, $pkg);
			} else {
				$self->{install_list}->{$pkg} =
				$self->{pkg_get_latest_version}($psgconf, $pkg);
			}

			###
			### Verify we have the latest version, we might have a newer
			### version installed and it is not yet on the repository
			###
			if ( exists $pkg_installed_list->{$pkg} &&
				scalar @{$pkg_installed_list->{$pkg}} &&
				$self->ComparePkgs (
					$pkg . $self->{seperator}->[0]
						. $self->{install_list}->{$pkg},
					$pkg . $self->{seperator}->[0]
						. $pkg_installed_list->{$pkg}->[
							$#{$pkg_installed_list->{$pkg}}
						]
				) <= 0 ) {
				$self->{install_list}->{$pkg} =
					$pkg_installed_list->{$pkg}->[
							$#{$pkg_installed_list->{$pkg}}
					];
			}
		}
	}
}

sub _order_list {
	my ($self, $psgconf, $hash, $installed, $order) = @_;
	my (@list, $pkg, $pkg2, $dep, $maxndx, $ndx, $ndx2, @deps);

	foreach $pkg (keys %{$hash}) {

		### If we have the pkg_default_version defined, use that version
		if ( $hash->{$pkg} ne undef ) {
			$pkg2 = $pkg . $self->{seperator}->[0] . $hash->{$pkg};

		### Otherwise if we have a version in the pkg name, use that
		} elsif ( $pkg =~ /$self->{seperator}->[0]/ ) {
			$pkg2 = $pkg;

		} else {
			warn "\t* no version found for package $pkg\n"
				if ( $psgconf->{verbose} );
			next;
		}

		if ($self->can('pkg_get_dependencies')) {
			@deps = $self->pkg_get_dependencies($psgconf, $pkg2);
		} else {
			@deps = $self->{pkg_get_dependencies}($psgconf, $pkg2);
		}

		if ( scalar @deps ) {
			$maxndx=-1;
			for (my ($i) = 0; $i < scalar @deps; $i++)  {
				($dep) = $self->Parse($deps[$i]);

				### Check to see if the dependancies are already
				### installed (the $installed->{X} tests), or to be 
				### installed (the $hash->{X} tests), if we are doing
				### installs (as defined by $order being zero).
				### If we do not find the dependancy, issue a warning.
				warn "\tWARNING: Package ($deps[$i]) not installed (required by $pkg)\n"
					if ( ! $order &&
						! defined $installed->{$deps[$i]} &&
						! defined $installed->{$dep} &&
						! defined $hash->{$deps[$i]} &&
						! defined $hash->{$dep} );

				### Now find where to install this package on the 
				### ordered list.  Find if the dependancies are already
				### there, the install it after the last one on the list.
				$ndx = &_find_ndx($deps[$i], \@list, 0);
				$ndx2 = &_find_ndx($dep, \@list, 0);

				$maxndx = $ndx if ( $ndx > $maxndx );
				$maxndx = $ndx2 if ( $ndx2 > $maxndx );
			}

			### Now we know that all the dependancies for this package
			### are between the head of the list and $maxndx, so install
			### it after that one.
			@list = &_add_after ($pkg2, $maxndx, \@list);
		} else {
			### we do not have any dependencies, so put the package 
			### at the begining of the list
			@list = &_add_after ($pkg2, -1, \@list);
		}
	}

	@list = reverse(@list) if ( $order );

	return \@list;
}

sub _find_ndx { 
	my ($val, $array, $exact) = @_;
	my $ndx;

	return -1 
		if ( ref($array) ne 'ARRAY' );

	for ($ndx = 0; $ndx < scalar @{$array}; $ndx++)  {
		return $ndx
			if ( $array->[$ndx] eq $val && $exact );
		return $ndx
			if ( $array->[$ndx] =~ /^\Q$val\E/ && ! $exact );
	}

	return -1;
}

sub _add_after {
	my ($val, $ndx, $array) = @_;

	if ( $ndx > scalar @{$array} ) {
		push ( @{$array}, $val);
	} elsif ( $ndx < 0 ) {
		unshift ( @{$array}, $val);
	} else {
		splice ( @{$array}, $ndx+1, 0, ( $val ) );
	}

	return @{$array};
}


###############################################################################
###  diff method
###############################################################################

sub diff
{
	my ($self, $psgconf) = @_;
	my ($pkg, $gotcha);

	# 1) print out pkg_install_list
	# print out total number of Packages to install.
	$gotcha=0;
	map {
		print "\tPackageManager: $_ needs to be installed\n";
		$gotcha=1;
	} @{$self->{install_list}};

	print "\n"
		if ($gotcha && $psgconf->{verbose});

	# 2) print out pkg_unselected_list if pkg_warn_unselected;
	if ( $self->{warn_unselected} ) {
		$gotcha=0;
		map {
			print "\tWARNING: unselected package: $_\n";
			$gotcha=1;
		} @{$pkg_unselected_list};

		print "\n"
			if ($gotcha && $psgconf->{verbose});
	}
}


###############################################################################
###  do() method
###############################################################################

sub do
{
	my ($self, $psgconf) = @_;
	my ($pkg, $key, $ndx, $gotcha, $err);

	print $0 . ": Installing Package updates...\n"
          if ($psgconf->{verbose});

	# 1) install packages on pkg_install_list
	foreach $pkg (@{$self->{install_list}}) {

		### If the number_of_versions is set to 1, then that means
		### the package management system cannot handle multiple versions 
		### on the system at the same time, so we may have to force a 
		### removal before we can do an install.
		if ( $self->{number_of_versions} == 1 ) {

			###
			### Now find the package to remove
			###
               my ($pkg2) = $self->Parse($pkg);

			$ndx = &_find_ndx($pkg2, $pkg_unselected_list, 0);

			if ( $ndx != -1 ) {

				print "\tPackageManager: Removing $pkg_unselected_list->[$ndx]\n"
					if ($psgconf->{verbose});

				if ($self->can('pkg_remove')) {
					if ($self->pkg_remove($psgconf, $pkg_unselected_list->[$ndx], 1)) {
						$err++;
						warn "\n\tWARNING: Could not remove package ($pkg_unselected_list->[$ndx]), as a prelude to install ($pkg), skipping...\n\n";
						next;
					}
				} else {
					if ($self->{pkg_remove}($psgconf, $pkg_unselected_list->[$ndx], 1)) {
						$err++;
						warn "\n\tWARNING: Could not remove package ($pkg_unselected_list->[$ndx]), as a prelude to install ($pkg), skipping...\n\n";
						next;
					}
				}

				delete $pkg_unselected_list->[$ndx];
			}
		}

		$gotcha=1;
		print "\tPackageManager: Installing $pkg\n"
			if ($psgconf->{verbose});

		if ($self->can('pkg_install')) {
			if ($self->pkg_install($psgconf, $pkg)) {
				$err++;
				warn "\n\tWARNING: Could not install package ($pkg)\n\n";
			}
		} else {
			if ($self->{pkg_install}($psgconf, $pkg)) {
				$err++;
				warn "\n\tWARNING: Could not install package ($pkg)\n\n";
			}
		}

		print "\n"
			if ($gotcha && $psgconf->{verbose});
	}

	# 2) if all installed correctly
	#	a) if pkg_remove_unselected and pkg_warn_unselected
	#		remove all packages in pkg_unselected_list
	if ( ! $err && 
		$self->{warn_unselected} && 
		$self->{remove_unselected} ) {

		$gotcha=0;
		print $0 . ": Removing old/unselected Packages...\n"
          	if ($psgconf->{verbose});

		foreach $pkg (@{$pkg_unselected_list}) {
			$gotcha=1;
			print "\tPackageManager: Removing $pkg\n"
				if ($psgconf->{verbose});

			if ($self->can('pkg_remove')) {
				if ($self->pkg_remove($psgconf, $pkg, 0)) {
					$err++;
					warn "\n\tWARNING: Could not remove package ($pkg)\n\n";
				}
			} else {
				if ($self->{pkg_remove}($psgconf, $pkg, 0)) {
					$err++;
					warn "\n\tWARNING: Could not remove package ($pkg)\n\n";
				}
			}
		}

		print "\n"
			if ($gotcha && $psgconf->{verbose});
	}

	return ! $err;
}


###############################################################################
### Placeholder methods that should be defined in the derived classes
###############################################################################
sub pkg_get_installed
{
	my ($self, $psgconf) = @_;
	my (%pkg_installed_list);

	### this space intentionally left blank

	return \%pkg_installed_list;
}

sub pkg_get_latest_version
{
	my ($self, $psgconf, $pkg) = @_;

	### this space intentionally left blank

	return "";
}

sub pkg_get_dependencies
{
	my ($self, $psgconf, $pkg) = @_;

	### this space intentionally left blank

	return undef;
}

sub pkg_install
{
	my ($self, $psgconf, $pkg) = @_;

	### this space intentionally left blank

	return 0;
}

sub pkg_remove
{
	my ($self, $psgconf, $pkg, $force) = @_;

	### this space intentionally left blank

	return 0;
}

1;

__END__

=head1 NAME

PSGConf::Action::PackageManager - Generic package install action

=head1 SYNOPSIS

  use PSGConf::Action::PackageManager;

  $psgconf->register_actions(
		PSGConf::Action::PackageManager->new(
			'quiet'		=> 1
		),
		...
	);

=head1 DESCRIPTION

The B<PSGConf::Action::PackageManager> module provides a B<PSGConf>
abstracted action class for updating all packages.  Usually this is
only used by a derived action class.

The B<PSGConf::Action::PackageManager> class is derived from the
B<PSGConf::Action> class, but it defines/overrides the following
methods:

=over 4

=item check()

Reads in all currently installed packages and compares them to the
list of packages that should be installed (I<pkg_install_list>).  If
there are packages installed that are not on (I<pkg_install_list>) then
add them to the list of unselected packages (I<pkg_unselected_list>).
If there are packages that have version mismatches, leave them on the
I<pkg_install_list>, otherwise remove them from that list.  If there
are more than I<pkg_number_of_versions> packages installed of a type,
put the oldest packages on I<pkg_unselected_list>.

=item diff()

Prints out any packages that need to be installed (I<pkg_install_list>) 
or removed (I<pkg_unselected_list>).

=item do()

Installs all the packages left listed in I<pkg_install_list>.  Removes
packages from the I<pkg_unselected_list> if I<pkg_warn_unselected> and
I<pkg_remove_unselected> are set.

The following are methods that need to be defined by the derived class
and are only place holders here.

=over 4

=item I<pkg_get_installed()>

A method that will assign values to the I<pkg_installed_list>, which
will be all the packages currently installed.  The I<pkg_installed_list>
is a reference to a hash of arrays.  The array is sorted to have
versions in ascending order.  Called from the B<check()> method.

=item I<pkg_get_latest_version($pkg)>

A method that will return a B<PSGConf::Data::String> that contains 
the latest version of $pkg from the package repository.  Called from 
the B<check()> method.

=item I<pkg_get_dependencies($pkg)>

A method that will return a B<PSGConf::Data::List> that contains
all the packages that $pkg will depend upon, regardless
if they have been installed or not.  This is for the package on
the package repository and $pkg will have the version in it as well.
Called from the B<diff()> method.

=item I<pkg_install($pkg)>

A method that will install a $pkg on the system.  Returns 0 for a 
successfull install, non-zero for a failure.  Called from B<do()> method.

=item I<pkg_remove($pkg, $force)>

A method that will remove $pkg from the system, and may have to force
the removal, depending on the value of $force, which will be a 
B<PSGConf::Data::Boolean>.  Returns 0 for a successfull removal, non-zero
for a failure.  Called from B<do()> method.

=back

The B<PSGConf::Action::PackageManager> class also defines the
following variables:

=over 4

=item I<pkg_unselected_list>

A list of packages that were found to be installed but are not in the
I<pkg_install_list>.  The user does not set this list, but rather is
derived from the system itself.  The list key is both the package and
its version.

The following methods are added to be used by the derived classes

=item I<Parse($pkg)>

A method that will take the B<PSGConf::Data::List> C<pkg_seperator> and
break up C<$pkg> into its component parts.  It will return an array of
elements.

=item I<ComparePkgs($pkga, $pkgb)>

A method that compares I<$pkga> with I<$pkgb> and returns less than,
equal to or greater than zero if I<$pkga> is less than, equal to or
greater than I<$pkgb>.  

=back

=back

=head1 SEE ALSO

L<perl>

L<PSGConf>

L<PSGConf::Action>

L<PSGConf::Data::Boolean>

L<PSGConf::Data::String>

L<PSGConf::Data::Integer>

L<POSIX>

L<version>

=cut