#!/usr/bin/perl

use strict;
use warnings;

my ($file, $max) = @ARGV;
my ($base, $ext) = split (/\./, $file);

for my $f (reverse <$base.*.$ext>) {
  next unless ($f =~ /\.([0-9]{4})\./);
  my $i = $1;  # grab number we just matched into $i
  if ($i >= $max) {
    unlink $f or warn "$0: Could not remove $f: $!\n";
    next;
  }
  # else
  my $n = sprintf "%s.%04i.%s", $base, $i+1, $ext;
  rename $f, $n or warn "$0: Could not rename $f to $n: $!\n";
}

rename $file, "$base.0001.$ext"
  or warn "$0: Could not rename $file to $base.0001.$ext: $!\n";

# Split Filename From Extention
  my ($base, $ext) = split (/\./, $argFileName);
# Check For File Extension
  $HaveExt = ( ( length $ext ) < 1 ? "Y" : "N" );

  $ext = "" . $ext;

$var ||= "";

$var = "" unless defined $var;

#!/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";
};