package PPM;
require 5.004;
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw(PPMdat PPMERR InstalledPackageProperties ListOfRepositories RemoveRepository AddRepository GetPPMOptions SetPPMOptions InstallPackage RemovePackage VerifyPackage UpgradePackage RepositoryPackages RepositoryPackageProperties QueryInstalledPackages QueryPPD);

use LWP::UserAgent;
use LWP::Simple;

use File::Basename;
use File::Copy;
use File::Path;
use ExtUtils::Install;
use Cwd;
use Config;
use HtmlHelp;

use Osd;
use Archive::Tar;

use strict;

#set Debug to 1 to debug PPMdat file reading
#             2 to debug parsing PPDs
#
# values may be or'ed together.
#
my $Debug = 0;

my $PPMERR;

my ($PPM_ver, $CPU, $OS_VALUE, $OS_VERSION, $LANGUAGE);

# options from data file.
my ($build_dir, $Ignorecase, $Clean, $Force_install, $Confirm, $Root, $More);

my %repositories;

my ($current_root, $orig_root);

# Keys for this hash are package names.  It is filled in by a successful
# call to read_config().  Each package is a hash with the following keys:
# LOCATION, INST_DATE, INST_ROOT, INST_PACKLIST and INST_PPD.
my %installed_packages = ();

# Keys for this hash are CODEBASE, INSTALL_HREF, INSTALL_EXEC,
# INSTALL_SCRIPT, NAME, VERSION, TITLE, ABSTRACT, LICENSE, AUTHOR,
# UNINSTALL_HREF, UNINSTALL_EXEC, UNINSTALL_SCRIPT, PERLCORE_VER and DEPEND.
# It is filled in after a successful call to parsePPD().
my %current_package = ();
my @current_package_stack;

# this may get overridden by the config file.
my @required_packages = ('PPM', 'libnet', 'Archive-Tar', 'Compress-Zlib', 'libwww-perl');

# ppm.xml location is in the environment variable 'PPM_DAT', else it is in 
# the same place as this script.
my ($basename, $path) = fileparse($0);

if (defined $ENV{'PPM_DAT'} && -f $ENV{'PPM_DAT'}) 
{
    $PPM::PPMdat = $ENV{'PPM_DAT'};
}
elsif (-f "$Config{'installsitelib'}/ppm.xml")
{
	$PPM::PPMdat = "$Config{'installsitelib'}/ppm.xml";
}
elsif (-f "$Config{'installprivlib'}/ppm.xml")
{
	$PPM::PPMdat = "$Config{'installprivlib'}/ppm.xml";
}
elsif (-f $path . "/ppm.xml")
{  
    $PPM::PPMdat = $path . $PPM::PPMdat;
}
else
{
	print "Failed to load PPM_DAT file\n";
	return -1;
}


my $init = 0;

#
# Exported subs
#

sub InstalledPackageProperties
{
    my (%ret_hash, $dep);
    read_config();
    foreach $_ (keys %installed_packages) {
        parsePPD(%{ $installed_packages{$_}{'INST_PPD'} } );
        $ret_hash{$_}{'NAME'} = $_;
        $ret_hash{$_}{'DATE'} = $installed_packages{$_}{'INST_DATE'};
        $ret_hash{$_}{'AUTHOR'} = $current_package{'AUTHOR'};
        $ret_hash{$_}{'VERSION'} = $current_package{'VERSION'};
        $ret_hash{$_}{'ABSTRACT'} = $current_package{'ABSTRACT'};
        $ret_hash{$_}{'PERLCORE_VER'} = $current_package{'PERLCORE_VER'};
        foreach $dep (@{$current_package{'DEPEND'}}) {
            push @{$ret_hash{$_}{'DEPEND'}}, $dep;
        }
    }
    return %ret_hash;
}

sub ListOfRepositories
{
    read_config();
    return %repositories;
}

sub RemoveRepository
{
    my (%argv) = @_;
    my ($arg, $repository, $save, $loc);
    foreach $arg (keys %argv) {
        if ($arg eq 'repository') { $repository = $argv{$arg}; }
        if ($arg eq 'save') { $save = $argv{$arg}; }
    }

    read_config();
    foreach $_ (keys %repositories) {
        if ($_ =~ /^\Q$repository\E$/) {
            delete $repositories{$repository};
            last;
        }
    }
    if (defined $save && $save != 0) { save_options(); }
}

sub AddRepository
{
    my (%argv) = @_;
    my ($arg, $repository, $location, $save);
    foreach $arg (keys %argv) {
        if ($arg eq 'repository') { $repository = $argv{$arg}; }
        if ($arg eq 'location') { $location = $argv{$arg}; }
        if ($arg eq 'save') { $save = $argv{$arg}; }
    }
    
    read_config();
    $repositories{$repository} = $location;
    if (defined $save && $save != 0) { save_options(); }
}

sub GetPPMOptions
{
    my %ret_hash;
    read_config();
    $ret_hash{'IGNORECASE'} = $Ignorecase;
    $ret_hash{'CLEAN'} = $Clean;
    $ret_hash{'FORCE_INSTALL'} = $Force_install;
    $ret_hash{'CONFIRM'} = $Confirm;
    $ret_hash{'ROOT'} = $Root;
    $ret_hash{'BUILDDIR'} = $build_dir;
    $ret_hash{'MORE'} = $More;
    return %ret_hash;
}

sub SetPPMOptions
{
    my (%argv) = @_;
    my ($arg, %opts, $save);
    foreach $arg (keys %argv) {
        if ($arg eq 'options') { %opts = %{$argv{$arg}}; }
        if ($arg eq 'save') { $save = $argv{$arg}; }
    }
    $Ignorecase = $opts{'IGNORECASE'};
    $Clean = $opts{'CLEAN'};
    $Force_install = $opts{'FORCE_INSTALL'};
    $Confirm = $opts{'CONFIRM'};
    $Root = $opts{'ROOT'};
    $build_dir = $opts{'BUILDDIR'};
	$More = $opts{'MORE'};
    if (defined $save && $save != 0) { save_options(); }
}

sub UpgradePackage
{
    my (%argv) = @_;
    my ($arg, $package, $location);
    foreach $arg (keys %argv) {
        if ($arg eq 'package') { $package = $argv{$arg}; }
        if ($arg eq 'location') { $location = $argv{$arg}; }
    }
    return VerifyPackage("package" => $package, "location" => $location, "upgrade" => 1);
}

