# -*-perl-*-

# $id$

# The generic schedule module.

# $Log: Group.plm,v $
# Revision 1.10  2007/02/28 21:16:39  thomas
# Add 'epoch only' scheduler
#
# Revision 1.9  2005/06/24 21:07:28  thomas
# Only schedule based on last seven months history
#
# Revision 1.8  2005/03/30 22:05:23  thomas
# -- Ensure that an epoch estimate exists in all incoming atoms
# -- On inc only days, schedule epoch no epoch in previous epoch cycle.
#
# Revision 1.7  2003/06/12 21:57:33  thomas
# final save before 0.3.11 branch
#
# 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/07/23 16:02:27  thomas
# version 0.2.5
#
# Revision 1.3  2002/07/10 14:01:28  thomas
# sushi-0.2.4
#
# Revision 1.2  2002/07/08 15:56:33  thomas
# 0.2.3 release
#
# Revision 1.1.1.1  2002/05/21 14:13:28  thomas
# sushi - backup to disk
#

package Sushi::Group;

use strict;
use Time::Local;
use Data::Dumper;
use Sushi::Misc;
use DirHandle;
use Time::localtime;
use IO::Pipe;
use POSIX ":sys_wait_h";

use base ("Sushi::Log");

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

# The constructor for all Group Types

sub new {
  my $invocant = shift;
  my $class = ref ($invocant) || $invocant;
  my $type = undef;
  if ($class =~ /::([^:]+)$/) {
    $type = $1;
  }
  my $timestr = Sushi::Misc::dailyGroup;
  my $self = { debug          => $::debug,
	       schedule_group => $timestr,
	       type           => $type,
	       @_
	     };
  bless ($self, $class);
  if (!defined ($self->{type})) {
    $self->error ("Group $class::new: Can't identify type!");
    return undef;
  }
  return $self;
}

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

sub scheduleGroup {
  my ($self) = @_;

  ref ($self) or return 0;

  return $self->scheduleInterval();

}

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

# The infamous interval scheduler

