use PPM;
my $file = $ARGV[0];
$file = &file_precious() unless $file;

my %installed = &pkg_installed();
my @packages  = &pkg2install($file);
for my $pkg (@packages) {
	my $package  = $pkg->{'NAME'};
	my $location = $pkg->{'LOCATION'};
	if ($installed{$package}) {
		UpgradePackage('package' => $package, 'location' => $location);
	}
	else {
		InstallPackage('package' => $package, 'location' => $location);
	}
}

sub file_precious {
use Config;
	my $file_precious = $Config{'sitelib'}.'/ppm.xml';
	$file_precious =~ s!\\!/!g;
	$file_precious;
}

sub pkg_installed {
	my $file = &file_precious();
	my @packages = &pkg2install($file);
	my %ret;
	for my $pkg (@packages) {
		$ret{$pkg->{'NAME'}}++;
	}
	%ret;
}

sub pkg2install {
	my $file = shift;
	return unless $file;
	my $file_precious = &file_precious();
#	print $file_precious,"\n";

	my %precious = &ppm_precious($file_precious);
#	for my $key (keys %precious) { print "$key\n";}
	my @packages = &ppm_package($file);
#	for my $pkg (@packages) {print $pkg->{'NAME'},'::',$pkg->{'LOCATION'},"\n";}

	my @ret;
	my $default_loc;
	for my $pkg (@packages) {
		my $name = $pkg->{'NAME'};
		my $loc  = $pkg->{'LOCATION'};
		if (!$precious{$name}) {
			delete $pkg->{'LOCATION'} if ($loc eq $default_loc);
			push @ret, $pkg;
		}
		else {
			$default_loc = $loc unless $default_loc;
		}
	}
	@ret;
}


sub ppm_package {
use XML::Parser;
	my $file = shift;
	my $p    = new XML::Parser(Style => 'Tree');
	my $xml  = $p->parsefile($file)->[1];

	my @ars     = &GetArray($xml, 'PACKAGE');
	my @ret;
	for my $ar (@ars) {
		my $pkg = {};
		$pkg->{'NAME'} = $ar->[0]->{'NAME'};
		for my $attr (
			'LOCATION',
			)
		{
			&set_pkg_attr($pkg, $ar, $attr);
		}
		push @ret, $pkg;
	}
	@ret;
}

sub set_pkg_attr {
	my ($pkg, $ar, $attr) = @_;
	my ($ar) = &GetArray($ar, $attr);
	$pkg->{$attr} = $ar->[2];
}

sub ppm_precious {
use XML::Parser;
	my $file = shift;
	my $p    = new XML::Parser(Style => 'Tree');
	my $xml  = $p->parsefile($file)->[1];

	my ($ar)= &GetArray($xml, 'PPMPRECIOUS');
	my %ret;
	for (split(/;/,$ar->[2])) {
		$ret{$_}++;
	}
	%ret;
}

sub GetArray {
	my $xml    = shift;
	my $target = shift;
	my @ret;
	for (my $i=0; $i <= $#$xml; $i++) {
		if ($xml->[$i] eq $target) {
			push @ret, $xml->[$i+1];
		}
	}
	@ret;
}