#! /usr/bin/perl

# Copyright (C) 2005  Nick Urbanik <nicku@nicku.org>

# 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 warnings;
use strict;
use File::Find ();
use File::Copy;
use constant MAIL_HOME => "$ENV{HOME}/Mail";

# Avoid rotating too aggressively, as discussions get too disjointed:
use constant MIN_SIZE_BEFORE_ROTATE => 10000000;

# There is no point in rotating mail files that are not receiving more mail:
use constant MAX_AGE_DAYS_TO_ROTATE => 40;

sub find_highest_suffix($$$) {
    my ( $dir, $basename, $dot_dash ) = @_;
    my $counter = 1;
    my $targetbase;
    for ( $targetbase = "$basename$dot_dash$counter"; -e "$dir/$targetbase";
          ++$counter, $targetbase = "$basename$dot_dash$counter" ) {
    }
    return --$counter;
    #print "$dir/$targetbase does not exist\n" unless -e "$dir/$targetbase";
    #print "\$dir/\$targetbase = '$dir/$targetbase', counter = $counter\n";
    #return $counter;
}

# Example:
# Identify that of all files matching Index-(\d+), Inbox-3 has the highest.
# Return 3.
# We assume that no file ends in "-0".
# return 0 if no files match m!$dir/$basename-(\d+)$!
sub find_highest_dash_number($$) {
    my ( $dir, $basename ) = @_;
    return find_highest_suffix $dir, $basename, '-';
}

sub find_highest_dot_number($$) {
    my ( $dir, $basename ) = @_;
    return find_highest_suffix $dir, $basename, '.';
}

sub move_report($$) {
    my ( $source, $target ) = @_;
    if ( -e $target ) {
        warn "$target already exists; not overwriting it.\n";
        return;
    }
    if ( move( $source, $target ) ) {
        #if ( 1 ) {
        print "Moved $source to $target\n";
    } else {
        warn "Unable to move $source to $target\n";
    }
}

# Example:
# Inbox-3 -> Inbox.n (where n is minimum where Inbox.n does not exist),
# Inbox-2 -> Inbox.n (where n is minimum where Inbox.n does not exist),
# Inbox-1 -> Inbox.n (where n is minimum where Inbox.n does not exist),
# i.e.,
# Inbox-3 -> Inbox.2
# Inbox-2 -> Inbox.3
# Inbox-1 -> Inbox.4
sub fix_original_rotations($$) {
    my ( $dir, $basename ) = @_;
    my $dotcounter  = find_highest_dot_number  $dir, $basename;
    my $dashcounter = find_highest_dash_number $dir, $basename;
    # print "highest dash number = $dashcounter\n";
    for ( ++$dotcounter; -e "$dir/$basename-$dashcounter"
          and not -e "$dir/$basename.$dotcounter";
          --$dashcounter, ++$dotcounter ) {
        my $source = "$dir/$basename-$dashcounter";
        my $target = "$dir/$basename.$dotcounter";
        move_report $source, $target;
    }
    return 1;
}

# Example:
# Inbox.14 -> Inbox.15, Inbox.13 -> Inbox.14, ..., Inbox -> Inbox.1
sub rotate_names($$) {
    my ( $dir, $basename ) = @_;
    unless ( -e "$dir/$basename.1" ) {
        move_report "$dir/$basename", "$dir/$basename.1";
        return 1;
    }
    my $counter = find_highest_dot_number  $dir, $basename;
    # print "highest dot number = $counter\n";
    for ( ; $counter > 0 and -e "$dir/$basename.$counter"
          and not -e "$dir/$basename." . ( $counter + 1 );
          --$counter ) {
        my $source = "$dir/$basename.$counter";
        my $target = "$dir/$basename." . ( $counter + 1 );
        move_report $source, $target;
    }
    move_report "$dir/$basename", "$dir/$basename.1";
    return 1;
}

sub target_name($$) {
    my ( $dir, $basename ) = @_;
    my $counter = 1;
    my $targetbase;
    for ( $targetbase = "$basename-$counter"; -e "$dir/$targetbase";
          ++$counter, $targetbase = "$basename-$counter" ) {
    }
    return "$dir/$targetbase";
}

# for the convenience of &wanted calls, including -eval statements:
use vars qw/*name *dir *prune/;
*name   = *File::Find::name;
*dir    = *File::Find::dir;
*prune  = *File::Find::prune;

sub wanted {
    # my ($dev,$ino,$mode,$nlink,$uid,$gid, $target);
    my $basename = $_;
    # All base names (never yet rotated) end with a non-digit:
    return unless /^[^.].*[^\d]\z/s;
    return unless my ( $dev, $ino, $mode, $nlink, $uid, $gid )
        = lstat "$dir/$basename";

    fix_original_rotations( $dir, $basename );
    print "$dir/$basename: size ", -s "$dir/$basename", "\n";
    return unless -s "$dir/$basename" > MIN_SIZE_BEFORE_ROTATE;
    ( -M _ < MAX_AGE_DAYS_TO_ROTATE ) &&
    rotate_names( $dir, $basename );
    # print("\$basename=$basename, \$dir=$dir, \$name=$name\n");
}



# Traverse desired filesystems
File::Find::find( { wanted => \&wanted }, MAIL_HOME );
exit;