# our variables declared in main listed here
our %opt;
our %cfg;

package IPM_RM; # rempository manager
require Exporter;
@ISA = qw(Exporter);
# symbols to export by default
@EXPORT = qw(install search ListPackages);

use strict;
use Config;
use File::Path; # mkpath, rmtree
use File::Basename;  # fileparse dirname basename
use IPM_Util;
use LWP::Simple;
use IPM_InstallPkg;

1;


sub install
{
    my (@modlist) = @_;
    my $mod;
    while ($mod = shift @modlist) {
        $mod =~ s/-[\d\.]*$//;      # remove version number if any
        print "Installing $mod\n" unless $opt{'quiet'};

        my ($modpath, $version) = findpackage($mod);
        if ($modpath) {
            print "Found module at $modpath\n" if $opt{'verbose'};
            # fetch file if it is remte
            if ($modpath =~ /^http:/ || $modpath =~ /^ftp:/) {
                my ($name, $path) = fileparse($modpath);
                print "Downloading $mod\n" if $opt{'verbose'};
                print "DBG: Downloading $modpath\n" if $opt{'debug'};
                mirror($modpath, "$cfg{cachedir}/$name");
                # todo check
                $modpath = "$cfg{cachedir}/$name";
            }
            else {
                # check if file exists
            }
            InstallPkg($modpath, $version);
            unlink ($modpath) unless ($modpath =~ /http:/ || $modpath =~ /ftp:/);
        }
        else {
            print "Module $mod not found\n";
        }
    }
    print "DONE\n";
}




sub findpackage
{
    my ($mod) = @_;

    $mod =~ s/::/-/g;
    # search for named module is package repositories, and return path to it
    # case 1 $mod is full path to local ppd
    if (-f $mod && $mod =~ /\.ppd$/) {
        return parseppd($mod);
    }
    # case 2 $mod is full path to local tar.gz
    if (-f $mod && $mod =~ /\.tar\.gz$/) {
        return ($mod, undef);
    }
    # case 3 $mod is full path to remote ppd
    if ($mod =~ /^http:.*\.ppd$/) {
        return parseppd($mod);
    }
    # case 4 $mod is full path to remote tar.gz
    if ($mod =~ /^http:.*\.tar\.gz$/) {
        return ($mod, undef);
    }

    my @repository_list = GetRepositoryListStripped();
    foreach my $d (@repository_list) {
        print "Searching for $mod in $d \n" if $opt{'verbose'};
        if ($d !~ /^http:/ && $d !~ /^ftp:/ ) {
            if (-f "$d/$mod.ppd") {
                return parseppd("$d/$mod.ppd");
            }
            # TODO LOOK for $mod-9.99-PKG-OSName.tar.gz
        }
        else {
            return parseppd("$d/$mod.ppd") if (head("$d/$mod.ppd"));
        }
    }

    return undef;
}



sub search
{
    my (@modlist) = @_;
    print "Searching for @modlist\n" unless $opt{'quiet'};

    my @repository_list = GetRepositoryListStripped();
    foreach my $path (@repository_list) {
        print "Searching in $path\n" unless $opt{'Quiet'};
        my @list = ListPackages($path);
        my @filtered_list;
        if (!@modlist) {
            @filtered_list = @list;
        }
        else {
            @filtered_list = ();
            my $mod = 'File';
            foreach $mod (@modlist) {
                push(@filtered_list, grep (/$mod/i, @list));
            }
        }
        print join("\n", @filtered_list);
        print "\n";
    }
}





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



sub is_old {
    # return true if file 1 is older than file 2,3,4,..    
    my $target = shift @_;
    return 1 if (!-e $target);

    my $targettime = (stat($target))[9];
    my @sources = @_;
    foreach my $file (@sources) {
        # todo if source file is missing we could return 1 or undef
        next if (!-e $file);
        my $filetime = (stat($file))[9];
        if ($filetime > $targettime) {
            #print "$file is newer than $target\n";
        }
        return 1 if ($filetime > $targettime);
    }
    return 0;
}


