#!%%PERL%% -w

# This script synchronizes the packages in $tardir with those installed by the
# octave packaging system.  It uninstalls those packages for which it or its
# dependencies are not contained $tardir.  It installs those packages for which
# it and its dependencies are in $tardir.  Packages are uninstalled or
# installed in the correct order, so that dependency requirements are always
# satisfied.

my $prefix = defined($ENV{"PKG_PREFIX"}) ? $ENV{"PKG_PREFIX"} : "%%PREFIX%%";
my $tardir = "$prefix/share/octave/tarballs";

use strict;
use Archive::Tar;
use IO::Zlib;
use File::Remove qw(remove);

# Interrogate octave to see where it stores its packages.

open(OCTAVE,"octave-cli -W -H -q --no-site-file --eval \"pkg('prefix');pkg('global_list')\" |") || die;
my $install_prefix = <OCTAVE> || die;
chomp $install_prefix;
$install_prefix =~ s/.*\s+//;
my $arch_dep_prefix = <OCTAVE> || die;
chomp $arch_dep_prefix;
$arch_dep_prefix =~ s/.*\s+//;
my $global_list = <OCTAVE> || die;
chomp $global_list;
close OCTAVE;

# %long_form is a hash that does conversions like
# $long_form{"odepkg"} == "odepkg-0.8.8.tar.gz"

my %long_form;
while (<$tardir/*>) {
  if (!-l && /([^\/]+)$/) {
    my $n = $1;
    $n =~ /(.*)\-/;
    $long_form{$1} = $n;
  }
}
while (my $p = <$install_prefix/*>) {
  $p =~ s+.*/++;
  $p =~ /(.*)\-/;
  $long_form{$1} = "$p.tar.gz";
}

# Get the list of packages in $tardir.

my %in_tarballs;
while (<$tardir/*>) {
  if (!-l && /([^\/]+)$/) {
    my $n = $1;
    $in_tarballs{$n} = 1;
  }
}

my %is_installed;  # Those packages that are installed.  For these the hash
                   # returns a list of the packages requiring it.
my %to_remove;     # Those packages that need to be uninstalled.  For these
                   # the hash returns a list of the packages requiring it.
my $nr_to_remove;  # The number of packages that need to be uninstalled.
my %to_install;    # Those packages that remain to be installed.  For these
                   # the hash returns a list of the dependencies.

# Calculate which entries of %is_installed exist.

%is_installed = ();
while (my $p = <$install_prefix/*>) {
  $p =~ s+.*/++;
  $is_installed{"$p.tar.gz"} = "";
}

# Compare %is_installed with the output of pkg('list') in octave.  If it is
# different then the octave packaging system is probably corrupt, so we clean
# out everything.

my %check_installed;
open(OCTAVE,"octave-cli -W -H -q --no-site-file --eval \"pkg('list')\" |") || die;
<OCTAVE>;
my $out = join "",<OCTAVE>;
while ($out =~ s/^\s*(\S+)\s*\|\s*(\S+).*$//m) {
  $check_installed{"$1-$2.tar.gz"} = "";
}
close OCTAVE;
foreach my $p (sort keys %is_installed) {
  if (defined($is_installed{$p}) && !defined($check_installed{$p})) {
    print "The octave packaging system is probably corrupt, so it will be rebuilt.\n";
    remove( \1, $arch_dep_prefix, $global_list, $install_prefix);
    %is_installed = ();
    last;
  }
}

# Fill in the values of %is_installed by checking the dependencies.

while (my $p = <$install_prefix/*>) {
  $p =~ s+.*/++;
  open(D,"$install_prefix/$p/packinfo/DESCRIPTION") || die $!;
  foreach my $l (<D>) {
    if ($l=~s/^Depends:\s*//i) {
      foreach my $ll (split ",",$l) {
        chomp($ll);
        $ll = lc($ll);
        $ll =~ s/^\s+//;
        $ll =~ s/\s.*//;
        if (defined $long_form{$ll}) {
          my $depends = $long_form{$ll};
          if (defined $is_installed{$depends}) {
            $is_installed{$depends} .= ($is_installed{$depends} eq ""?"":"|")."$p.tar.gz";
          }
        }
      }
    }
  }
  close D;
}
 
# Find which packages need to be uninstalled.