sub scheduleInterval {
  my ($self) = shift;

  ref($self) or return -1;

  $self->log (2, "ISched:($self->{type}): Beginning Interval Scheduler at " . ctime (time) . "\n");

  # This is the number of days before I re-epoch a volume 'just because'.
  # The guarantee is that it will be re-epoched within twice this number
  # of days.
  defined $self->reepochdays or $self->reepochdays(90);
  my $reepoch = (60*60*24*$self->reepochdays);

  # Choose reasonable defaults and calculate derived parameters
  defined $self->interval or $self->interval (14);
  defined $self->now      or $self->now (time);
  my ($interval,$now) = ($self->interval, $self->now);
  my ($ttime, $tmon, $daysleft);
  my ($mday,$mon,$year) = (localtime($now)->mday,
			   localtime($now)->mon,
			   localtime($now)->year);

  # Bound the atoms to be executed today only...
  my ($execute_before) = timelocal (0,45,23,$mday,$mon,$year) + 1;
  my ($execute_after)  = timelocal (0,0,0,$mday,$mon,$year) - 1;

  # The start of the cycle
  my $stmday = int(($mday-1)/$interval)*$interval+1;
  my $starttime = timelocal (0,0,0,$stmday,$mon,$year);

  # If the end of the cycle is in next month, do some magic
  my $endtime = $starttime + ($interval-1)*24*60*60;
  $tmon = localtime($endtime)->mon;
  if ($tmon != $mon) {
    # We're really in the previous cycle -- recalc some things
    $stmday = int(($mday-1)/$interval)*$interval+1-$interval;
    $starttime = timelocal (0,0,0,$stmday,$mon,$year);
    $endtime = $starttime + ($interval-1)*24*60*60;
    # But finish all the epochs today
    $daysleft = 1;
  } else {
    $daysleft = $interval - ($mday - $stmday);
  }

  # $self->log (3, "\$stmday=$stmday, \$mday=$mday\n");
  $self->log (2, "ISched:($self->{type}): Interval scheduler configuration:\n");
  $self->log (2, "ISched:($self->{type}): Time scheduling for: " . ctime ($now) . "\n");
  $self->log (2, "ISched:($self->{type}): Interval Start: " . ctime ($starttime) . "\n");
  $self->log (2, "ISched:($self->{type}): Interval End: " . ctime ($endtime) . "\n");
  $self->log (2, "ISched:($self->{type}): Days remaining in interval: $daysleft\n");

  $self->log (2, "ISched:($self->{type}): starting epoch search at " . ctime () . "\n");

  my ($tepoch, %lastepoch, $burec, $aname, $mtime, $atom, $etoday);
  my ($etotal, $etotalmodified, $eremain, $scheduled, $purged, $neverepoched)
    = (0,0,0,0,0,0);

  ############################################################################
  # Step 1.  With 'n' days left in the epoch cycle, epoch 1/nth of
  # all the atoms that have changed since the last epoch.

  foreach $aname (keys %{$self->{atoms}}) {
    $atom = $self->{atoms}->{$aname};

    # Read only part of the history, to shrink process size.  Anything
    # longer ago than 7 months we pretend doesn't exist
    $atom->history (time() - 60*60*24*30*7);

    # Make sure they have an epoch size estimate
    if (!defined ($atom->epsize) || !$atom->epsize) {
      $self->log (0, "ISched:($self->{type}): No epoch size for $aname.  Setting to 100.\n");
      $atom->epsize (100);
    }

    # Set some initial parameters
    $atom->execute_before ($execute_before);
    $atom->execute_after  ($execute_after);

    # Mark as unsure so far...
    $atom->level(-1);

    # Total of all epochs
    $etotal += $atom->epsize;

    # No need to epoch here if epoched after last modification
    $burec = $atom->lastBu(0);
    $tepoch = (defined ($burec) ? $burec->{timestamp} : 0);
    $mtime = $atom->data_last_update;
    (defined ($mtime) && $tepoch > $mtime) and next;

    $etotalmodified += $atom->epsize;

    $tepoch or $neverepoched++;
    if ($tepoch < $starttime) {
      $eremain += $atom->epsize;
      $lastepoch{$aname} = $tepoch;
    }
  }

  $etoday = $eremain/$daysleft;

  $self->log (2, "ISched:($self->{type}): Total epoch size: $etotal\n");
  $self->log (2, "ISched:($self->{type}): Total size modified since being epoched: $etotalmodified\n");
  $self->log (2, "ISched:($self->{type}): Remain epoch size this cycle: $eremain\n");
  $self->log (2, "ISched:($self->{type}): Space to epoch today: $etoday\n");
  $self->log (2, "ISched:($self->{type}): $neverepoched never-epoched volumes found\n");

  $self->log (2, "ISched:($self->{type}): scheduling epochs at " . ctime() . "\n");

  # For an epoch day, schedule 1/nth of the atoms for epochs.  Choose
  # least recently backed up atoms first.  Epoch anything for which we
  # don't have an epoch on file.
  my ($today_count, $today_size) = (0,0);
  foreach $aname (sort {$lastepoch{$a} <=> $lastepoch{$b}} keys %lastepoch) {
    $atom = $self->{atoms}->{$aname};
    if ($etoday>0 || $lastepoch{$aname}==0) {
      $atom->level(0);
      $etoday -= $atom->epsize;
      $today_count++;
      $today_size += $atom->epsize;
    }
  }
  $self->log (2, "ISched:($self->{type}): Current cycle: $today_count atoms scheduled for epoch, $today_size total space\n");


  ############################################################################
  # Step 2.  Epoch 1/90 of all atoms not picked so far that were the
  # last epoch is >= 90 days old.  Always epoch where the
  # last epoch is >= 180 days old.
  $self->log (2, "ISched:($self->{type}): starting epoch replacement search at " . ctime () . "\n");
  %lastepoch = ();
  $eremain = 0;
  foreach $aname (keys %{$self->{atoms}}) {
    $atom = $self->{atoms}->{$aname};

    # Skip atoms already chosen for epoch above.
    ($atom->level() > -1) and next;

    $burec = $atom->lastBu(0);
    if (!defined $burec) {
      $self->error ("ISched:($self->{type}): Never-epoched atom " . $atom->commonName . "found in step 2 (this is BAD(tm))!");
      next;
    }
    $tepoch = $burec->{timestamp};

    if ($tepoch < $now - $reepoch) {
      $eremain += $atom->epsize;
      $lastepoch{$aname} = $tepoch;
    }
  }

  $self->log (2, "ISched:($self->{type}): Space with epochs >= 90 days: $eremain\n");
  $self->log (2, "ISched:($self->{type}): scheduling old epochs at " . ctime() . "\n");

  $etoday = $eremain/$self->reepochdays;

  ($today_count, $today_size) = (0,0);
  foreach $aname (sort {$lastepoch{$a} <=> $lastepoch{$b}} keys %lastepoch) {
    $atom = $self->{atoms}->{$aname};
    if ($etoday>0 || $lastepoch{$aname} < $now - 2 * $reepoch) {
      $atom->level(0);
      $etoday -= $atom->epsize;
      $today_count++;
      $today_size += $atom->epsize;
    }
  }
  $self->log (2, "ISched:($self->{type}): Old epochs: $today_count atoms scheduled for epoch, $today_size total space\n");

  ############################################################################
  # Step 3.  Delete everything that hasn't changed since being backed up.
  # Step 4.  Inc everything left.
  my $delatom = 0;
  my $incatoms = 0;
 INC: foreach $aname (keys %{$self->{atoms}}) {
    $atom = $self->{atoms}->{$aname};

    # Skip atoms already chosen for epoch above.
    ($atom->level() > -1) and next;

    if (defined ($mtime = $atom->data_last_update)) {
      foreach (@{$atom->history}) {
        if (($_->{result}    eq 'Success') &&
            ($_->{on_disk}   eq 'Yes') &&
            ($_->{timestamp} >  $mtime)) {
          $self->log (3, "Deleting atom " . $atom->commonName . ", (mtime (" . ctime ($mtime) . ") < lastbu (" . ctime ($_->{timestamp}) . ", level $_->{level}))\n");
          defined ($atom->id) and $atom->deleteAtoms;
          delete $self->{atoms}->{$aname};
	  $delatom++;
          next INC;
        }
      }
    }
    $atom->level(1);
    $incatoms++;
  }
  $self->log (3, "ISched:($self->{type}): Found $incatoms atoms to inc.\n");

  # Count the number of atoms at each level for instrumentation
  my %ttlatom;
  my $level;
  foreach $aname (keys %{$self->{atoms}}) {
    $atom = $self->{atoms}->{$aname};
    $level = $atom->level;
    defined $ttlatom{$level} or $ttlatom{$level} = 0;
    $ttlatom{$level}++;
    # Let the Atom module estimate the size and time for this backup
    $atom->estimateSize;
  }

  $self->log (2, "ISched:($self->{type}): Skipped $delatom atoms (not modified).\n");
  foreach $level (sort keys %ttlatom) {
    $self->log (2, "ISched:($self->{type}): Scheduled $ttlatom{$level} atoms at level $level.\n");
  }
  $self->log (2, "ISched:($self->{type}): Completed Interval Scheduler at " . ctime() . "\n");

  return 1;
}

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

