our %opt;
our %cfg;   # use cachedir to untar,  $Config{'installsitelib'} for *.packlist

package IPM_InstallPkg;
require Exporter; @ISA = qw(Exporter); @EXPORT = qw(InstallPkg ListInstalledPackages get_package_list RemovePackages MakeTOC);

use strict;
use Config;
use File::Path; # mkpath, rmtree
use Pod::Html;
use Cwd qw(abs_path cwd getcwd);
use IPM_Util;
use File::Basename;
BEGIN {
    # this is to get around warnings generated in ExtUtils::Install in V5.6.1
    local $^W;
    require ExtUtils::Install;
    import ExtUtils::Install;
};


1;




sub InstallPkg
{
    my ($filename) = @_;
    print "Installing package $filename\n" if $opt{'verbose'};

    my $this_platform;
    if ($^O eq "MSWin32") { $this_platform = "Win32"; }
    else { $this_platform = `uname`; chop $this_platform; }
    my $perlpath = $Config{'perlpath'};
    $perlpath = "\"$perlpath\"" if $perlpath =~ / /;    # quote it if it contains spaces

    my $abspath = abspath($filename);
    my $pkgdir = basename($filename);
    $pkgdir =~ s/\.tar\.gz//;
    $pkgdir =~ s/-PKG.*$//;
    my $packlistdir = $Config{'installsitelib'};
    my $packlist = "$packlistdir/$pkgdir.packlist";

    die if !$cfg{'cachedir'};
    chdir($cfg{'cachedir'});      # works even if drive letter is different than current
    mkdir $pkgdir;
    chdir $pkgdir;
    UnTar ($abspath);

    my ($pkg_platform) = $filename =~ /-PKG-(.*)\.tar\.gz/;
    $pkg_platform ||= $opt{'platform'} || $this_platform;

    my $blibdir = ".";
    if ($pkg_platform eq $this_platform && $Config{'installhtmldir'}) {
        # currently true only for only Win32
        # old perl version come with html prebuilt
        _build_html() if (!-d "$blibdir/blib/Html");
    }

    if ($pkg_platform ne $this_platform) {
        # install in foreign platform directory
        # todo change $cfg{'datadir'} to subdir
        print "TODO: Install to foreign plaform, This platform = $this_platform, package platform = $pkg_platform\n";
        return;
    }

    my %copylist = ("$blibdir/blib/lib" => $Config{'installsitelib'},
                    "$blibdir/blib/arch" => $Config{'installsitearch'},
                    "$blibdir/blib/bin" => $Config{'installbin'},
                    "$blibdir/blib/script" => $Config{'installscript'},
                    "$blibdir/blib/Html" => $Config{'installhtmldir'},          # V5.003 Win32 only
                    "$blibdir/blib/HtmlHelp" => $Config{'installhtmlhelpdir'},  # V5.003 Win32 only
                    "$blibdir/blib/man1" => $Config{'installman1dir'},  # Unix only
                    "$blibdir/blib/man3" => $Config{'installman3dir'},  # Unix only
                    "read" => $packlist,
                    "write" => $packlist,
                    );

    my $nono = 0;
    ExtUtils::Install::install(\%copylist, $opt{'verbose'}, $nono);
    # run the install script if there is one
    system("$perlpath $blibdir/install.ppm") if (-e "$blibdir/install.ppm" && !$nono);
    chdir($cfg{'cachedir'});
    rmtree($pkgdir) unless $opt{'noclean'};
    MakeTOC() if (-f "$Config{'installhtmldir'}/perltoc.html"); # does a chdir
}


############################## QUERY ##########################################

sub ListInstalledPackages
{
    my @package_list = get_package_list();
    print "#Installed packages\n";
    print join("\n", @package_list), "\n";
}

sub get_package_list
{
    # return list of *.packlist files in sitelib
    my $packlistdir = $Config{'installsitelib'};
    my @package_list = GetFlist($packlistdir);
    @package_list = grep ( /\.packlist$/ , @package_list);
    @package_list = map { /(.*)\.packlist$/ } @package_list;
    return @package_list;
}



############################## REMOVE ##########################################

sub RemovePackages
{
    my (@packagelist) = @_;     # list of packages to be removed
    my $packlist;

    while (@packagelist) {
        my $package_name = shift @packagelist;      # does not include version number
        $package_name =~ s/-[\d\.]*$//;      # remove version number if any

        my @installed_packages = get_package_list();
        my ($match) = grep(/(^$package_name$|^$package_name-[\d\.]+$)/i, @installed_packages);
        if (!$match) {
            print "Error: Package $package_name is not installed\n";
            return;
        }
        $package_name = $match;
        print "Removing package $package_name\n" unless $opt{'quiet'};

        my $packlistdir = $Config{'installsitelib'};
        my $packlist = "$Config{'installsitelib'}/$package_name.packlist";

        if (!-f $packlist) {
            print "Error: packlist ($packlist) for package $package_name not found\n";
            next;
        }

        # clean up any files that do not exist, otherwise uninstal will bomb
        my @packlistdata = split("\n", ReadFile($packlist));
        my $foo;
        my @newpacklistdata;
        foreach $foo (@packlistdata) {
            push(@newpacklistdata, $foo) if (-e $foo);
        }
        WriteFile($packlist, join("\n", @newpacklistdata));

        my $nono = 0;
        ExtUtils::Install::uninstall($packlist, $opt{'verbose'}, $nono);
    }
    MakeTOC();
    print "DONE\n";
}







