#!/usr/bin/perl

use strict;
use warnings;

# Get The Argument List
  my ($argFileName, $argMaxCount) = @ARGV;

# End Run If We Don't Have At Least 2 Arguments
  die " - Usage : $0 <FileName> <ArchiveCount>\n" if $#ARGV < 1;

# Check For Valid Arguments
  die " - $0: FileName:  $argFileName does NOT exist\n" unless ( -e $argFileName );
  die " - $0: ArchiveCount:  $argMaxCount is less than 1\n" if ( $argMaxCount < 1 );

# Split Filename From Extention
  my ($base, $ext) = split (/\./, $argFileName);

# Check For File Extension And Add "."
  $ext = ( ( defined $ext ) ? ( "." . $ext ) : "" );

# Rename The Files
  &myRename;

# Rename The Subfile Dictionaries As Well 
  if ( $ext eq ".sf" ) {
    warn "\n - Processing Subfile Dictionaries:\n\n";
    $ext = ".sfd";
    &myRename;
  }

# End Processing
exit;

sub myRename
{
  # Get File List In Reverse Order

  for my $curFile ( reverse <$base*$ext> ) {
  # Skip Non-Matching Extentions
    my ($curBase, $curExt) = split (/\./, $curFile);
    $curExt = ( ( defined $curExt ) ? ( "." . $curExt ) : "" );
    next unless $ext eq $curExt;

  # Skip Non-Version File Names
    next unless ( $curFile =~ /$base\_([0-9]{4})$ext/ );

  # Save This Version Number
    my $fileVersionNum = $1;  # Grab Number We Just Matched Into $fileVersionNum

  # Purge All Matching File Versions >= The Max Counter
    if ( $fileVersionNum >= $argMaxCount ) {
      warn " - Removing - $curFile\n";
      unlink $curFile or warn " - $0: Could not remove $curFile: $!\n";
      next;
    };
    # else
    my $newFile = ( sprintf "%s_%04i%s", $base, $fileVersionNum+1, $ext );
    warn " - Renaming - $curFile -> $newFile\n";
    rename $curFile, $newFile or warn " - $0: Could not rename $curFile to $newFile: $!\n";
  };

  my $oldFile = ( sprintf "%s%s", $base, $ext );
  my $newFile = ( sprintf "%s_%04i%s", $base, 1, $ext );
  warn " - Renaming - $oldFile      -> $newFile\n";
  rename ( $oldFile, $newFile ) or warn " - $0: Could not rename $oldFile to $newFile: $!\n";
};