#!/usr/bin/perl -w
# cleanscore - Remove expired entrys from slrn's Scorefile.

# Copyright (c) 1999 - 2001 Felix Schueller <fschueller@netcologne.de>
# 
# 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.
#     
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
# more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.   

use Fcntl qw(:DEFAULT :flock);

sub help();
sub reset_vars();
sub insert_comment();
sub end_of_score();
sub clean_file($);

$version="0.9.8.0";
$DEBUG = 0;
$remove_comments = 0;
$max_empty_lines = -1;
$VERBOSE = 0;
$keep = 0;
$test_only = 0;
$save_file = "";
$bak_ext = ".bak";
$ign_pat = "";

require "getopts.pl"; &Getopts('b:de:f:hi:k:hrs:tVv');
if (defined($opt_b)) {$bak_ext = $opt_b;}
if (defined($opt_d)) {$DEBUG = $opt_d;}
if (defined($opt_e)) {$max_empty_lines = $opt_e;}
if (defined($opt_h)) {help(); exit(0);}
if (defined($opt_i)) {$ign_pat = $opt_i;}
if (defined($opt_r)) {$remove_comments = $opt_r;}
if (defined($opt_s)) {$save_file = $opt_s;}
if (defined($opt_t)) {$test_only = $opt_t;}
if (defined($opt_k)) {$keep = $opt_k * 86400;}
if (defined($opt_v)) {$VERBOSE = $opt_v;}
if (defined($opt_V)) {print ("cleanscore - Version: $version (bugreports to: fschueller\@netcologne.de)\n"); exit(0);}
$opt_h = $opt_V; # suppress 'perl -w' warnings.

if (defined($opt_f))
  {
    ($target = $opt_f) =~ s#/$##g;
  }
else
  {
    print("You must specify a scorefile with the '-f scorefile' option.\n");
    print("Try 'cleanscore -h' for a more detailed help\n");
    exit 1;
  }
  
if ($DEBUG)
  {
    print ("Version: $version\n");
    if (defined($opt_k)) {print ("Keep: $keep ($opt_k)\n");}
    print ("\n");
  }

if (-f $target)
  {
    clean_file($target);
  }
elsif (-d $target)
  {
    my $bak_pat=$bak_ext;
    opendir(SCOREDIR, $target) || die ("Can't open $target: $!");
    # escape characters with special meaning.
    $bak_pat=~ s/\./\\./g;
    foreach (readdir(SCOREDIR))
      {
        if (/^\.\.?$/) {next;} # skip '.' and '..' 
	if (/$bak_pat$/o) {next;} # skip $bak_ext
	if ($ign_pat) { if (/$ign_pat$/o) {next;} };
	unless ( -f "$target/$_") {next;} # skip everything that is not a normal file.
	clean_file("$target/$_");
      }
  }

############################ END OF MAIN ###############################

