#!/usr/bin/env perl
our $VERSION = "0.50";

###############################################################################
### Configuration #############################################################
###############################################################################

our $TESTING = 0;
our $KEEP    = 5;		

our $COMPRESS = '';

our %SUFFIX  = ( 'gzip' => 'gz',   'bzip2' => 'bz2' );
our %PROGRAM = ( 'gzip' => 'gzip', 'bzip2' => 'bzip2' );

###############################################################################
### Declarations ##############################################################
###############################################################################

use strict;

use Getopt::Long;
use Pod::Usage;

###############################################################################
### main () ###################################################################
###############################################################################

my $parser = new Getopt::Long::Parser;
my $result = $parser->getoptions (
    'c|compress=s'  => \$COMPRESS,
    't|testing'     => \$TESTING,
    'k|keep=i'      => \$KEEP,
    'z'             => sub { $COMPRESS = 'gzip' },
    'man'           => sub { pod2usage (-verbose=>2) },
    'h|help'        => sub { pod2usage (-verbose=>1) }) || pod2usage (1);

pod2usage (1) unless scalar @ARGV;

foreach my $file (@ARGV) {
    rotate ($file, $KEEP, $COMPRESS);
}

exit 0;

###############################################################################
### Subroutines ###############################################################
###############################################################################

sub rotate {
    my ($file, $tokeep, $comp) = @_;
    return unless -f $file;
    my ($comp_prog, $comp_suffix);
    if ($comp) {
        die "No program known for compression type '$comp'\n"
            unless $comp_prog = $PROGRAM{$comp};
        die "No file suffix known for '$comp'\n" 
            unless $comp_suffix = $SUFFIX{$comp};
    }
    for (my $i = $tokeep; $i > 0; $i--) {
        my $j = $i+1;
        my $old = $comp ? "$file.$i.$comp_suffix" : "$file.$i";
        my $new = $comp ? "$file.$j.$comp_suffix" : "$file.$j";
        next unless -f $old;
        if ($tokeep <= $i) { _unlink ($old) }
        else               { _rename ($old, $new) }
    }
    if ($tokeep > 0) {
        my $new_temp = "$file.1";
        my $old_temp;
        if (-f $new_temp) { 
            $old_temp = "$new_temp.tmp";
            _rename ($new_temp, $old_temp);
        }
        _rename ($file, "$file.1");
        _compress ("$file.1", $comp_prog, $comp_suffix) if $comp_prog;
        _rename ($old_temp, $new_temp) if ($old_temp);
    } else { _unlink ($file) }
}

###############################################################################
### Internal Subroutines ######################################################
###############################################################################

sub _compress {
    my ($file, $program, $suffix) = @_;
    my $new = "$file.$suffix";
    if ($TESTING) {
        print "Would have compressed $file with $program\n";
        return 1;
    } 
    if (-f $new) { print "File already exists: $new\n" and return }
    unless (-f $file) { print "No such file: $file\n" and return }

    print "Compressing '$file' with '$program'\n";
    local $@;
    system ("$program $file");
    die "Error: $@\n" if $@;
    return 1;
}

sub _rename { 
    my ($old, $new) = @_;
    if ($TESTING) {
        print "Would have renamed $old to $new\n";
        return 1;
    } 
    if (-f $new)     { print "File already exists: $new\n" and return }
    unless (-f $old) { print "No such file: $old\n" and return }

    print "Renaming $old to $new\n";
    rename ($old, $new) or die "Error: $!\n";
    return 1;
}

sub _unlink {
    my ($file) = @_;
    if ($TESTING) { 
        print "Would have removed $file\n";
        return 1;
    }
    unless (-f $file) { print "No such file: $file\n" && return }
    unlink ($file);
    return 1;
}

###############################################################################
### Documentation #############################################################
###############################################################################

=head1 NAME

rotate_file

=head1 SYNOPSIS

B<rotate_file> I<FILE>

B<rotate_file> --compress I<COMPRESS_TYPE> I<FILE>

B<rotate_file> -z I<FILE>

=head1 DESCRIPTION

rotate_file renames the file I<FILE> to I<FILE.1>; if there is a file I<FILE.1>,
then we'll rename that to I<FILE.2>; etc, up to a set number of kept entries
(and larger numbers are deleted).  Additionally, we can compress the files as we
go with gzip or bzip2.

=head1 OPTIONS

=over 4

=item B<-c> I<COMPRESS_TYPE>, B<--compress> I<COMPRESS_TYPE>

Turns on compression of the files with the given I<COMPRESS_TYPE>.  Valid
options are 'gzip' and 'bzip2'.

=item B<-t>, B<--testing>

Testing mode; don't actually make any changes, just tell us what would have
happened.

=item B<-k> I<COUNT>, B<--keep> I<COUNT>

Number of records to keep.  Defaults to 5.

=item B<-z>

Same as B<--compress> I<gzip>

=item B<-h>, B<--help>

Prints out the synopsis information and exits.

=item B<--man>

Prints out a manual page and exits.

=back

=head1 TODO

Add '--date' option to just rename to the current date.

=head1 AUTHOR

Tim Skirvin <tskirvin@killfile.org>

=cut