# Returns 1 on success, 0 and sets $PPMERR on failure.
sub InstallPackage
{
    my (%argv) = @_;
    my ($arg, $package, $location, $root);
    foreach $arg (keys %argv) {
        if ($arg eq 'package') { $package = $argv{$arg}; }
        if ($arg eq 'location') { $location = $argv{$arg}; }
        if ($arg eq 'root') { $root = $argv{$arg}; }
    }
    my $PPDfile;

    read_config();

    my $packagefile = $package;
    if (!defined($PPDfile = locatePPDfile($packagefile, $location))) {
        $PPM::PPMERR = "Could not locate a PPD file for package $package";
        return 0;
    }
    my %PPD = readPPDfile($PPDfile);

    parsePPD(%PPD);

    if (defined $current_package{'DEPEND'}) {
        my ($dep);
        push(@current_package_stack, [%current_package]);
        foreach $dep (@{$current_package{'DEPEND'}}) {
            # Has PPM already installed it?
            if(!defined $installed_packages{$dep}) {
                # Has *anybody* installed it, or is it part of core Perl?
                my $p = $dep;
                $p =~ s@-@/@g;
                my $found = grep -f, map "$_/$p.pm", @INC;
                if (!$found) {
#                    print "Installing dependency '$dep'...\n";
                    if(!InstallPackage("package" => $dep, "location" => $location)) {
                        $PPM::PPMERR = "Error installing dependency: $PPM::PPMERR\n";
                        if ($Force_install eq "No") {
                            return 0;
                        }
                    }
                }
            }
        }
        %current_package = @{pop @current_package_stack};
    }
    my ($basename, $path) = fileparse($PPDfile);
    # strip the trailing path separator
    my $chr = substr($path, -1, 1);
    if ($chr eq '/' || $chr eq '\\') {
        chop $path;
    }
    
    if ($path =~ /^file:\/\/.*\|/i) {
        # $path is a local directory, let's avoid LWP by changing
        # it to a pathname.
        $path =~ s@^file://@@i;
        $path =~ s@^localhost/@@i;
        $path =~ s@\|@:@;
    }


    # get the code and put it in $build_dir
    my $install_dir = $build_dir . "/" . $current_package{'NAME'};
    File::Path::rmtree($install_dir,0,0);
    if(!-d $install_dir && !File::Path::mkpath($install_dir, 0, 0755)) {
        $PPM::PPMERR = "Could not create $install_dir: $!";
        return 0;
    }
    ($basename) = fileparse($current_package{'CODEBASE'});
    # CODEBASE is a URL
    if ($current_package{'CODEBASE'} =~ m@^...*://@i) {
        my $status;
        $status = LWP::Simple::getstore($current_package{'CODEBASE'}, "$install_dir/$basename");
        if ($status < 200 || $status > 299) {
            $PPM::PPMERR = "Read of $current_package{'CODEBASE'} failed";
            return 0;
        }
    }
    # CODEBASE is a full pathname
    elsif (-f $current_package{'CODEBASE'}) {
        copy($current_package{'CODEBASE'}, "$install_dir/$basename");
    }
    # CODEBASE is relative to the directory location of the PPD
    elsif (-f "$path/$current_package{'CODEBASE'}") {
        copy("$path/$current_package{'CODEBASE'}", "$install_dir/$basename");
    }
    # CODEBASE is relative to the URL location of the PPD
    else {
        my $status;
        $status = LWP::Simple::getstore("$path/$current_package{'CODEBASE'}", "$install_dir/$basename");
        if ($status < 200 || $status > 299) {
            $PPM::PPMERR = "Read of $path/$current_package{'CODEBASE'} failed";
            return 0;
        }
    }

# is there a more reliable way than this??
# this leaves $inst_root as, e.g., 'd:\perl'.
    my $inst_archlib = $Config{installsitearch};
    my $inst_root = $Config{installbin};
    $inst_root =~ s/\\bin\\*.*$//i;
    my $packlist = "$Config{installsitearch}/auto/$current_package{'NAME'}/.packlist";
    my $cwd = getcwd();
    chdir($install_dir);

    my $tar;
    if ($basename =~ /\.gz$/i) {
        $tar = Archive::Tar->new($basename,1);
    }
    else {
        $tar = Archive::Tar->new($basename,0);
    }
    $tar->extract($tar->list_files);
    $basename =~ /(.*).tar/i;
    chdir($1);
    # copied from ExtUtils::Install
    my $INST_LIB = MM->catdir(MM->curdir,"blib","lib");
    my $INST_ARCHLIB = MM->catdir(MM->curdir,"blib","arch");
    my $INST_BIN = MM->catdir(MM->curdir,'blib','bin');
    my $INST_SCRIPT = MM->catdir(MM->curdir,'blib','script');
    my $INST_MAN1DIR = MM->catdir(MM->curdir,'blib','man1');
    my $INST_MAN3DIR = MM->catdir(MM->curdir,'blib','man3');
    my $INST_HTMLDIR = MM->catdir(MM->curdir,'blib','html');
    my $INST_HTMLHELPDIR = MM->catdir(MM->curdir,'blib','htmlhelp');

	my ($inst_lib, $inst_bin, $inst_script, $inst_man1dir, $inst_man3dir, $inst_htmldir, $inst_htmlhelpdir);
	# PPM upgrade has to be done differently; needs to go into 'privlib'
	if ($current_package{'NAME'} eq 'ppm' || $current_package{'NAME'} eq 'PPM') {
	    $packlist = "$Config{archlibexp}/auto/$current_package{'NAME'}/.packlist";
		$inst_archlib = $Config{archlibexp};
    	$inst_lib = $Config{installprivlib};
    	$inst_bin = $Config{installbin};
	    $inst_script = $Config{installscript};
	    $inst_man1dir = $Config{installman1dir};
	    $inst_man3dir = $Config{installman3dir};
        $inst_htmldir = $Config{installhtmldir};
        $inst_htmlhelpdir = $Config{installhtmlhelpdir};
	}
	else {
    	$inst_lib = $Config{installsitelib};
    	$inst_bin = $Config{installbin};
	    $inst_script = $Config{installscript};
	    $inst_man1dir = $Config{installman1dir};
	    $inst_man3dir = $Config{installman3dir};
        $inst_htmldir = $Config{installhtmldir};
        $inst_htmlhelpdir = $Config{installhtmlhelpdir};
	    if (defined $root || defined $current_root) {
	        $root = (defined $root ? $root : $current_root);
	        if ($root ne $inst_root) {
	            if ($packlist =~ /\\lib\\(.*)/) {
	                $packlist = "$root\\lib\\$1";
	            }
	            if ($inst_lib =~ /\\lib\\*(.*)/) {
	                $inst_lib = "$root\\lib\\$1";
	            }
	            if ($inst_archlib =~ /\\site\\*(.*)/) {
	                $inst_archlib = "$root\\site\\$1";
	            }
	            $inst_bin =~ s/\Q$inst_root/$root\E/i;
	            $inst_script =~ s/\Q$inst_root/$root\E/i;
	            $inst_man1dir =~ s/\Q$inst_root/$root\E/i;
	            $inst_man3dir =~ s/\Q$inst_root/$root\E/i;
	            $inst_root = $root;
	        }
	    }
	}
    ExtUtils::Install::install({
        "read" => $packlist, "write" => $packlist,
        $INST_LIB => $inst_lib, $INST_ARCHLIB => $inst_archlib,
        $INST_BIN => $inst_bin, $INST_SCRIPT => $inst_script,
        $INST_MAN1DIR => $inst_man1dir, $INST_MAN3DIR => $inst_man3dir,
        $INST_HTMLDIR => $inst_htmldir, $INST_HTMLHELPDIR => $inst_htmlhelpdir},0,0,0);

    HtmlHelp::MakePerlHtmlIndexCaller();

    if (defined $current_package{'INSTALL_SCRIPT'}) {
        run_script("script" => $current_package{'INSTALL_SCRIPT'}, 
                   "scriptHREF" => $current_package{'INSTALL_HREF'},
                   "exec" => $current_package{'INSTALL_EXEC'},
                   "inst_root" => $inst_root, "inst_archlib" => $inst_archlib);
    }

    chdir($cwd);

# ask to store this location as default for this package?
    PPMdat_add_package($path, $packlist, $inst_root);
    # if 'install.ppm' exists, don't remove; system()
    # has probably not finished with it yet.
    if ($Clean eq "Yes" && !-f "$install_dir/install.ppm") {
        File::Path::rmtree($install_dir,0,0);
    }
    reread_config();

    return 1;
}

# Returns a hash with key $location, and elements of arrays of package names.
# Uses '%repositories' if $location is not specified.
sub RepositoryPackages
{
    my (%argv) = @_;
    my ($arg, $location, %ppds);
    foreach $arg (keys %argv) {
        if ($arg eq 'location') { $location = $argv{$arg}; }
    }

    if (defined $location) {
        @{$ppds{$location}} = list_available("location" => $location);
    }
    else {
        read_config();  # need repositories
        foreach $_ (keys %repositories) {
            $location = $repositories{$_};
            @{$ppds{$location}} = list_available("location" => $location);           
        }
    }

    return %ppds;
}

sub RepositoryPackageProperties
{
    my (%argv) = @_;
    my ($arg, $package, $location, $PPDfile);
    foreach $arg (keys %argv) {
        if ($arg eq 'package') { $package = $argv{$arg}; }
        if ($arg eq 'location') { $location = $argv{$arg}; }
    }
    
    read_config();
    if (!defined($PPDfile = locatePPDfile($package, $location))) {
        $PPM::PPMERR = "Could not locate a PPD file for package $package";
        return undef;
    }
    my %PPD = readPPDfile($PPDfile);
    parsePPD(%PPD);
    
    my (%ret_hash, $dep);
    $ret_hash{'NAME'} = $current_package{'NAME'};
    $ret_hash{'TITLE'} = $current_package{'TITLE'};
    $ret_hash{'AUTHOR'} = $current_package{'AUTHOR'};
    $ret_hash{'VERSION'} = $current_package{'VERSION'};
    $ret_hash{'ABSTRACT'} = $current_package{'ABSTRACT'};
    $ret_hash{'PERLCORE_VER'} = $current_package{'PERLCORE_VER'};
    foreach $dep (@{$current_package{'DEPEND'}}) {
        push @{$ret_hash{'DEPEND'}}, $dep;
    }
    
    return %ret_hash;
}

