#!/usr/bin/perl
#
# civgame-clean - reduce the number of Freeciv savefiles
#
# for usage informatiuon, call me without arguments or options

# $Id: civgame-clean,v 1.1$
#
# if you modify this script, please notify
# the author: reinpost@xxxxxxxxxx (Reinier Post)
#
# should run under Perl 4.036 or any Perl 5

sub usage
{
  print <<ZZ;

Usage:	$0 [-nrl] -# [arg [arg [...]]]

  where args are Freeciv savefiles or directories containing them,
    and # is a positive number
  
  deletes those savefiles that civserver saves with saveturns set to 1,
    but not with saveturns set to #

  without arguments, defaults to .

  without the -l option, never deletes the savefile with the highest year
    (determined per directory)

  with the -r option, descends recursively through subdirectories

  with the -n option, only shows what would be deleted

  the -# option is required; options must precede arguments


  recommended use (when a civserver is running):

     sh -c 'while sleep 100; do $0 -1000; done' &

ZZ
  exit(1);
}


#--- cmdline parse ---#
#

@ARGV || &usage;

$recursive = 0;
$justshow = 0;
$savelatest = 1;

$freq = 0;  # an impossible value; 1 is possible

@args = ();
$inopts = 1;
while ($arg = shift(@ARGV))
{
  if ($inopts)
  {
    if ($arg =~ /^-[nrl]+$/)
    {
      $justshow   = 1 if $arg =~ /n/;
      $recursive  = 1 if $arg =~ /r/;
      $savelatest = 0 if $arg =~ /l/;
      next;
    }
    elsif ($arg =~ /^-/)
    {
      ($arg =~ /^-([1-9]\d*)$/ && ($freq = $1)) || &usage;
      next;
    }
    else
    {
      $inopts = 0;
    }
  }

  # (!$inopts)
  &usage if $arg =~ /^-/;

  push(@args,$arg);
}

$freq || &usage;

@args = ('.') if !@args;


#--- collect filenames ---#
#
# store all files of the form saved by freeciv, recording their year;
# for directories, use their files (non-recursively)

undef(%year);
while (@args)
{
  $arg = shift(@args);

  if (-d $arg)
  {
    opendir(DIR,$arg) || die("$0: fatal error: cannot open directory $arg\n");
    @itsfiles = readdir(DIR);
    closedir(DIR) || die("$0: fatal error: cannot close directory $arg\n");

    if (@itsfiles)
    {
      push(@args,
       grep(!/^\.\.?$/ && ($_ = "$arg/$_") && (-f $_ || ($recursive && -d $_)),
        @itsfiles));
    }
  }
  elsif (-f $arg && $arg =~ m#(.*/)?civgame(-?[1-9]\d*)\.sav$#)
  {
    $year{$arg} = $2;
  }
}

if (!%year)
{
  warn("no savefiles of the required form were found\n") if $justshow;
  exit(0);
}

#--- determine the maximum year we need to consider ---#
#

$maxyear = -4000;
foreach $year (values(%year))
{
  $maxyear = $year if $year > $maxyear;
}


#--- mark all years that would be saved with saveturns set to $freq ---#
#

undef(%freqsaved);

for ($i = 0, $year = -4000;
     $year <= $maxyear;
     ++$i, $year += ($year < 1000 ? 20 : $year < 1500 ? 10 : 5))
{
  $freqsaved{$year || 1} = 1  unless $i % $freq;
}


#--- also mark the latest savefile in each directory, if requested ---#
#
# bug: treats the same directory under different names as different
#
if ($savelatest)
{
  undef(%foundoneindir);
  foreach (sort {$year{$b} <=> $year{$a}} keys(%year))
  {
    $mydir = m#^(.*)/# ? $1 : '.';
    next if defined($foundoneindir{$mydir});

    $foundoneindir{$mydir} = 1;

    $freqsaved{$year{$_} || 1} = 1;
  }
}

#--- remove all saved games corresponding to unmarked years ---#
#

if ($justshow)
{
  foreach (sort {$year{$a} <=> $year{$b}} keys(%year))
  {
    warn(($freqsaved{$year{$_}} ? '# not:  ' : '') . "rm $_\n");
  }
}
else
{
  while (($_,$year) = each(%year))
  {
    unlink($_) unless $freqsaved{$year{$_}};
  }
}