# Copyright 2005-2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: uninstall_feature.tag,v 1.3 2007-03-30 23:40:54 pajamian Exp $

UserTag uninstall_feature Order       name
UserTag uninstall_feature MapRoutine  Vend::Config::uninstall_feature
UserTag uninstall_feature Version     $Revision: 1.3 $
UserTag uninstall_feature Description <<EOD
This tag uninstalls features which were installed with Feature.
EOD

sub uninstall_feature {
my ($value) = @_;
my $c = $Vend::Cfg
  or die "Not in catalog context.\n";

#::logDebug("Running uninstall for cat=$Vend::Cat, from cfg ref=$c->{CatalogName}");
$value =~ s/^\s+//;
$value =~ s/\s+$//;
my $fdir = Vend::File::catfile($Global::FeatureDir, $value);

unless(-d $fdir) {
  config_warn("Feature '%s' not found, skipping.", $value);
  return $c;
}

my $etag = errmsg("feature %s uninstall -- ", $value);

# Get the global install files and remove them from the config list
my @gfiles = glob("$fdir/*.global");
my %seen;
@seen{@gfiles} = @gfiles;

# Get the init files and remove them from the config list
my @ifiles = glob("$fdir/*.init");
@seen{@ifiles} = @ifiles;

# Get the uninstall files and remove them from the config list
my @ufiles = glob("$fdir/*.uninstall");
@seen{@ufiles} = @ifiles;

# Any other files are config files
my @cfiles = grep ! $seen{$_}++, glob("$fdir/*");

# directories are for copying
my @cdirs = grep -d $_, @cfiles;

my $Tag = new Vend::Tags;

my @copy;
my @errors;
my @warnings;

my $wanted = sub {
  return unless -f $_;
  my $n = $File::Find::name;
  $n =~ s{^$fdir/}{};
  my $d = $File::Find::dir;
  $d =~ s{^$fdir/}{};
  push @copy, [$n, $d];
};

if(@cdirs) {
  File::Find::find({ wanted => $wanted, follow => 1 }, @cdirs);
}
#::logDebug("ufiles=" . ::uneval(\@ufiles));
#::logDebug("ifiles=" . ::uneval(\@ifiles));
#::logDebug("cdirs=" . ::uneval(\@cdirs));
#::logDebug("copy=" . ::uneval(\@copy));

for(@ufiles) {
#::logDebug("Running uninstall file $_");
  my $save = $Global::AllowGlobal->{$Vend::Cat};
  $Global::AllowGlobal->{$Vend::Cat} = 1;
  open UNFILE, "< $_"
    or do {
      push @errors, $etag . errmsg("error reading %s: %s", $_, $!);
    };
  my $chunk = join "", <UNFILE>;
  close UNFILE;

#::logDebug("uninstall chunk length=" . length($chunk));

  my $out;
  eval {
    $out = Vend::Interpolate::interpolate_html($chunk);
  };

  if($@) {
    push @errors, $etag . errmsg("error running uninstall %s: %s", $_, $@);
  }

  push @warnings, $etag . errmsg("message from %s: %s", $_, $out)
    if $out =~ /\S/;

  $Global::AllowGlobal->{$Vend::Cat} = $save;
}

for(@copy) {
  my ($n, $d) = @$_;

  my $tf = Vend::File::catfile($c->{VendRoot}, $n);
  next unless -f $tf;

  my $contents1 = Vend::File::readfile($tf);

  my $sf = "$fdir/$n";

  open UNSRC, "< $sf"
    or die $etag . errmsg("Couldn't read uninstall source file %s: %s", $sf, $!);

  local $/;
  my $contents2 = <UNSRC>;

  if($contents1 ne $contents2) {
    push @warnings, $etag . errmsg("will not uninstall %s, changed.", $tf);
    next;
  }

  unlink $tf
    or do {
      push @errors,
        $etag . errmsg("$etag couldn't unlink file %s: %s", $tf, $!);
      next;
    };

  my $td = Vend::File::catfile($c->{VendRoot}, $d);
  my @left = glob("$td/*");
  push @left, glob("$td/.?*");
  next if @left;
  File::Path::rmtree($td);
}

if(@ifiles) {
#::logDebug("running uninstall touch and init");
  my $initdir = Vend::File::catfile($c->{ConfDir}, 'init', $value);
  File::Path::mkpath($initdir) unless -d $initdir;
  my $fn = Vend::File::catfile($initdir, 'uninstall');
#::logDebug("touching uninstall file $fn");
  open UNFILE, ">> $fn"
    or die errmsg("Couldn't create uninstall flag file %s: %s", $fn, $!);
  print UNFILE $etag . errmsg("uninstalled at %s.\n", scalar(localtime));
  close UNFILE;
}


my $errors;
for(@errors) {
  $Tag->error({ set => $_});
  ::logError($_);
  $errors++;
}

for(@warnings) {
  $Tag->warnings($_);
  ::logError($_);
}

return ! $errors;
}