# Returns 1 on success, 0 and sets $PPMERR on failure.
sub RemovePackage
{
    my (%argv) = @_;
    my ($arg, $package, $force);
    foreach $arg (keys %argv) {
        if ($arg eq 'package') { $package = $argv{$arg}; }
        if ($arg eq 'force') { $force = $argv{$arg}; }
    }
    my %PPD;

    read_config();
    if (!defined $installed_packages{$package}) {
        my $pattern = $package;
        undef $package;
        # Do another lookup, ignoring case
        foreach $_ (keys %installed_packages) {
            if (/^$pattern$/i) {
                $package = $_;
                last;
            }
        }
        if (!defined $package) {
            $PPM::PPMERR = "Package '$pattern' has not been installed by PPM";
            return 0;
        }
    }
    
    # Don't let them remove PPM itself, libnet, Archive-Tar, etc.
    # but we can force removal if we're upgrading
    unless (defined $force) {
        foreach (@required_packages) {
            if ($_ eq $package) {
                $PPM::PPMERR = "Package '$package' is required by PPM and cannot be removed";
                return 0;
            }
        }
    }
    
    my $install_dir = $build_dir . "/" . $package;
    %PPD = %{ $installed_packages{$package}{'INST_PPD'} };
    parsePPD(%PPD);
    my $cwd = getcwd();
    if (defined $current_package{'UNINSTALL_SCRIPT'}) {
        if (!chdir($install_dir)) {
            $PPM::PPMERR = "Could not chdir() to $install_dir: $!";
            return 0;
        }
        run_script("script" => $current_package{'UNINSTALL_SCRIPT'}, 
                   "scriptHREF" => $current_package{'UNINSTALL_HREF'},
                   "exec" => $current_package{'UNINSTALL_EXEC'});
        chdir($cwd);
    }
    else {
        if (-f $installed_packages{$package}{'INST_PACKLIST'}) {
            ExtUtils::Install::uninstall("$installed_packages{$package}{'INST_PACKLIST'}", 0, 0);
        }
    }

    File::Path::rmtree($install_dir,0,0);
    PPMdat_remove_package($package);
    # Rebuild the HTML Index
    HtmlHelp::MakePerlHtmlIndexCaller();
    reread_config();
    return 1;
}

# returns "0" if package is up-to-date; "1" if an upgrade is available;
# undef and sets $PPMERR on error; and the new VERSION string if a package
# was upgraded.
sub VerifyPackage
{
    my (%argv) = @_;
    my ($arg, $package, $location, $upgrade);
    foreach $arg (keys %argv) {
        if ($arg eq 'package') { $package = $argv{$arg}; }
        if ($arg eq 'location') { $location = $argv{$arg}; }
        if ($arg eq 'upgrade') { $upgrade = $argv{$arg}; }
    }

    my ($installedPPDfile, $comparePPDfile, %installedPPD, %comparePPD);

    read_config();

    if (!defined $installed_packages{$package}) {
        $PPM::PPMERR = "Package '$package' has not been installed by PPM";
        return undef;
    }
    
    %installedPPD = %{ $installed_packages{$package}{'INST_PPD'} };

    if (!defined($comparePPDfile = locatePPDfile($package, $location))) {
        $PPM::PPMERR = "Could not locate a PPD file for $package";
        return undef;
    }
    %comparePPD = readPPDfile($comparePPDfile);

    parsePPD(%installedPPD);
    my ($inst_version) = $current_package{'VERSION'};
    my ($inst_major, $inst_minor, 
        $inst_patch1, $inst_patch2) = split (',', $inst_version); 
    my ($inst_root) = $installed_packages{$package}{'INST_ROOT'};
    parsePPD(%comparePPD);
    my ($comp_version) = $current_package{'VERSION'};
    my ($comp_major, $comp_minor, 
        $comp_patch1, $comp_patch2) = split (',', $comp_version); 

    if ($comp_major > $inst_major ||
        ($comp_major == $inst_major && $comp_minor > $inst_minor) ||
        ($comp_major == $inst_major && $comp_minor == $inst_minor &&
         $comp_patch1 > $inst_patch1) ||
        ($comp_major == $inst_major && $comp_minor == $inst_minor &&
         $comp_patch1 == $inst_patch1 && $comp_patch2 > $inst_patch2)) {
        if ($upgrade) {
            if (!defined $location) {
            # need to remember the $location, because once we remove the
            # package, it's unavailable.
                $location = $installed_packages{$package}{'LOCATION'};
            }
            RemovePackage("package" => $package, "force" => 1);
            InstallPackage("package" => $package, "location" => $location, "root" => $inst_root);
            return $comp_version;
        }
        return '1';
    }
    else {
        # package is up to date
        return '0';
    }
}

# Changes where the packages are installed.
# Returns previous root on success, undef and sets $PPMERR on failure.
sub chroot
{
    my (%argv) = @_;
    my ($arg, $location, $previous_root);
    foreach $arg (keys %argv) {
        if ($arg eq 'location') { $location = $argv{$arg}; }
    }

    if (!-d $location) {
        $PPM::PPMERR = "'$location' does not exist.\n";
        return undef;
    }

    if (!defined $orig_root) {
        $orig_root = $Config{installbin};
        $orig_root =~ s/bin.*$//i;
        chop $orig_root;
        $current_root = $orig_root;
    }
# mjn: move this to front-end?
    $previous_root = $current_root;
    $current_root = $location;
    return $previous_root;
}

sub QueryInstalledPackages
{
    my (%argv) = @_;
    my ($searchRE, $searchtag, $ignorecase, $package, %ret_hash);
    $PPM::PPMERR = undef;
    my ($arg);
    foreach $arg (keys %argv) {
        if ($arg eq 'searchRE' && defined $argv{$arg}) {
            $searchRE = $argv{$arg};
            eval { $searchRE =~ /$searchRE/ };
            if ($@) {
                $PPM::PPMERR = "'$searchRE': invalid regular expression.";
                return ();
            }
        }
        if ($arg eq 'searchtag' && (defined $argv{$arg})) { $searchtag = uc($argv{$arg}); }
        if ($arg eq 'ignorecase') { $ignorecase = $argv{$arg}; }
    }
    if (!defined $ignorecase) {
        $ignorecase = $Ignorecase;
    }

    read_config();
    foreach $package (keys %installed_packages) {
        my $results;
        if (defined $searchtag) {
            my %Package = %{ $installed_packages{$package} };
            parsePPD(%{ $Package{'INST_PPD'} } );
            $results = $current_package{$searchtag};
        }
        else {
            $results = $package;
        }
        if (!defined $searchRE) {
            $ret_hash{$package} = $results;
        }
        elsif ($results =~ /$searchRE/) {
            $ret_hash{$package} = $results;
        }
        elsif ($ignorecase eq "Yes" && ($results =~ /$searchRE/i)) {
            $ret_hash{$package} = $results;
        }
    }

    return %ret_hash;
}

# Returns the matched string on success, "" on no match, and undef
# on error.
sub QueryPPD
{
    my (%argv) = @_;
    my ($location, $searchRE, $searchtag, $ignorecase, $package);
    my ($arg, $PPDfile, $string);
    foreach $arg (keys %argv) {
        if ($arg eq 'location') { $location = $argv{$arg}; }
        if ($arg eq 'searchRE' && defined $argv{$arg}) {
            $searchRE = $argv{$arg};
            eval { $searchRE =~ /$searchRE/ };
            if ($@) {
                $PPM::PPMERR = "'$searchRE': invalid regular expression.";
                return undef;
            }
        }
        if ($arg eq 'searchtag') { $searchtag = $argv{$arg}; }
        if ($arg eq 'ignorecase') { $ignorecase = $argv{$arg}; }
        if ($arg eq 'package') { $package = $argv{$arg}; }
    }
    if (!defined $ignorecase) {
        $ignorecase = $Ignorecase;
    }

    if (!$location) {
        read_config();
    }

    if (!defined($PPDfile = locatePPDfile($package, $location))) {
        $PPM::PPMERR = "Could not locate a PPD file for package $package";
        return undef;
    }
    my %PPD = readPPDfile($PPDfile);

    parsePPD(%PPD);

    my $retval = "";

    if ($searchtag eq 'abstract') {
        $string = $current_package{'ABSTRACT'}
    }
    elsif ($searchtag eq 'author') {
        $string = $current_package{'AUTHOR'}
    }
    elsif ($searchtag eq 'title') {
        $string = $current_package{'TITLE'}
    }

    if (!$searchRE) {
        $retval = $string;
    }
    elsif ($ignorecase eq "Yes") {
        if ($string =~ /$searchRE/i) {
            $retval = $string;
        }
    }
    elsif ($string =~ /$searchRE/) {
        $retval = $string;
    }

    return $retval;
}

#
# Internal subs
#

