# -*-perl-*-

# $Id$

# Purge old data from the active pool

# $Log$
# Revision 1.1  2012/06/05 20:52:52  timc
# testing possibility of purging all older than two epochs
#
# Revision 1.8  2011/08/30 19:59:45  koczan
# System calls shouldn't be PATH-dependent
#
# Revision 1.7  2010/06/17 16:21:59  koczan
# use the database to estimate size (parsing vos exa wasn't working)
#
# Revision 1.6  2003/06/09 14:45:11  thomas
# schema version of database
#
# Revision 1.5  2003/06/04 17:30:53  thomas
# *** empty log message ***
#
# Revision 1.4  2002/09/10 20:42:57  thomas
# sushi-0.3.1
#
# Revision 1.3  2002/08/20 21:59:56  thomas
# installed 0.3.0
#
# Revision 1.2  2002/08/14 17:13:07  thomas
# 0.2.9 release
#
# Revision 1.1  2002/07/23 16:02:28  thomas
# version 0.2.5
#

package Sushi::ScorchedEarth;

use strict;
use Time::localtime;
use Time::Local;
use Data::Dumper;

use base qw(Sushi::Log);

###############################################################################
# A result is a candidate for deletion if it is dated previous to last
# month's _successful_ offline epoch, _OR_ if it is a non-successful atom
# more than 14 days old.
#
sub getlist {
  my $args = shift;

  if (exists ($args->{type}) && defined ($args->{type}) && length ($args->{type})) {
    return gettype ($args);
  }

  my $results = {};
  my $purges = {};

  # Get a list of all active results
  # Theoretically, the below won't work, because if a type/atom pair _could_
  # be in two different groups with the same time stamp.  I don't think
  # that will ever happen...
  my ($res, $akey);
  print "Getting result information...\n";
  foreach $res (@{Sushi::GenDB::fetch (
					  {
					   on_disk => 'Purged',
					  },
					  {
					   opers => {
						     on_disk => '!='
						    }
					  },
					  $::table_defs->{view_atom_results}
					 )}) {
    $akey = "$res->{type}:$res->{name}";
    # defined ($results->{$akey}) or $results->{$akey} = {};
    $results->{$akey}->{$res->{timestamp}} = $res;
  }

  # Figure out the cutoff (first second in last month)
  my ($mon, $year) = (localtime->mon(), localtime->year()+1900);
  if ($mon>0) {
    $mon--;
  } else {
    $year--;
    $mon=11;
  }

  my $saveset = { month => $mon, year  => $year	};
  my (undef, $starttime, undef) = Sushi::OffLine->setinfo ($saveset);

  print "Building offline set information...\n";
  my $epochs = Sushi::OffLine->getEpochList ($saveset, {});

  print "Finding atoms to scorchedearth...\n";
  # Analyze each atom
  my $fourteendaysago = time - 14 * 24 * 60 * 60;
  my $timestamp;

  # Get all the atoms before the offline set
  foreach $akey (keys %$results) {
    defined ($epochs->{$akey}) or next;
    defined ($epochs->{$akey}->{storage_id}) or next;
    foreach $timestamp (keys %{$results->{$akey}}) {
      ($epochs->{$akey}->{timestamp} > $timestamp) and
	$purges->{"$akey:$timestamp"} = $results->{$akey}->{$timestamp};
    }
  }

  # And get all the failed atoms older than 14 days
  foreach $akey (keys %$results) {
    foreach $timestamp (keys %{$results->{$akey}}) {
      $res = $results->{$akey}->{$timestamp};
      if (($res->{result} ne 'Success') && ($timestamp < $fourteendaysago)) {
	# print "Result for $akey:" . ctime ($timestamp) . " is $res->{result}\n";
	$purges->{"$akey:$timestamp"} = $res;
      }
    }
  }

  # And purge everything that's older than dirt
  # (one month older than the scheduler will re-epoch -- see Group.pm)
  my $oldasdirt = time - (90 + 90 + 30) * 24 * 60 * 60;
  foreach $akey (keys %$results) {
    foreach $timestamp (keys %{$results->{$akey}}) {
      if ($timestamp < $oldasdirt) {
	$purges->{"$akey:$timestamp"} = $results->{$akey}->{$timestamp};
      }
    }
  }

  return $purges;
}