######################################## SUBS #####################



sub _build_html
{
    my @files = scan_dir("blib", '(\\.pod)|(\\.pm)$');
    my $f;
    foreach $f (@files) {
        $f =~ s%blib/%%;
        my $outfile;
        ($outfile = $f) =~ s/(\.pod)|(\.pm)$/.html/i;
        print ("$f => html/$outfile\n") if $opt{'verbose'};
        my $outdir;
        $outdir = "./blib/html/$outfile";
        $outdir =~ s#/[^/]+$##;
        mkpath($outdir, 0, 0777);
        Pod::Html::pod2html("--htmlroot=/", "--htmldir=./blib/html",
                    "--quiet",
                    "--header", "--podroot=.", "--index",
                    "--infile=./blib/$f",
                    "--outfile=./blib/html/$outfile");
    }
}


sub MakeTOC
{
    print "Making TOC\n" if $opt{'verbose'};
    # make table of contents page for currently installed html files
    # updates perltoc.html

    my ($cwd, @dir, @pod, @modules, $filename);
    my ($desc, $line);

    chdir $Config{'installhtmldir'};
    $cwd = $Config{'installhtmldir'}; $cwd =~ s/\\/\\\\/g;
    #@dir = `dir *.html /s/b/a-d`;
    #chomp @dir;
    @dir = scan_dir($Config{'installhtmldir'}, '\\.html$');
    #print "HTML FILES:\n", join("\n", @dir), "\n";

    foreach $filename (@dir) {
        $filename =~ s%/%\\%g;
        $filename =~ s/^$cwd\\//i;
        next if ($filename !~ m/^(lib\\)|(site\\lib\\)/i);   # skip files in root of html directory

        #G:\perl56i\html/site/lib/DBI.html
        #G:\perl56i\html/site/lib/Bundle/LWP.html
        #G:\perl56i\html/lib/Symbol.html
        #G:\perl56i\html/lib/Pod/perlembed.html
        #G:\perl56i\html/lib/Pod/Win32.html

        $desc = $filename;
        $desc =~ s/^site\\lib\\//i;
        $desc =~ s/^lib\\//i;
        $desc =~ s/^pod\\//i;
        $desc =~ s/\\/::/g;
        $desc =~ s/\.html$//i;

        # put description at start so we can sort it.
        my $fileurl = $filename;
        $fileurl =~ s%\\%/%g;
        $line = "$desc %%%% <a href=\"$fileurl\">$desc<\/a><br>\n";

        if ($filename =~ /^lib\\pod/i) {
            push(@pod, $line);
        } else {
            push(@modules, $line);
        }
    } # foreach

    @pod = sort {uc($a) cmp uc($b)} @pod;
    @pod = map { (/.* %%%% (.*)/s)[0]  }  @pod;
    @modules = map { (/.* %%%% (.*)/s)[0]  } sort {uc($a) cmp uc($b)} @modules;

    my $data = ReadFile("perltoc.html");
    my ($header, $footer) = $data =~ m/(^.*<!--BEGIN TOC-->).*(<!--END TOC-->.*)/s;

    $data = "<h4><a name=\"CorePerlDocs\">Core Perl Docs</a></h4>\n";
    $data .= join("\n", @pod);
    $data .= "<h4><a name=\"ModuleDocs\">Module Docs</a></h4>\n";
    $data .= join("\n", @modules);

    WriteFile("perltoc.html", $header . $data . $footer);
}



######################################## SUBS #####################
sub get_name_description
{
    # get name and description from filename, and optional version
    my ($f, $version) = @_;           # $f = foo/bar/baz.tar.gz or foo/bar/baz-1.00.tar.gz
    $f =~ s/\.tar\.gz//;
    $f =~ s/-PKG.*$//;
    $f = basename($f);

    my $package_name;
    my $package_description;

    if ($f =~ /(.*?)-([\d\.]+)$/) {
        my $package_version = "";
        ($package_name, $package_version) = $f =~ /(.*?)-([\d\.]+)$/;
        $package_description = $f;
    }
    else {
        $package_name = $f;
        $package_description = $f;
    }
    if ($version) {
        $package_description = "$package_name-$version";
    }

    return ($package_name, $package_description);
}



sub abspath
{
    # the Cwd::abs_path function does not seem to work
    my ($filename) = @_;
    if ($filename =~ m%^/% || $filename =~ m%^.\:% ) {   # already an absolute path
        return $filename;
    }
    my $abs;
    if (dirname($filename) eq '.') {
        $abs = getcwd() . '/' . basename($filename);
    }
    else {
        $abs = getcwd() . '/' . $filename;
    }
    $abs =~ s%//%/% while $abs =~ m%//%;  # strip all double // chars
    print "abspath: returning = $abs\n";;
    return $abs;
}


