[Freeciv-Dev] Re: (PR#3516) Save files to large and redundant

["Reinier Post" <rp@xxxxxxxxxx>]

On Wed, Feb 26, 2003 at 02:04:31AM -0800, ChrisK@xxxxxxxx wrote:

> What about a sensible method to get rid of old savegames,
> e.g. rm *.sav.gz ? ;-)
> 
> Or write a script that keeps 3 savegames for each seed and deletes
> everything else.

Attached.  I haven't used this in a while but it is expected to work.

-- 
Reinier

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

# $Id: civgame-clean,v 1.4 2003/02/26 10:48:57 gamecvs Exp $
#
# issued under the GNU license; if you modify this script, please notify
# the author: reinpost@xxxxxxxxxx (Reinier Post)
#
# should run under any Perl 5 or higher

use strict;

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;

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

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

my @args = ();
my $inopts = 1;
while (my $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)

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

  if (-d $arg)
  {
    opendir(DIR,$arg) || die("$0: fatal error: cannot open directory $arg\n");
    my @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([-+]?\d+)\.sav(.gz)?$#)
  {
    $year{$arg} = 0 + $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 ---#
#

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


#--- mark all years that would be saved with saveturns set to $freq ---#
#
# this is version dependent!  but it doesn't change very often
#

my %freqsaved;

for (my $i = 0, my $year = -4000;
     $year <= $maxyear;
     ++$i, $year += ($year < 1000 ? 20 : $year < 1500 ? 10 :
                         $year < 1700 ? 5 : $year < 1800 ? 2 : 1))
{
  $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)
{
  my %foundoneindir;
  foreach (sort {$year{$b} <=> $year{$a}} keys(%year))
  {
    my $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 (my ($file,$year) = each(%year))
  {
    unlink($file) unless $freqsaved{$year{$file}};
  }
}