sub save_options
{
    read_config();
    if (!open(DAT, "<$PPM::PPMdat")) {
        $PPM::PPMERR = "open of $PPM::PPMdat failed: $!\n";
        return 1;
    }
    my @contents = <DAT>;
    close DAT;
    if (!open(DAT, ">$PPM::PPMdat")) {
        $PPM::PPMERR = "open of $PPM::PPMdat failed: $!\n";
        return 1;
    }

    my $i = 0;
    my $line = $contents[$i];
    while ($line) {
        if ($line =~ /^<OPTIONS.*>$/) {
            # found the options           
            # Save the repositories first.
            foreach $_ (keys %repositories) {
                print DAT "<REPOSITORY NAME=\"$_\" LOCATION=\"$repositories{$_}\" />\n";
            }
            print DAT "<PPM_PRECIOUS>";
            foreach (@required_packages) {
                print DAT "$_;"
            }
            print DAT "</PPM_PRECIOUS>\n";
            print DAT "<OPTIONS IGNORECASE=\"$Ignorecase\" CLEAN=\"$Clean\" CONFIRM=\"$Confirm\" FORCE_INSTALL=\"$Force_install\" ROOT=\"$Root\" BUILDDIR=\"$build_dir\" MORE=\"$More\" />\n";
            # write the rest of the file.
            $line = $contents[++$i];
            while ($line) {
                print DAT $line;
                $line = $contents[++$i];
            }
            last;
        }
        else {
            # repositories will be saved with the rest of the options.
            if ($line !~ /^<REPOSITORY/) {
                print DAT $line;
            }
            $line = $contents[++$i];
        }
    }

    close(DAT);
}

# Returns a sorted array of packages with PPDs available from $location.
# Sets PPM::PPMERR and returns undef on error.
sub list_available
{
    my (%argv) = @_;
    my ($arg, $location, @ppds);
    foreach $arg (keys %argv) {
        if ($arg eq 'location') { $location = $argv{$arg}; }
    }

    if ($location =~ /^file:\/\/.*\|/i) {
        # $location is a local directory, let's avoid LWP by changing
        # it to a pathname.
        $location =~ s@^file://@@i;
        $location =~ s@^localhost/@@i;
        $location =~ s@\|@:@;
    }

	# URL in UNC notation
    if ($location =~ /^file:\/\/\/\//i) {
		$location =~ s@^file://@@i;
	}
	
    # directory or UNC    
    if (-d $location || $location =~ /^\\\\/ || $location =~ /^\/\//) {
        opendir(PPDDIR, $location) or return undef;
        my ($file);
        @ppds = grep { /\.ppd$/i && -f "$location/$_" } readdir(PPDDIR);
        foreach $file (@ppds) {
            $file =~ s/\.ppd//i;
        }
    }
    elsif ($location =~ m@^...*://@i) {
        my $doc = read_href("href" => $location, "request" => 'GET');
        if (!defined $doc) {
            return undef;
        }

        if ($doc =~ /^<head><title>/) {
            # read an IIS format directory listing
            @ppds = grep { /\.ppd/i } split('<br>', $doc);
            my $file;
            foreach $file (@ppds) {
                $file =~ s/\.ppd<.*$//is;
                $file =~ s@.*>@@i;
            }
        }
        elsif ($doc =~ /<BODY BGCOLOR=FFFFFF>\n\n<form name=VPMform/s) {
            # read output of default.prk over an HTTP connection
            @ppds = grep { /^<!--Key:.*-->$/ } split('\n', $doc);
            my $file;
            foreach $file (@ppds) {
                if ($file =~ /^<!--Key:(.*)-->$/) {
                    $file = $1;
                }
            }
        }
        else {
            # read an Apache (?) format directory listing
            @ppds = grep { /\.ppd/i } split('\n', $doc);
            my $file;
            foreach $file (@ppds) {
                $file =~ s/\.ppd\".*$//is;
                $file =~ s@^<A HREF=\"@@i;
            }
        }
    }
    return sort @ppds;
}

sub read_href
{
    my (%argv) = @_;
    my ($arg, $href, $request, $proxy_user, $proxy_pass);
    foreach $arg (keys %argv) {
        if ($arg eq 'href') { $href = $argv{$arg}; }
        if ($arg eq 'request') { $request = $argv{$arg}; }
    }

    my $ua = new LWP::UserAgent;
    $ua->agent("$0/0.1 " . $ua->agent);
    if (defined $ENV{HTTP_proxy}) {
        $proxy_user = $ENV{HTTP_proxy_user};
        $proxy_pass = $ENV{HTTP_proxy_pass};
        $ua->env_proxy;
    }
    my $req = new HTTP::Request $request => $href;
    if (defined $proxy_user && defined $proxy_pass) {
        $req->proxy_authorization_basic("$proxy_user", "$proxy_pass");
    }

    # send request
    my $res = $ua->request($req);

    # check the outcome
    if ($res->is_success) {
        return $res->content;
    } else {
        $PPM::PPMERR = "Error reading $href: " . $res->code . " " . $res->message . "\n";
        return undef;
    }
}

sub reread_config
{
    %current_package = ();
    %installed_packages = ();
    $init = 0;
    read_config();
}

# returns 0 on success, 1 and sets $PPMERR on error.
sub PPMdat_add_package
{
    my ($location, $packlist, $inst_root) = @_;
    my $package = $current_package{'NAME'};
    my $time_str = localtime;

    if (defined $installed_packages{$package} ) {
        # remove the existing entry for this package.
        PPMdat_remove_package($package);
    }

    if(!open(DAT, ">>$PPM::PPMdat")) {
        $PPM::PPMERR =  "open of $PPM::PPMdat failed: $!\n";
        return 1;
    }
    print DAT "<PACKAGE NAME=\"$current_package{'NAME'}\">\n" .
              (defined ($location) ? "\t<LOCATION>$location</LOCATION>\n" : "") .
              "\t<INST_PACKLIST>$packlist</INST_PACKLIST>\n" .
              "\t<INST_ROOT>$inst_root</INST_ROOT>\n" .
              "\t<INST_DATE>$time_str</INST_DATE>\n" .
              "\t<INST_PPD>\n" .
              "\t\t<SOFTPKG NAME=\"$current_package{'NAME'}\" VERSION=\"$current_package{'VERSION'}\">\n" .
              (defined $current_package{'TITLE'} ? "\t\t<TITLE>$current_package{'TITLE'}</TITLE>\n" : "") .
              (defined $current_package{'ABSTRACT'} ? "\t\t<ABSTRACT>$current_package{'ABSTRACT'}</ABSTRACT>\n" : "") .
              (defined $current_package{'AUTHOR'} ? "\t\t<AUTHOR>$current_package{'AUTHOR'}</AUTHOR>\n" : "") .
              (defined $current_package{'LICENSE'} ? "\t\t<LICENSE HREF=\"$current_package{'LICENSE'}\" />\n" : "") .
              "\t\t<IMPLEMENTATION>\n" .
              (defined $current_package{'PERLCORE_VER'} ? "\t\t\t<PERLCORE VERSION=\"$current_package{'PERLCORE_VER'}\" />\n" : "");
              
    foreach $_ (@{$current_package{'DEPEND'}}) {
        print DAT "\t\t\t<DEPENDENCY NAME=\"$_\" />\n";
    }

    print DAT "\t\t\t<CODEBASE HREF=\"$current_package{'CODEBASE'}\" />\n" .
              "\t\t\t<INSTALL " .
              (defined $current_package{'INSTALL_EXEC'} ? "EXEC=\"$current_package{'INSTALL_EXEC'}\"" : "") .
              (defined $current_package{'INSTALL_HREF'} ? "HREF=\"$current_package{'INSTALL_HREF'}\">\n" : ">\n") .
              (defined $current_package{'INSTALL_SCRIPT'} ? "\t\t\t\t$current_package{'INSTALL_SCRIPT'};\n" : "") .
              "\t\t\t</INSTALL>\n" .
              "\t\t\t<UNINSTALL " .
              (defined $current_package{'UNINSTALL_EXEC'} ? "EXEC=\"$current_package{'UNINSTALL_EXEC'}\"" : "") .
              (defined $current_package{'UNINSTALL_HREF'} ? "HREF=\"$current_package{'UNINSTALL_HREF'}\">\n" : ">\n") .
              (defined $current_package{'UNINSTALL_SCRIPT'} ? "\t\t\t\t$current_package{'UNINSTALL_SCRIPT'};\n" : "") .
              "\t\t\t</UNINSTALL>\n" .
              "\t\t</IMPLEMENTATION>\n" .
              "\t\t</SOFTPKG>\n" .
              "\t</INST_PPD>\n" .
              "</PACKAGE>\n";

    close(DAT);
    return 0;
}