###############################################################################
# Return all the non-purged atoms for a given type
#
sub gettype {
  my $args = shift;

  length ($args->{type}) or return undef;

  my $results = {};
  my $purges = {};

  # Get a list of all active results
  # Theoretically, the below won't work, because if a type/atom pair _could_
  # be in two different groups with the same time stamp.  I don't think
  # that will ever happen...
  my ($res, $akey);
  print "Getting result information...\n";
  foreach $res (@{Sushi::GenDB::fetch (
					  {
					   on_disk => 'Purged',
					   type    => $args->{type},
					  },
					  {
					   opers => {
						     on_disk => '!='
						    }
					  },
					  $::table_defs->{view_atom_results}
					 )}) {
    $purges->{"$res->{type}:$res->{name}:$res->{timestamp}"} = $res;
  }

  return $purges;
}



###############################################################################

sub showlist {
  my $args = shift;
  my $opts = shift;
  my $purges = shift;

  print "Purgable list:\n";
  Sushi::GenDB::displayHeader (
			       { print_headings => 1 },
			       $::table_defs->{view_atom_results}
			      );
  my $res;
  my $tsize = 0;
  my $result;
  foreach $result (sort keys %$purges) {
    Sushi::GenDB::displayRow (
			      {},
			      $::table_defs->{view_atom_results},
			      $purges->{$result}
			     );
    $tsize += $purges->{$result}->{comp_size};
  }
  print "Found " . scalar (keys %$purges) . " purgable atoms (" . int ($tsize/(1024*1024)) . " MB total).\n";

}


###############################################################################
# Purge the on-line records for the passed atoms

sub purge {
  my $args = shift;
  my $purges = shift;

  my ($akey, $result, $atoms, $atom, $before_size, $after_size, $commonName);
  my ($reason, $path, $res, $nrows);
  # OK.  Let's do it...
  foreach $akey (sort keys %$purges) {
    $result = $purges->{$akey};
    $atom = Sushi::Atom->newAtom (%$result);
    if (!defined $atom) {
      $::log->error ("Failed to create atom id=$result->{id}\n");
      next;
    }
    $commonName = $atom->commonName;
    $before_size = &getSize ($result->{afs_volume});
    my $skipdel = 0;
    if (!defined $result->{afs_volume}) {
      $::log->error ("$commonName: No result volume found.  Skipping to db update...\n");
      $skipdel = 1;
    }
    if (!defined ($result->{afs_path}) || length ($result->{afs_path}) < 20) {
      $::log->error ("$commonName: afs_path ($result->{afs_path}) suspiciously short.  Skipping to db update...\n");
	$skipdel = 1;
    }
    if (!$skipdel) {
      $reason = "Purge $commonName";
      $path = Sushi::AfsBits::mountVolume ($result->{afs_volume}, $reason);
      if (!defined $path) {
	$::log->error ("Failed to mount $result->{afs_volume} to purge $commonName.  Skipping...\n");
	next;
      }
      my @files = glob "$path/$result->{afs_path}/*";
      if (@files) {
	Sushi::Misc::runCmd (
			     "/bin/rm",
			     @files
			    );
      } else {
	$::log->error ("No files match $path/$result->{afs_path}/*.  Skipping delete.\n");
      }
      Sushi::AfsBits::unMountVolume ($result->{afs_volume}, $reason);
      $after_size = &getSize ($result->{afs_volume});
      print "$commonName: volume size $before_size (before), $after_size (after), shrank " . ($before_size - $after_size) . "\n";
    }
    $nrows = Sushi::GenDB::update (
				   {
				    id => $result->{id},
				    timestamp => $result->{timestamp}
				   },
				   {},
				   {
				    on_disk => 'Purged'
				   },
				   $::table_defs->{results}
				  );
  }
  return;
}

###############################################################################

sub getSize {
  my $vol = shift;

  my $sth = $::sudbh->prepare("select round(sum(comp_size)/1024, 0) as size from results where afs_volume = '$vol' and on_disk != 'Purged'");
  if (!$sth->execute()) {
    $::log->error("Cannot query size for $vol");
    return undef;
  }
  my $size = $sth->fetchrow_hashref->{size} || 0;
  $sth->finish;

  return $size;
}


###############################################################################

1;