sub writeAtoms {
  my $self = shift;

  ref ($self) or return 0;

  $self->log (2, "writeAtoms Started at " . ctime() . "\n");
  my $rows = 0;

  foreach (keys %{$self->{atoms}}) {
    $self->{atoms}->{$_}->state ('Pending');
    $self->{atoms}->{$_}->writeAtom;
    $rows++;
  }
  $self->log (2, "writeAtoms about to commit at " . ctime() . "\n");
  # $::sudbh->commit;
  $self->log (2, "writeAtoms Finished at " . ctime() . " ($rows atoms)\n");
  return $rows;
}

###############################################################################
# Create a DESTROY method for profiling
sub DESTROY { return; }

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

# These are the methods that just set (or report) a variable -- use autoload

sub debug;
sub interval;
sub now;
sub group;

sub AUTOLOAD {
  my $self = shift;
  my $value = shift;

  our $AUTOLOAD;

  ref($self) or return undef;

  $AUTOLOAD =~ /::DESTROY$/ and return undef;

  $AUTOLOAD =~ /::(debug|interval|now|group|reepochdays)$/ or return undef;
  my $var = $1;

  # Read-only
  $AUTOLOAD =~ /::group$/ and return $self->{$var};

  # Others are read-write
  defined ($value) and $self->{$var} = $value;
  return $self->{$var};
}

###############################################################################
# Always schedule epochs.  Guess at sizes...

sub scheduleEpoch {
  my ($self) = shift;

  ref($self) or return -1;

  $self->log (2, "Beginning epoch scheduler ($self->{type}) at " . ctime (time) . "\n");

  my $now = localtime(time);
  my ($mday,$mon,$year) = ($now->mday, $now->mon, $now->year);

  # Bound the atoms to be executed today only...
  my ($execute_before) = timelocal (0,45,23,$mday,$mon,$year) + 1;
  my ($execute_after)  = timelocal (0,0,0,$mday,$mon,$year) - 1;

  my ($aname, $atom);
  foreach $aname (keys %{$self->{atoms}}) {
    $atom = $self->{atoms}->{$aname};
    $atom->execute_before ($execute_before);
    $atom->execute_after  ($execute_after);
    $atom->level (0);
    $atom->estimateSize();
  }
  $self->log (2, "Finished epoch scheduler ($self->{type}) at " . ctime (time) . "\n");
}


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

# Schedule an epoch once each cycle.
# Rather than duplicating all the interval scheduler code, just call the
# interval scheduler and then delete the incs.

sub scheduleEpochOnly {
  my ($self) = shift;

  ref($self) or return -1;

  $self->log (2, "scheduleEpochOnly:($self->{type}): Calling Interval Scheduler\n");
  $self->scheduleInterval;
  $self->log (2, "scheduleEpochOnly:($self->{type}): Back from Interval Scheduler\n");

  # Now, delete the incs
  my ($aname, $atom);
  my $delincs = 0;
  foreach $aname (keys %{$self->{atoms}}) {
    $atom = $self->{atoms}->{$aname};
    if ($atom->level > 0) {
      delete $self->{atoms}->{$aname};
      $delincs++;
    }
  }

  $self->log (2, "scheduleEpochOnly:($self->{type}): Removed $delincs incs.\n");
  $self->log (2, "scheduleEpochOnly:($self->{type}): done at " .ctime() . "\n");
  return 1;
}

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


1;