# returns 0 on success, 1 and sets $PPMERR on error.
sub PPMdat_remove_package
{
my ($package) = @_;

    if (!open(DAT, "<$PPM::PPMdat")) {
        $PPM::PPMERR = "open of $PPM::PPMdat failed: $!\n";
        return 1;
    }
    my @contents = <DAT>;
    close DAT;
    if (!open(DAT, ">$PPM::PPMdat")) {
        $PPM::PPMERR = "open of $PPM::PPMdat failed: $!\n";
        return 1;
    }

    # there's gotta be a nicer way to do this...
    my $i = 0;
    my $line = $contents[$i];
    while ($line) {
        if ($line =~ /^<PACKAGE NAME="$package"/) {
            # found the package
            $line = $contents[++$i];
            while ($line) {
                # skip lines until its entry ends
                if ($line =~ /^<\/PACKAGE>.*$/) {
                    # we removed it, write the rest of the file
                    $line = $contents[++$i];
                    while ($line) {
                        print DAT $line;
                        $line = $contents[++$i];
                    }
                    last;
                }
                $line = $contents[++$i];
            }
        }
        else {
            print DAT $line;
            $line = $contents[++$i];
        }
    }

    close(DAT);

    return 0;
}

# Run $script using system().  If $scriptHREF is specified, its contents are 
# used as the script.  If $exec is specified, the script is saved to a
# temporary file and executed by $exec.
sub run_script
{
    my (%argv) = @_;
    my ($arg, $script, $scriptHREF, $exec, $inst_root, $inst_archlib);
    foreach $arg (keys %argv) {
        if ($arg eq 'script') { $script = $argv{$arg}; }
        if ($arg eq 'scriptHREF') { $scriptHREF = $argv{$arg}; }
        if ($arg eq 'exec') { $exec = $argv{$arg}; }
        if ($arg eq 'inst_root') { $inst_root = $argv{$arg}; }
        if ($arg eq 'inst_archlib') { $inst_archlib = $argv{$arg}; }
    }

    my (@commands, $tmpname);

    if ($scriptHREF) {
        if ($exec) {
            # store in a temp file.
            $tmpname = $build_dir . "/PPM-" . time();
            LWP::Simple::getstore($scriptHREF, $tmpname);
        }
        else {
            my $doc = LWP::Simple::get $scriptHREF;
            if (!defined $doc) {
                print $PPM::PPMERR;
            }
            @commands = split("\n", $doc);
            if (!defined $commands[0]) {
                print $PPM::PPMERR;
                return 0;
            }
        }
    }
    else {
        if (-f $script) {
            $tmpname = $script;
        }
        else {
            # change any escaped chars
            $script =~ s/&lt;/</gi;
            $script =~ s/&gt;/>/gi;

            @commands = split(';;', $script);
            if ($exec) {
                my $command;

                # store in a temp file.
                $tmpname = $build_dir . "/PPM-" . time();
                open(TMP, ">$tmpname");
                foreach $command (@commands) {
                    print TMP "$command\n";
                }
                close(TMP);
            }
        }
    }
    $ENV{'PPM_INSTROOT'} = $inst_root;
    $ENV{'PPM_INSTARCHLIB'} = $inst_archlib;
    if ($exec) {
        system("start $exec $tmpname");
    }
    else {
        my $command;
        for $command (@commands) {
            system($command);
        }
    }
}

sub parsePPD
{
    my %PPD = @_;
    
    my ($Package);
    my ($PackageName, $PackageVer, $PackageTitle, $PackageAbstract, $PackageAuthor, $PackageLicenseHREF);

    %current_package = ();
  
    my @Elems = keys( %{ $PPD{elem} } );

    foreach $Package (@Elems) {
        if ($Package eq 'SOFTPKG') {
            my $index = 0;

            while (defined %{ $PPD{elem}{$Package}[$index] } ) {
                my %PackageHash = %{ $PPD{elem}{$Package}[$index] };
                my ($Attr, $Element);

                # We're interested in the 'NAME' and 'VERSION' attributes.
                my @Attrs = keys( %{ $PackageHash{attr} } );
                foreach $Attr (@Attrs) {
                    if ($Attr eq 'NAME') {
                        $PackageName = $PackageHash{attr}{'NAME'};
                    }
                    elsif ($Attr eq 'VERSION') {
                        $PackageVer = $PackageHash{attr}{'VERSION'};
                    }
                }

                my @PackageElems = keys( %{ $PackageHash{elem} } );
                foreach $Element (@PackageElems) {
                    my %ElementsHash = %{ $PackageHash{elem}{$Element}[0] };
                    if ($Element eq 'TITLE') {
                        $PackageTitle = $ElementsHash{ data };
                    }
                    elsif ($Element eq 'ABSTRACT') {
                        $PackageAbstract = $ElementsHash{ data };
                    }
                    elsif ($Element eq 'LICENSE') {
                        my @Attrs = keys( %{ $ElementsHash{attr} } );
                        my $Attr;
                        foreach $Attr (@Attrs) {
                            if ($Attr eq 'HREF') {
                                $PackageLicenseHREF = $ElementsHash{attr}{'HREF'};
                            }
                        }
                    }
                    elsif ($Element eq 'IMPLEMENTATION') {
                        if (implementation( %{ $ElementsHash{elem} } )) {
                            # identified the implementation for our platform
                            last;
                        }
                    }
                    elsif ($Element eq 'AUTHOR') {
                        $PackageAuthor = $ElementsHash{ data };
                    }
                }
                $index++;
            }
            defined $PackageName && ($current_package{'NAME'} = $PackageName);
            defined $PackageVer && ($current_package{'VERSION'} = $PackageVer);
            defined $PackageTitle && ($current_package{'TITLE'} = $PackageTitle);
            defined $PackageAbstract && ($current_package{'ABSTRACT'} = $PackageAbstract);
            defined $PackageAuthor && ($current_package{'AUTHOR'} = $PackageAuthor);
            defined $PackageLicenseHREF && ($current_package{'LICENSE'} = $PackageLicenseHREF);
        }
        else {
        }

        if ($Debug & 2) { 
            if (%current_package) { 
                my $Elem;
                my @Elems = keys( %current_package );
                print "Read a PPD...\n";
                foreach $Elem (@Elems) {
                    print "\t$Elem: $current_package{$Elem}\n";
                }
            }
        }

    }
}