%to_remove = ();
$nr_to_remove = 0;
foreach my $p (keys %is_installed) {
  if (defined($is_installed{$p})) {
    my $altp = $p; # so that 3.5.0 and 3.5 are the same package numbers
    $altp =~ s/(\-\d+\.\d+[^\.]*)\.0(\.tar\.gz)$/$1$2/ || 
    $altp =~ s/(\-\d+\.\d+[^\.]*)(\.tar\.gz)$/$1\.0$2/;
    if (!defined($in_tarballs{$p}) && !defined($in_tarballs{$altp})) {
      $to_remove{$p} = $is_installed{$p};
      $nr_to_remove++;
    }
  }
}

if ($nr_to_remove>0) {

# The function make_ordered_list_to_remove() is a recursive depth first
# search to put the packages to be removed in correct order according to
# dependency.  The result is put into @ordered_list_to_remove.

  my @ordered_list_to_remove;

  sub make_ordered_list_to_remove {
    foreach my $p (split /\|/,$_[0]) {
      if (defined $to_remove{$p} || defined $is_installed{$p}) {
        make_ordered_list_to_remove($is_installed{$p});
        push @ordered_list_to_remove,$p;
        undef $to_remove{$p};
        undef $is_installed{$p};
      }
    }
  }


  make_ordered_list_to_remove(join("|",sort keys %to_remove));

# Remove the packages that need to be uninstalled.

  foreach my $p (@ordered_list_to_remove) {
    print "load-octave-pkg: octave is uninstalling $p.\n";
    $p =~ s/\-[^\-]+\.tar\.gz//;
    system "octave-cli -W -H -q --no-site-file --eval \"pkg('uninstall','$p')\" > /dev/null";
  }
}

# Clean out any crud that might be left over.

my @pkg = <$install_prefix/*>;
if ($#pkg==-1) {
  print "load-octave-pkg: there are currently no octave packages installed.\n";
  remove( \1, $arch_dep_prefix, $global_list, $install_prefix);
}

# Recalculate which entries of %is_installed exist.

%is_installed = ();
while (my $p = <$install_prefix/*>) {
  $p =~ s+.*/++;
  $is_installed{"$p.tar.gz"} = "";
}

# Calculate which packages need to be installed, and fill in the values of
# %is_tarballs by checking the dependencies.

%to_install = ();
foreach my $n (keys %in_tarballs) {
  my $altn = $n; # so that 3.5 and 3.5.0 are the same package numbers
  $altn =~ s/(\-\d+\.\d+[^\.]*)(\.tar\.gz)$/$1\.0$2/ ||
  $altn =~ s/(\-\d+\.\d+[^\.]*)\.0(\.tar\.gz)$/$1$2/;
  if (defined($in_tarballs{$n})) {
    if (!defined($is_installed{$n}) && !defined($is_installed{$altn})) {
      my $tar = Archive::Tar->new("$tardir/$n",COMPRESS_GZIP);
      die if !defined($tar);
      my @list_of_files = grep /^.*\/DESCRIPTION$/, $tar->list_files();
      die if $#list_of_files!=0;
      my $descr = $tar->get_content($list_of_files[0]);
      foreach my $l (split /\n/,$descr) {
        if ($l=~s/^Depends:\s*//i) {
          foreach my $ll (split ",",$l) {
            $ll = lc($ll);
            $ll =~ s/^\s+//;
            $ll =~ s/\s.*//;
            if ($ll ne "octave") {
              $to_install{$n} .= (defined($to_install{$n})?"|":"").(defined($long_form{$ll})?$long_form{$ll}:$ll);
            }
          }
        }
      }
      $to_install{$n} .= "";
    }
  }
}

# The function make_ordered_list_to_install() is a recursive depth first
# search to put the packages to be installed in correct order according to
# dependency.  The result is put into @ordered_list_to_install.

my @ordered_list_to_install;

sub make_ordered_list_to_install {
  my $retval = 1;
  foreach my $p (split /\|/,$_[0]) {
    if (!defined $in_tarballs{$p}) {
      $retval = 0;
    } elsif (defined $to_install{$p}) {
      if (make_ordered_list_to_install($to_install{$p})) {
        push @ordered_list_to_install,$p;
        undef $to_install{$p};
      } else {
        $retval = 0;
      }
    }
  }
  return $retval;
}

make_ordered_list_to_install(join("|",sort keys %to_install));

# Now install the packages that need to be installed.

foreach my $p (@ordered_list_to_install) {
  print "load-octave-pkg: octave is installing $p.\n";
  system "octave-cli -W -H -q --no-site-file --eval \"pkg('install','$tardir/$p')\" > /dev/null\n";
}

# Remove directories that may have been left behind by the octave packaging
# process.

rmdir "$prefix/lib/octave/packages";