sub clean_file($)
{
  my $score_file = shift;
  my (@ak_date, $ak_year, $ak_month, $ak_day);
  my ($day, $month, $year);
  my $prev_empty_lines=0, $group= -1;

  
  if ($DEBUG)
  {
    print ("\nScorefile: $score_file\n");
    print ("Dates: Entry / System");
    if ($keep) {print (" - $opt_k Days");}
    print ("\n\n");
  }

  @ak_date = localtime (time - $keep);
  $ak_year = ($ak_date[5] + 1900);
  $ak_month = ($ak_date[4] + 1);
  $ak_day = $ak_date[3];

  unless ($test_only)
    {  
      sysopen (SCORE, "$score_file", O_RDWR) || die ("Can't open $score_file: $!");
      flock (SCORE, LOCK_EX | LOCK_NB) || die ("Can't lock $score_file: $!");
      sysopen (OUT, "$score_file.cs", O_RDWR | O_CREAT) || die ("Can't open $score_file.cs: $!");
      $file_is_changed=0;
    }
  else
    {
      open (SCORE, "$score_file") || die ("Can't read $score_file: $!");
    }

  reset_vars();
  @$comment = "";
  $co_line = 0;

  #Magic starts here
  while (<SCORE>)
    {
      # Removing empty lines is a problem, we don't know to whitch entrie they belong.
      # So we provide the an option to cut multiple empty lines down to $max_empty_lines 
      if ($max_empty_lines >= 0) 
        {
          if (/^\s*$/)
            {
	      if ($prev_empty_lines==$max_empty_lines)
	        {
	          $file_is_changed=1;
		  next;
	        }
	      else
	        {
	          $prev_empty_lines++;
	        }
	    }
          else
            {
	      if ($prev_empty_lines)
	        {
	          $prev_empty_lines=0;
	        }
	    }
        }
	
      if ($remove_comments) # Remove '%' comments
        {
          if (/^\s*%/)
            {
              if ($VERBOSE || $DEBUG) {print ($_);}
              $file_is_changed=1;
	      next;
            }
        }
  
      if (/\%EOS/ || /#EOS/)
        {
          $comment[$co_line] = $_;
          $co_line++;
          insert_comment();	    
          end_of_score();
          next;
        }
  
      if (/\%BOS/ || /#BOS/)
        {
          insert_comment();
          end_of_score();
          $seen_bos = 1;
        }
  
      if (/^\s*%/ || /^\s*#/ || /^\s*$/)  # put comments in an extra array
        {
          $comment[$co_line] = $_;
          $co_line++;
          next;
        }

      if (/Expires:/i)
        {
          if (/\d{1,2}-\d{1,2}-\d{4}/)
            {
              ($day, $month, $year) = /(\d{1,2})-(\d{1,2})-(\d{4})/;
            }
          else
            {
              ($month, $day, $year) = m#(\d{1,2})/(\d{1,2})/(\d{4})#;
            }
          if ($DEBUG)
            {
              print ("Year: $year / $ak_year\n");
              print ("Month: $month / $ak_month\n");
              print ("Day: $day / $ak_day\n");
            }
          if ($year < $ak_year)
            {
              $is_expired = 1;
            }
          elsif ($year == $ak_year)
            {
              if ($month < $ak_month)
	        {
                  $is_expired = 1;
                }
  	      elsif ($month == $ak_month)
  	        {
                  if ($day <= $ak_day) {$is_expired = 1;}
                }
            }
          if ($DEBUG && $is_expired) {print ("Entry is expired\n");}
        }

      if (/^\S*\[.*\]\S*$/)  # Found a new groupexpression - entry ends here
        {
          #unless ($seen_bos)
            #{
	  end_of_score();
          insert_comment();
	    #}
          $group=$sc_line;
        }
  
      if (/Score:/i)
        {
          if ($seen_score) #there was a 'Score:' before entry ends here
            {
              if ($is_expired && $group >= 0) # Save Groupexp if necessary
                {
	          unless ($test_only) {print (OUT $ak_score[$group]);}
                }
              end_of_score();
              insert_comment();
              $group = -1;
            }
          $seen_score = 1;
        }
      insert_comment();
      $ak_score[$sc_line] = $_;
      $sc_line++;
    } #while (<SCORE>)

  end_of_score();
  insert_comment();
  end_of_score();

  unless ($test_only)
    {
      if ($file_is_changed)
        {
          # $score_file.cs contains the new scorefile $score_file the old.
          
	  # copy $score_file to $score_file$bak_ext
          seek (SCORE, 0, 0) || die ("Can't rewind $score_file: $!");
          open (DEST, ">$score_file$bak_ext") || die ("Can't write $score_file$bak_ext: $!");
          while (<SCORE>) {print (DEST $_);}
          close (DEST);
          
	  # copy $score_file.cs to $score_file
          seek (SCORE, 0, 0) || die ("Can't rewind $score_file: $!");
          truncate (SCORE, 0);
          seek (OUT, 0, 0) || die ("Can't rewind $score_file.cs: $!");
          while (<OUT>) {print (SCORE $_);}
        }
      close (OUT);
      if (-e "$score_file.cs") { unlink("$score_file.cs")};
    }
  close (SCORE);
} #sub clean_file($)

sub end_of_score()
{
  unless ($is_expired || $test_only)
    {
      print (OUT @ak_score);
    }
  else
    {
      $file_is_changed=1;
      if ($save_file && $is_expired)
        {
	  open (SAVE, ">>$save_file") || die ("Can't append to $save_file: $!");
	  print (SAVE @ak_score);
	  close (SAVE);
	}
      if ($VERBOSE || $DEBUG)
        {
          print (@ak_score);
          print ("\nNext Entry:\n\n");
        }
    }
  reset_vars();
} #sub end_of_score()

sub insert_comment()
{
  if ($co_line)
    {
      for ($i=0; $i < $co_line; $i++)
        {
          $ak_score[$sc_line] = $comment[$i];
          $sc_line++;
        }
    }
  $co_line = 0;
  @comment = "";
}

sub reset_vars()
{
  @ak_score ="";
  $is_expired = 0;
  $seen_bos = 0;
  $seen_score = 0;
  $sc_line = 0;
}

sub help()
{
  print <<EOF;
cleanscore - Remove expired entries from slrn's Scorefile.

   -V              "Version."  Print Version and exit.
   -h              "Help".     Prints a help message.


   -b <extension>  "Backup extention".   Overwrites the default backup-
                   extention ('.bak')
		   
   -d              "Debug."    Prints dates and status for each entry.

   -e n            "Empty lines." Cut multiple empty lines down to N.
   
   -f <filename>   "File".   Chose "filename" for cleaning.   **Required**
                             If "filename" is a directory
			     clean all files in it.

   -i <pattern>    "Ignore pattern".   When scanning through a directory
                   ignore files with names matching "pattern".
		   The "backup extention" is matcht automaticly.
		   
   -k n            "Keep for N days".
                   Do not remove expired entries, but instead hold them
                   for N more days.  This allows to keep expired entries
                   so you can still edit them, eg. change the expiry date.

   -r              "Remove".  Removes comment lines, i.e. lines beginning
                   with '%'. (e.g. remove slrn generated comments
                   when you use '#' for your own comments).
 
   -s <filename>   "Save to". Save removed entries to "filename".

   -t              "Test".  Just check for expired entries
                   but do not change the scorefile.
                   Make sense with options -v or -d only.

   -v              "Verbose".  Prints all expired entries to stdout.
EOF
}