# Tests the passed IMPLEMENTATION for suitability on the current platform.
# Fills in the CODEBASE, INSTALL_HREF, INSTALL_EXEC, INSTALL_SCRIPT,
# UNINSTALL_HREF, UNINSTALL_EXEC, UNINSTALL_SCRIPT and DEPEND keys of
# %current_package.  Returns 1 on success, 0 otherwise.
sub implementation
{
    my %ElementsHash = @_;
    my ($ImplProcessor, $ImplOS, $ImplLanguage, $ImplCodebase, $ImplInstallHREF,
        $ImplInstallExec, $ImplInstallScript, $ImplUninstallHREF,
        $ImplUninstallExec, $ImplUninstallScript, @ImplDepend, $ImplPerlCoreVer);
    my @ImplElements = keys( %ElementsHash );
    my $ImplElement;

    foreach $ImplElement (@ImplElements) {
        my %ImplHash = %{ $ElementsHash{$ImplElement}[0] };
        if ($ImplElement eq 'PROCESSOR') {
            my @Attrs = keys( %{ $ImplHash{attr} } );
            my $Attr;
            foreach $Attr (@Attrs) {
                if ($Attr eq 'VALUE') {
                    $ImplProcessor = $ImplHash{attr}{'VALUE'};
                }
            }
        }
        elsif ($ImplElement eq 'OS') {
            my @Attrs = keys( %{ $ImplHash{attr} } );
            my $Attr;
            foreach $Attr (@Attrs) {
# need to get {data} here
                if ($Attr eq 'VALUE') {
                    $ImplOS = $ImplHash{attr}{'VALUE'};
                }
            }
        }
        elsif ($ImplElement eq 'LANGUAGE') {
            my @Attrs = keys( %{ $ImplHash{attr} } );
            my $Attr;
            foreach $Attr (@Attrs) {
                if ($Attr eq 'VALUE') {
                    if ($ImplLanguage && $ImplLanguage ne $LANGUAGE) {
                        $ImplLanguage = $ImplHash{attr}{'VALUE'};
                    }
                }
            }
        }
        elsif ($ImplElement eq 'CODEBASE') {
            my @Attrs = keys( %{ $ImplHash{attr} } );
            my $Attr;
            foreach $Attr (@Attrs) {
                if ($Attr eq 'HREF') {
                    $ImplCodebase = $ImplHash{attr}{'HREF'};
                }
            }
        }
        elsif ($ImplElement eq 'PERLCORE') {
            my @Attrs = keys( %{ $ImplHash{attr} } );
            my $Attr;
            foreach $Attr (@Attrs) {
                if ($Attr eq 'VERSION') {
                    $ImplPerlCoreVer = $ImplHash{attr}{'VERSION'};
                }
            }
        }
        elsif ($ImplElement eq 'DEPENDENCY') {
            foreach $_ (@{ $ElementsHash{$ImplElement}}) {
                my %ImplHash = %{ $_ };
                my @Attrs = keys( %{ $ImplHash{attr} } );
                my $Attr;
                foreach $Attr (@Attrs) {
                    if ($Attr eq 'NAME') {
                        push (@ImplDepend, $ImplHash{attr}{'NAME'});
                    }
                }
            }
        }
        elsif ($ImplElement eq 'INSTALL') {
            my @Attrs = keys( %{ $ImplHash{attr} } );
            my $Attr;
            foreach $Attr (@Attrs) {
                if ($Attr eq 'HREF') {
                    $ImplInstallHREF = $ImplHash{attr}{'HREF'};
                }
                elsif ($Attr eq 'EXEC') {
                    $ImplInstallExec = $ImplHash{attr}{'EXEC'};
                }
            }
            $ImplInstallScript = $ImplHash{data};
        }
        elsif ($ImplElement eq 'UNINSTALL') {
            my @Attrs = keys( %{ $ImplHash{attr} } );
            my $Attr;
            foreach $Attr (@Attrs) {
                if ($Attr eq 'HREF') {
                    $ImplUninstallHREF = $ImplHash{attr}{'HREF'};
                }
                elsif ($Attr eq 'EXEC') {
                    $ImplUninstallExec = $ImplHash{attr}{'EXEC'};
                }
            }
            $ImplUninstallScript = $ImplHash{data};
        }
    }
    
    if (defined($ImplProcessor) && $ImplProcessor ne $CPU) {
            # no match
            return 0;
    }
    elsif (defined($ImplLanguage) && $ImplLanguage ne $LANGUAGE) {
            # no match
            return 0;
    }
    elsif (defined($ImplOS) && $ImplOS ne $OS_VALUE) {
            # no match
            return 0;
    }
    # we've got a suitable implementation
    defined $ImplPerlCoreVer && ($current_package{'PERLCORE_VER'} = $ImplPerlCoreVer);
    defined $ImplCodebase && ($current_package{'CODEBASE'} = $ImplCodebase);
    defined $ImplInstallHREF && ($current_package{'INSTALL_HREF'} = $ImplInstallHREF);
    defined $ImplInstallExec && ($current_package{'INSTALL_EXEC'} = $ImplInstallExec);
    defined $ImplInstallScript && ($current_package{'INSTALL_SCRIPT'} = $ImplInstallScript);
    defined $ImplUninstallHREF && ($current_package{'UNINSTALL_HREF'} = $ImplUninstallHREF);
    defined $ImplUninstallExec && ($current_package{'UNINSTALL_EXEC'} = $ImplUninstallExec);
    defined $ImplUninstallScript && ($current_package{'UNINSTALL_SCRIPT'} = $ImplUninstallScript);
    defined @ImplDepend && (@{$current_package{'DEPEND'}} = @ImplDepend);
    return 1;
}