sub GetRepositoryListStripped()
{
    my @repository_list = split(/\n/, ReadFile("$cfg{datadir}/repository_list.txt") || "");
    map {s/^.*\s*=\s*//} @repository_list;      # strip off 'name = ' from 'name = value' pairs
    @repository_list = $opt{'location'} if ($opt{'location'});
    print "DBG: repository_list=", join(" ", @repository_list), "\n" if $opt{'debug'};
    return @repository_list;
}










sub ListPackages
{
    my ($path) = @_;
    return ($path !~ /^http:/) ? ListDirectoryPackages($path) : ListURLPackages($path);
}





sub ListDirectoryPackages
{
    my ($path) = @_;
    # package.lst, *.ppd. */blib, *.tar.gz, CPAN/modules/02packages.details.txt
    my @list;

    print "DBG: Packages in $path/package.lst:\n" if $opt{'debug'};
    my $data;
    if (-f "$path/package.lst") {
        $data = ReadFile("$path/package.lst");
        return ParseSummaryFile($data);
    }

    print "DBG: Packages in $path/*.ppd files:\n" if $opt{'debug'};
    my ($file);
    my @files;
    opendir(PPDDIR, $path) or die;
    @files = grep { /\.ppd$/i && -f "$path/$_" } readdir(PPDDIR);
    close (PPDDIR);
    @files = sort @files;
    foreach $file (@files) {
        #$file =~ s/\.ppd//i;

        my $ppddata;
        if (!($ppddata = ReadFile("$path/$file"))) {
            print "Error: Could not read $path/$file\n";
            next;
        }
        my ($package_name) = $ppddata =~ m/NAME=\"(.*?)\"/i;
        my ($package_version) = $ppddata =~ m/VERSION=\"(.*?)\"/i;
        while($package_version =~ s/,0$//) { 1; }
        $package_version =~ s/,/./g;
        my $package_description = "$package_name [$package_version]";
        #print "$package_description\n";
        push (@list, $package_description);
    }
    return @list if (@files && !$opt{'debug'});

    
    print "DBG: Packages in $path/*.tar.gz files:\n" if $opt{'debug'};
    opendir(PPDDIR, $path) or die;
    @files = grep { /\.tar\.gz$/i && -f "$path/$_" } readdir(PPDDIR);
    close (PPDDIR);
    @files = sort @files;

    foreach $file (@files) {
        $file =~ s/\.tar\.gz//i;
        $file =~ s/^(.*)-([\d\.]+)$/$1 [$2]/s;
        $file =~ s/^(.*)-([\d\.]+)-PPM$/$1 [$2]/is;
        #print "$file\n";
        push (@list, $file);
    }
    return @list;
}




sub ListURLPackages
{
    my ($path) = @_;
    my $data;

    # package.lst ,default.prk?list=1, CPAN/modules/02packages.details.txt, *.ppd's

    print "DBG: Packages in $path/package.lst:\n" if $opt{'debug'};
    if ($data = get_cached("$path/package.lst", $cfg{'cachedir'})) {
        return ParseSummaryFile($data);
    }

    print "DBG: Packages in $path/default.prk?list=1:\n" if $opt{'debug'};
    if ($data = get_cached("$path/default.prk?list=1")) {
        return ParsePRKList($data);
    }
    # removed search cpan directory

    print "DBG: Packages in $path/*.ppd files:\n" if $opt{'debug'};
    # we could fetch ppd to get name and version, but it would take a while
    $data = get("$path/");
    return if (!$data);

    my @ppds;
    if ($data =~ /^<head><title>/) {
        print "DBG: IIS format directory listing\n" if $opt{'debug'};
        @ppds = grep { /\.ppd/i } split('<br>', $data);
        @ppds = sort @ppds;
        my @list;
        my $file;
        foreach $file (@ppds) {
            $file =~ s/\.ppd<.*$//is;
            $file =~ s@.*>@@is;
            push (@list, $file);
        }
        return @list;
    }
    else {
        print "DBG: Apache format directory listing\n" if $opt{'debug'};
        @ppds = grep { /\.ppd/i } split('\n', $data);
        @ppds = sort @ppds;
        my @list;
        my $file;
        foreach $file (@ppds) {
            $file =~ s/^.*>(.*?)\.ppd<.*$/$1/i;
            push (@list, $file);
        }
        return @list;
    }
}


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



sub ParsePRKList
{
    my ($data) = @_;
    my @list;
    my @nv = $data =~ m%<!--Key:(.*?)-->.*?<tr>(.*?)</tr>%gs;
    my ($i, $n, $v);
    for($i=0; $i < @nv; $i += 2) {
        $n = $nv[$i];
        $v = $nv[$i+1];     # contains a row
        $v =~ s%.*<td>(.*)</td>%$1%s;   # get last col
        $v =~ s/<.*?>//sg;      # remove font, etc
        $v =~ s/ //sg;
        $v =~ s/\n//sg;
        my $d = "$n-$v";
        push (@list, $d);
    }
    return @list;
}


sub ParseSummaryFile
{
    my ($data) = @_;
    my @list;
    
    my @nv = $data =~/<SOFTPKG NAME=\"(.*?)\" VERSION=\"(.*?)\">/g;
    my ($i, $n, $v);
    for($i=0; $i < @nv; $i += 2) {
        $n = $nv[$i];
        $v = $nv[$i+1];
        while($v =~ s/,0$//) { 1; }
        $v =~ s/,/./g;
        my $d = "$n-$v";
        push (@list, $d);
    }
    return @list;
}


=comment
<SOFTPKG NAME="Alias" VERSION="2,32,0,0">
  <IMPLEMENTATION>
    <CODEBASE HREF="sun4-solaris-thread-multi/Alias.tar.gz" />
    <ARCHITECTURE NAME="sun4-solaris-thread-multi" />
    <OS NAME="solaris" />
  </IMPLEMENTATION>
  <IMPLEMENTATION>
    <CODEBASE HREF="MSWin32-x86-multi-thread/Alias.tar.gz" />
    <ARCHITECTURE NAME="MSWin32-x86-multi-thread" />
    <OS NAME="MSWin32" />
  </IMPLEMENTATION>
=cut

sub parseppd
{
    my ($PPDfile) = @_;
    # parse ppd file

    my $osname;
    if ($^O eq "MSWin32") {
        $osname = "MSWin32";
    }
    else {
        $osname = `uname`; chop $osname;
        $osname = lc($osname);
        $osname =~ s/-//;
        $osname =~ s/\///;
    }

    my $ppddata = ($PPDfile =~ /^http:/) ? get($PPDfile) : ReadFile($PPDfile);

    my ($package_name) = $ppddata =~ m/SOFTPKG NAME=\"(.*?)\"/i;
    my ($package_version) = $ppddata =~ m/SOFTPKG NAME=\".*?\"\s+VERSION=\"(.*?)\"/i;
    while($package_version =~ s/,0$//) { 1; }
    $package_version =~ s/,/./g;

    my $reltarfile;
    foreach ($ppddata =~ m/<IMPLEMENTATION>(.*?)<\/IMPLEMENTATION>/sg) {
        ($reltarfile) = $_ =~ m/CODEBASE HREF=\"(.*?)\"/is if (m/OS NAME=\"$osname\"/);
    }
    if (!$reltarfile) {
        print "ERROR: PPD does not contain an implementation section for OS=$osname\n";
        return undef;
    }
    my $package_description = "$package_name-$package_version";

    my $fulltarfile;
    if (-f $reltarfile) {       # ppd contain a full path
        $fulltarfile = $reltarfile;
    }
    elsif ($reltarfile =~ /^http:/) {
       $fulltarfile = $reltarfile;     # ppd contains an abs URL
    }
    else {
        my ($foo, $path) = fileparse($PPDfile);
        $fulltarfile = "$path$reltarfile";
    }

    return ($fulltarfile, $package_version);
}


sub get_cached
{
    my ($url, $cachedir) = @_;
    my $local_file = $url;
    $local_file =~ s%http://%%;
    $local_file =~ s%/|\\|\?|:%_%g;
    $local_file = "$cachedir/$local_file";

    my $rc = mirror($url, $local_file);
    #return is_success($rc) ? ReadFile($local_file) : undef;
    return (-e $local_file) ? ReadFile($local_file) : undef;
}