sub valid_URL_or_file
{
    my ($File) = @_;
    if ($File =~ /^file:\/\/.*\|/i) {
        # $File is a local directory, let's avoid LWP by changing
        # it to a pathname.
        $File =~ s@^file://@@i;
        $File =~ s@^localhost/@@i;
        $File =~ s@\|@:@;
    }
    return 1 if (-f $File);
    return 1 if ($File =~ m@^...*://@i && defined read_href("href" => $File, "request" => 'HEAD'));
    return 0;
}

# Builds a fully qualified pathname or URL to a PPD for $Package.
# If '$location' argument is given, that is used.  Otherwise, the
# '<LOCATION>' tag for a previously installed version is used, and
# if that fails, the default locations are looked at. 
#
# returns undef if it can't find a valid file or URL.
#
sub locatePPDfile
{
    my ($Package, $location) = @_;
    my $PPDfile;
    if (defined($location)) {
        if ($location =~ /[^\/]$/) { $location .= "/"; }
        $PPDfile = $location . $Package . ".ppd";
        if (!valid_URL_or_file($PPDfile)) {
            # not good.
            undef $PPDfile;
        }
    }
    else {
        # Is $Package a filename or URL?
        if (valid_URL_or_file($Package)) {
            $PPDfile = $Package;
        }
        # does the package have a <LOCATION> in $PPM::PPMdat?
        elsif (defined( $installed_packages{$Package} )) {
            $location = $installed_packages{$Package}{'LOCATION'};
            if ($location =~ /[^\/]$/) { $location .= "/"; }
            $PPDfile = $location . $Package . ".ppd";
            if (!valid_URL_or_file($PPDfile)) {
                # not good.
                undef $PPDfile;
            }
        }
        else {
            # No, try the defaults.
            my $location;

            foreach $_ (keys %repositories) {
                $location = $repositories{$_};
                if ($location =~ /[^\/]$/) { $location .= "/"; }
                $PPDfile = $location . $Package . ".ppd";

                if (valid_URL_or_file($PPDfile)) {
                    last;
                }
                undef $PPDfile;
            }
        }
    }

    # return the fully qualified pathname or HREF
    return $PPDfile;
}

# reads and parses $PPDfile, which can be a file or HREF
sub readPPDfile
{
    my ($PPDfile) = @_;
    my (@DATA, $CONTENTS);
    
    if ($PPDfile =~ /^file:\/\/.*\|/i) {
        # $PPDfile is a local directory, let's avoid LWP by changing
        # it to a pathname.
        $PPDfile =~ s@^file://@@i;
        $PPDfile =~ s@^localhost/@@i;
        $PPDfile =~ s@\|@:@;
    }

    # if $PPDfile is an HREF 
    if ($PPDfile =~ m@^...*://@i) {
        if (!defined (@DATA = read_href("href" => $PPDfile, "request" => 'GET'))) {
            return undef;
        }
        $CONTENTS = join('', @DATA);
    } else {
    # else $PPDfile is a regular file
        if (!open (DATAFILE, $PPDfile)) {
            $PPM::PPMERR = "open of $PPDfile failed: $!\n";
            return undef;
        }
        @DATA = <DATAFILE>;
        close(DATAFILE);
        $CONTENTS = join('', @DATA);
    }

    my %PPD = parse_osd( $CONTENTS);
    return %PPD; 
}

# reads and parses the PPM data file $PPM::PPMdat.  Stores config information in
# $PPM_ver, $build_dir, %repositories, $CPU, $OS_VALUE, and $OS_VERSION.
# Stores information about individual packages in the hash %installed_packages.
sub read_config
{
    if ($init) { return; }
    else { $init++; }

    my %PPD = readPPDfile($PPM::PPMdat);
    my @Elems = keys( %{ $PPD{elem} } );
    my ($Elem);
    foreach $Elem (@Elems) {

        my $index = 0;
        while (defined(%{ $PPD{elem}{$Elem}[$index] } )) {
            my ($current_package, $current_location, $current_inst_date,
                $current_inst_root, $current_inst_packlist, @current_inst_ppd);
            my %ConfigHash = %{ $PPD{elem}{$Elem}[$index] };

            if (defined $ConfigHash{data}) {
                if ($Elem eq 'PPM_VER') {
                    $PPM_ver = $ConfigHash{data};
                }
                if ($Elem eq 'PPM_PRECIOUS') {
                    @required_packages = split(';', $ConfigHash{data});
                }
            }
            else {
                if ($Elem eq 'PACKAGE') {
                    $current_package = $ConfigHash{attr}{'NAME'};
                }
                elsif ($Elem eq 'PLATFORM') {
                    $CPU = $ConfigHash{attr}{'CPU'};
                    $OS_VALUE = $ConfigHash{attr}{'OS_VALUE'};
                    $OS_VERSION = $ConfigHash{attr}{'OS_VERSION'};
                    $LANGUAGE = $ConfigHash{attr}{'LANGUAGE'};
                }
                elsif ($Elem eq 'REPOSITORY') {
                    my ($name);
                    $name = $ConfigHash{attr}{'NAME'};
                    $repositories{$name} = $ConfigHash{attr}{'LOCATION'};
                }
                elsif ($Elem eq 'OPTIONS') {
                    $Ignorecase = $ConfigHash{attr}{'IGNORECASE'};
                    $Clean = $ConfigHash{attr}{'CLEAN'};
                    $Confirm = $ConfigHash{attr}{'CONFIRM'};
                    $Force_install = $ConfigHash{attr}{'FORCE_INSTALL'};
                    $Root = $ConfigHash{attr}{'ROOT'};
					$More = $ConfigHash{attr}{'MORE'};
                    if (defined $Root) {
                        PPM::chroot("location" => $Root);
                    }
                    $build_dir = $ConfigHash{attr}{'BUILDDIR'};
                    # strip any trailing separator
                    my $chr = substr($build_dir, -1, 1);
                    if ($chr eq '/' || $chr eq '\\') {
                        chop $build_dir;
                    }                    
                }

                my @Elems = keys( %{ $ConfigHash{elem} } );
                my ($Elem);
                foreach $Elem (@Elems) {
                    my %PackageHash = %{ $ConfigHash{elem}{$Elem}[0] };
                    if (defined $PackageHash{data}) {
                        if ($Elem eq 'LOCATION') {
                            $current_location = $PackageHash{data};
                        }
                        elsif ($Elem eq 'INST_DATE') {
                            $current_inst_date = $PackageHash{data};
                        }
                        elsif ($Elem eq 'INST_ROOT') {
                            $current_inst_root = $PackageHash{data};
                        }
                        elsif ($Elem eq 'INST_PACKLIST') {
                            $current_inst_packlist = $PackageHash{data};
                        }
                    }
                    else {
                        if ($Elem eq 'INST_PPD') {
                            %{ $current_inst_ppd[$index] } = %PackageHash;
                        }
                    }
                }
                if (defined($current_package)) {
                    my %package_details = (LOCATION => $current_location, 
                                           INST_DATE => $current_inst_date,
                                           INST_ROOT => $current_inst_root,
                                           INST_PACKLIST => $current_inst_packlist,
                                           INST_PPD => \%{ $current_inst_ppd[$index] } );

                    %{ $installed_packages{$current_package} } = %package_details;
                }
            }
            $index++;
        }
    }

    if ($Debug & 1) {
        print "This is ppm, version $PPM_ver.\nRepository locations:\n";
        foreach $Elem (keys %repositories) { 
            print "\t$Elem: $repositories{$Elem}\n"
        }
        print "Platform is $OS_VALUE version $OS_VERSION on a $CPU CPU.\n";
        print "Packages will be built in $build_dir\n";
        print "Commands will " . ($Confirm eq "Yes" ? "" : "not ") . "be confirmed.\n";
        print "Temporary files will " . ($Clean eq "Yes" ? "" : "not ") . "be deleted.\n";
        print "Installations will " . ($Clean eq "Yes" ? "" : "not ") . "continue if a dependency cannot be installed.\n";
        print "Screens will " . ($More > 0 ? "pause after each $More lines.\n" : "not pause after the screen is full.\n");
        print "Case-" . ($Ignorecase eq "Yes" ? "in" : "") . "sensitive searches will be performed.\n";
        @Elems = keys( %installed_packages );
        foreach $Elem (@Elems) {
            print "\nFound installed package $Elem, " .
            "installed on $installed_packages{$Elem}{'INST_DATE'}\n" .
            "in directory root $installed_packages{$Elem}{'INST_ROOT'} " .
            "from $installed_packages{$Elem}{'LOCATION'}.\n\n";
        }
    }

}

1;

__END__

=head1 Name

ppm - PPM (Perl Package Management)

=head1 Synopsis

 use PPM;

 PPM::InstallPackage("package" => $package, "location" => $location, "root" => $root);
 PPM::RemovePackage("package" => $package, "force" => $force);
 PPM::VerifyPackage("package" => $package, "location" => $location, "upgrade" => $upgrade);
 PPM::QueryInstalledPackages("searchRE" => $searchRE, "searchtag" => $searchtag, "ignorecase" => $ignorecase);
 PPM::InstalledPackageProperties();
 PPM::QueryPPD("location" => $location, "searchRE" => $searchRE, "searchtag" => $searchtag, "ignorecase" => $ignorecase, "package" => $package);
 
 PPM::ListOfRepositories();
 PPM::RemoveRepository("repository" => $repository, "save" => $save);
 PPM::AddRepository("repository" => $repository, "location" => $location, "save" => $save);
 PPM::RepositoryPackages("location" => $location);
 PPM::RepositoryPackageProperties("package" => $package, "location" => $location);
 
 PPM::GetPPMOptions();
 PPM::SetPPMOptions("options" => %options, "save" => $save);

=head1 Description

PPM is a group of functions intended to simplify the tasks of locating,
installing, upgrading and removing software 'packages'.  It can determine
if the most recent version of a software package is installed on a system,
and can install or upgrade that package from a local or remote host.

PPM uses files containing an extended form of the Open Software
Description (OSD) specification for information about software packages.
These description files, which are written in Extensible Markup
Language (XML) code, are referred to as 'PPD' files.  Information about
OSD can be found at the W3C web site (at the time of this writing,
http://www.w3.org/TR/NOTE-OSD.html).  The extensions to OSD used by PPM
are documented in PPM::ppd.

PPD files for packages are generated from POD files using the pod2ppd
command.

=head1 Usage

=over 4

=item  PPM::InstallPackage("package" => $package, "location" => $location, "root" => $root);

Installs the specified package onto the local system.  'package' may
be a simple package name ('foo'), a pathname (P:\PACKAGES\FOO.PPD) or
a URL (HTTP://www.ActiveState.com/packages/foo.ppd).  In the case of a
simple package name, the function will look for the package's PPD file
at 'location', if provided; otherwise, it will use information stored
in the PPM data file (see 'Files' section below) to locate the PPD file
for the requested package.  The package's files will be installed under
the directory specified in 'root'; if not specified the default value
of 'root' will be used.

The function uses the values stored in the PPM data file to determine the
local operating system, operating system version and CPU type.  If the PPD
for this package contains implementations for different platforms, these
values will be used to determine which one is installed.

InstallPackage() updates the PPM data file with information about the package
installation. It stores a copy of the PPD used for installation, as well
as the location from which this PPD was obtained.  This location will
become the default PPD location for this package.

During an installation, the following actions are performed:

    - the PPD file for the package is read
    - a directory for this package is created in the directory specified in
      <BUILDDIR> in the PPM data file.
    - the file specified with the <CODEBASE> tag in the PPD file is 
      retrieved/copied into the directory created above.
    - if provided, the <INSTALL> script from the PPD is executed in the
      directory created above.
    - if an <INSTALL> script is not provided, the package is assumed to be a
      ready-to-install (binary) Perl module, and the following default actions
      are performed:
        - the package is unarchived in the directory created for this package
        - individual files from the archive are installed in the appropriate
          directories of the local Perl installation.
        - perllocal.pod is updated with the install information. (?)
    - information about the installation is stored in the PPM data file.

=item PPM::RemovePackage("package" => $package, "force" => $force)

Removes the specified package from the system.  Reads the package's PPD
(stored during installation) for removal details.  If 'force' is
specified, even a package required by PPM will be removed (useful
when installing an upgrade).

=item PPM::VerifyPackage("package" => $package, "location" => $location, "upgrade" => $upgrade)

Reads a PPD file for 'package', and compares the currently installed
version of 'package' to the version available according to the PPD.
The PPD file is expected to be on a local directory or remote site
specified either in the PPM data file or in the 'location' argument.
The 'location' argument may be a directory location or a URL.
The 'upgrade' argument forces an upgrade if the installed package is
not up-to-date.

The PPD file for each package will initially be searched for at
'location', and if not found will then be searched for using the
locations specified in the PPM data file.

=item  PPM::QueryInstalledPackages("searchRE" => $searchRE, "searchtag" => $searchtag, "ignorecase" => $ignorecase);

Returns a hash containing information about all installed packages.
By default, a list of all installed packages is returned.  If a regular
expression 'searchRE' is specified, only packages matching it are 
returned.  If 'searchtag' is specified, the pattern match is applied 
to the appropriate tag (e.g., ABSTRACT).

The data comes from the PPM data file, which contains installation
information about each installed package.

=item PPM::InstalledPackageProperties();

Returns a hash with package names as keys, and package properties as
attributes.

=item PPM::QueryPPD("location" => $location, "searchRE" => $searchRE, "searchtag" => $searchtag, "ignorecase" => $ignorecase, "package" => $package);

Searches for 'searchRE' (a regular expression) in the <ABSTRACT>,
<AUTHOR> or <TITLE> tags of the PPD file for 'package' at 'location'.
'location' may be either a remote address or a directory path, and if
it is not provided, the default location as specified in the PPM data
file will be used.  If the 'ignorecase' option is specified, it overrides
the current global case-sensitivity setting.  On success, the matching
string is returned.

=item PPM::RepositoryPackages("location" => $location);

Returns a hash, with 'location' being the key, and arrays of all packages
with package description (PPD) files available at 'location' as its
elements.  'location' may be either a remote address or a directory path.
If 'location' is not specified, the default location as specified in
the PPM data file will be used.

=item PPM::ListOfRepositories();

Returns a hash containing the name of the repository and its location.
These repositories will be searched if an explicit location is not
provided in any function needing to locate a PPD.

=item PPM::RemoveRepository("repository" => $repository, "save" => $save);

Removes the repository named 'repository' from the list of available
repositories.  If 'save' is not specified, the change is for the current
session only.

=item PPM::AddRepository("repository" => $repository, "location" => $location, "save" => $save);

Adds the repository named 'repository' to the list of available repositories.
If 'save' is not specified, the change is for the current session only.

=item PPM::RepositoryPackageProperties("package" => $package, "location" => $location);

Reads the PPD file for 'package', from 'location' or the default repository,
and returns a hash with keys being the various tags from the PPD (e.g.
'ABSTRACT', 'AUTHOR', etc.).

=item PPM::GetPPMOptions();

Returns a hash containing values for all PPM internal options ('IGNORECASE',
'CLEAN', 'CONFIRM', 'ROOT', 'BUILDDIR').

=item PPM::SetPPMOptions("options" => %options, "save" => $save);

Sets internal PPM options as specified in the 'options' hash, which is
expected to be the hash previously returned by a call to GetPPMOptions().

=back

=head1 Examples

=over 4

=item PPM::AddRepository("repository" => 'ActiveState', "location" => "http://www.ActiveState.com/packages", "save" => 1);

Adds a repository to the list of available repositories, and saves it in
the PPM options file.

=item PPM::InstallPackage("package" => 'http://www.ActiveState.com/packages/foo.ppd');

Installs the software package 'foo' based on the information in the PPD
obtained from the specified URL.

=item PPM::VerifyPackage("package" => 'foo', "upgrade" => true)

Compares the currently installed version of the software package 'foo' to
the one available according to the PPD obtained from the package-specific
location provided in the PPM data file, and upgrades to a newer
version if available.  If a location for this specific package is not
given in PPM data file, a default location is searched.

=item PPM::VerifyPackage("package" => 'foo', "location" => 'P:\PACKAGES', "upgrade" => true);

Compares the currently installed version of the software package 'foo'
to the one available according to the PPD obtained from the specified
directory, and upgrades to a newer version if available.

=item PPM::VerifyPackage("package" => 'PerlDB');

Verifies that package 'PerlDB' is up to date, using package locations specified
in the PPM data file.

=item PPM::RepositoryPackages("location" => http://www.ActiveState.com/packages);

Returns a hash keyed on 'location', with its elements being an array of
packages with PPD files available at the specified location.

=item PPM::QueryPPD("location" => 'P:\PACKAGES', "searchRE" => 'ActiveState', "searchtag" => 'author');

Searches the specified location for any package with an <AUTHOR> tag
containing the string 'ActiveState'.  On a successful search, the matching
string is returned.

=item %opts = PPM::GetPPMOptions();

=item $opts{'CONFIRM'} = 'No';

=item PPM::SetPPMOptions("options" => \%opts, "save" => 1);

Sets and saves the value of the option 'CONFIRM' to 'No'.

=back

=head1 Environment variables

=over 4

=item HTTP_proxy

If the environment variable 'HTTP_proxy' is set, then it will
be used as the address of a proxy for accessing the Internet.
If the environment variables 'HTTP_proxy_user' and 'HTTP_proxy_pass'
are set, they will be used as the login and password for the 
proxy server.

=back

=head1 Files

=over 4

=item package.ppd

A description of a software package, in extended Open Software Description
(OSD) format.  More information on this file format can be found in
PPM::ppd.  PPM stores a copy of the PPD it uses to install or upgrade
any software package.

=item ppm.xml - PPM data file.

The XML format file in which PPM stores configuration and package
installation information.  This file is created when PPM is installed,
and under normal circumstances should never require modification other
than by PPM itself.

The file consists of two sections.

=over 4

=item The first section contains a number of required XML tags:

    <PPM_VER>  - A string describing the version of PPM used to create
                 this file.

    <PLATFORM> - A description of the installation platform, consisting of
                 the following three attributes:

        OS_VALUE   - A string describing the local operating system.  This
                     must match the 'osname' value in your Config.pm file.

        OS_VERSION - ???

        CPU        - A description of the CPU of the local system.  The
                     definitive list of possible values is available at the
                     W3C web site (http://www.w3.org), but currently they are:

                         x86 mips alpha ppc sparc 680x0

        LANGUAGE   - A description of the language of the local system.
                     Uses language codes as specified in ISO 639.

    <REPOSITORY> - Specifies a location at which to search for PPM files.
                   It consists of the following attributes:
                   
        NAME     - A name by which the repository will be known,
                   e.g. 'ActiveState'.

        LOCATION - A URL or directory.

    <OPTIONS>  - PPM options, consisting of the following attributes:

        The following 3 attributes control PPM behaviour; they take a value
        of "Yes" or "No".
        
        IGNORECASE - Sets case-sensitive searches.
        CLEAN      - Sets removal of temporary files.
        CONFIRM    - Sets confirmation of installs/removals/upgrades.
        
        
        BUILDDIR   - Directory in which packages will be unpacked before
                     installation.
        ROOT       - Directory under which to install extensions.

These values are initialized when PPM is installed, and under normal
circumstances should never be modified.

=item The second section is manipulated internally by PPM.  It consists of records containing the following XML tags:

    <PACKAGE>   - The parent tag and record delineator.  The name of
                  the package is given as the 'NAME' attribute.

    <LOCATION>  - The location at which to search for updated versions
                  of the PPD file for this package.  LOCATION is the
                  Internet address or directory location of a PPD file
                  for a software package.  The following examples are
                  all valid:

                  <LOCATION>http://http.ActiveState.com/packages</LOCATION>
                  <LOCATION>S:\PACKAGES</LOCATION>
                  <LOCATION>/mnt/server/packages</LOCATION>

    <INST_DATE> - The date and time at which this package was installed by
                  PPM.

    <INST_ROOT> - Directory under which the extension was installed.

    <INST_PPD>  - a copy of the PPD originally used to install this
                  package.

=item Example ppm.dat file

 <PPM_VER>1,0,0,0</PPM_VER>
 <PLATFORM OS_VALUE="MSWin32" OS_VERSION="4,0,0,0" CPU="x86" />
 <REPOSITORY NAME="ActiveState" LOCATION="http://www.ActiveState.com/packages" />
 <OPTIONS IGNORECASE="No" CLEAN="Yes" CONFIRM="Yes" ROOT="c:/perllib" BUILDDIR="c:/temp" />
 
 <PACKAGE NAME="AtExit">
     <LOCATION>g:/packages</LOCATION>
     <INST_PACKLIST>c:/perllib/lib/site/MSWin32-x86/auto/AtExit/.packlist</INST_PACKLIST>
     <INST_ROOT>c:/perllib</INST_ROOT>
     <INST_DATE>Sun Mar  8 02:56:31 1998</INST_DATE>
     <INST_PPD>
         <SOFTPKG NAME="AtExit" VERSION="1,02,0,0">
         <TITLE>AtExit</TITLE>
         <ABSTRACT>Register a subroutine to be invoked at program-exit time.</ABSTRACT>
         <AUTHOR>Brad Appleton (Brad_Appleton-GBDA001@email.mot.com)</AUTHOR>
         <IMPLEMENTATION>
             <CODEBASE HREF="x86/AtExit.tar.gz" />
         </IMPLEMENTATION>
         </SOFTPKG>
     </INST_PPD>
 </PACKAGE>
 <PACKAGE NAME="Term-ANSIColor">
     <LOCATION>i:/repository</LOCATION>
     <INST_PACKLIST>c:/perllib/lib/site/MSWin32-x86/auto/Term-ANSIColor/.packlist</INST_PACKLIST>
     <INST_ROOT>c:/perllib</INST_ROOT>
     <INST_DATE>Sun Mar  8 02:56:41 1998</INST_DATE>
     <INST_PPD>
         <SOFTPKG NAME="Term-ANSIColor" VERSION="1,01,0,0">
         <TITLE>Term-ANSIColor</TITLE>
         <ABSTRACT>Color screen output using ANSI escape sequences</ABSTRACT>
         <AUTHOR>Russ Allbery (rra@stanford.edu) and Zenin (zenin@best.com)</AUTHOR>
         <IMPLEMENTATION>
             <CODEBASE HREF="x86/Term-ANSIColor.tar.gz" />
         </IMPLEMENTATION>
         </SOFTPKG>
     </INST_PPD>
 </PACKAGE>

=back

=cut