#!/usr/bin/perl

=head1 NAME

BASTRAMA - Backup Strategy Manager

=head1 SYNOPSIS

	bastrama.pl -n2 -k2 "hd1*.gz" "hd2*.gz" "hd3*.gz"
	bastrama.pl -n2 -k2 -c100

=head1 DESCRIPTION

The Backup Strategy Manager is a command-line tool to manage
backup files that are stored on random access memory (eg. hard drives).
It implements an infinite grandfather-father-son-etc strategy by deleting
excess files, therefore saving storage space while still keeping some of
the older backups in case something went wrong (and needs to be restored from)
a long time ago.

=head1 ARGUMENTS & OPTIONS

Bastrama takes as argument one or more fileglobs, each fileglob
describing files that are to be treated as one backup set.
(Remember to quote them, so that they won't be expanded by the shell.)

Every set of files is numbered by Bastrama, then some of the files are
marked to delete, according to the specifications of the selected strategy.

Recommended options:

=over

=item -n

specifies the amount of children every element of the tree has.
Default is 3.

=item -k

specifies how many files are kept from each level of the tree.
Must be equal or larger than n. Default is n.

=item -l

specifies maximal depth of tree. Default is infinite. (Other than
infinite isn't implemented, yet.)

=back

Optional options:

=over

=item --calc nnn | -c nnn

calculates from nnn files, which files would be deleted for given
n, k and l. No further action is taken.

=item --delete | -d

delete files. Default is not deleting, just adding .delete suffix
to files.

=item --force | -f

force file deletions even if Bastrama senses the possibility of trouble.

=item --undelete | -u

removes the .delete suffix from files. (This is done before anything
else.)

=back

=head1 EXIT CODES

=over

=item exit code 0

Everything worked alright.

=item exit code 1

One or more arguments had no wildcards in them. You probably forgot to
escape them from the shell.

=item exit code 2

One or more fileglobs came up empty.

=back

=head1 TODO

=over

=item *

Make renames safe

=item *

Increase time accuracy

=item *

Make --level param work

=item *

Add filename DB instead of numbering the files (as an option)

=item *

Polish interface. (Better error handling, better messages, etc.)

=back

=head1 AUTHOR & COPYRIGHT

Copyright 2002 Thiemo Nagel (thiemonagel@gmx.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

=cut

use warnings;
use strict;

use Getopt::Long;

my $version = '0.11';
my $eval = 0;

# Subroutine prototypes
sub EnforceStrategy ($$%);
sub ReadFileSequence ($);

# make STDOUT hot
 { my $ofh = select STDOUT;
	  $| = 1;
	  select $ofh;
	}

Getopt::Long::Configure('bundling');
GetOptions(
	'n=i'				=> \(my $opt_n),			# n
	'keep|k=i'		=> \(my $opt_keep),		# keep
	'levels|l=i'	=> \(my $opt_levels),	# levels
	'calc|c=i'		=> \(my $opt_calc),		# calculate space needed after x backups
	'delete|d'		=> \(my $opt_delete),	# perform deletes instead of renaming to .delete
	'force|f'		=> \(my $opt_force),		# ignore warnings
	'version|v'		=> \(my $opt_version),	# display version
	'undelete|u'	=> \(my $opt_undelete), # removes .delete suffix from files
);

if (defined $opt_version) {
	print "Bastrama $version - Backup Strategy Manager\n"
}

my $trouble;

if (! defined $opt_n) {
	$trouble = 1;
	$opt_n = 3;
	print "Setting n to $opt_n (might be trouble).\n";
}
die ("-n must be > 1!\n") if $opt_n < 2;

if (! defined $opt_keep || $opt_keep < $opt_n) {
	$trouble = 1;
	$opt_keep = $opt_n;
	print "Setting k to $opt_keep (might be trouble).\n";
}

if (! defined $opt_levels) {
	$trouble = 1;
	$opt_levels = 0;
	print "Setting levels to infinite (might be trouble).\n";
}

if (defined $opt_calc) {
	my $n = $opt_n;
	my %KeepNums;			# Numbers of files to keep

	$KeepNums{0} = 1;
	{
		my $a = $opt_calc;
		my $exp = 1;
		while ($a > 0) {
			for (my $b=0; $b < $opt_keep; $b++) {
				$KeepNums{$a-$b*$exp} = 1 if $a-$b*$exp >= 0
			}
			$exp *= $n;
			$a -= $a % $exp;
		}
	}

	my $kept = keys %KeepNums;

	print "After $opt_calc backup cycles, these $kept files will be kept for n=$opt_n and k=$opt_keep:\n";
	print "#\t\tage in cycles\n";

	foreach my $num (sort {$a <=> $b} keys %KeepNums) {
		printf "%6i\t\t%6i\n", $num, $opt_calc-$num
	}

	exit 0

}

if (scalar(@ARGV) == 0) {
	die "One or more fileglobs is needed as argument."
}

print "Trouble: No files will be deleted except if --force specified.\n"
	if $trouble && ! $opt_force;

{
	my $esc_forgot = 0;
	while (my $glob = shift @ARGV) {
		if ($glob =~ m/[*?{\[]/) {
			EnforceStrategy($opt_n, $opt_keep, ReadFileSequence ($glob))
		} else {
			$eval = 1 unless $eval;
			unless ($esc_forgot) {
				print "Gotcha! You need to escape your fileglob from the shell!\n";
				print "Skipping all arguments that don't contain at lease one out of: * ? { [\n";
			}
			$esc_forgot = 1
		}
	}
}


exit($eval);



# Reads files that are matching the fileglob and renames
# them to include the [BASTRAMAxx] signature and outputs
# a hash of filenames with their corresponding numbers
sub ReadFileSequence ($) {
	my $fileglob = shift;

	my %UnnumberedFiles;
	my %NumberedFiles;

	my $latest_numbered=100000;
	my $earliest_unnumbered=-1;
	my $filecount;

	# Read files and sort by numbered (with BASTRAMA sig) and not
	# numbered (without BASTRAMA sig)
	while (glob ($fileglob)) {
		next unless -f $_;
		$filecount++;
		if (m/\[BASTRAMA(\d+)]/) {
			$NumberedFiles{$_} = 0 + $1;
			$latest_numbered = -M $_ if -M $_ < $latest_numbered;
		} else {
			$UnnumberedFiles{$_} = -M $_;
			$earliest_unnumbered = -M $_ if -M $_ > $earliest_unnumbered;
		}
	}

	if ($filecount == 0) { $eval = 2 }

	if ($latest_numbered < $earliest_unnumbered) {
		$trouble = 1;
		print "Trouble: Time inconsistence\n"
	}

	# Determine max number of numbered files
	my $maxnum = -1;
	foreach my $file (keys %NumberedFiles) {
		if ($NumberedFiles{$file} > $maxnum) { $maxnum = $NumberedFiles{$file} }
	}

	# Sorting unnumbered files by file date
	my @SortedUnnumbered = sort
									{ $UnnumberedFiles{$b} <=> $UnnumberedFiles{$a} }
									keys %UnnumberedFiles;

	# Rename files without [BASTRAMAxx] signature
	{
		my $a = $maxnum+1;
		foreach my $file (@SortedUnnumbered) {
			(my $head, my $tail) = split (/\./, $file, 2);
			if (defined $tail) { $tail = ".$tail" }
			else { $tail = '' }
			my $newname = $head.'[BASTRAMA'.sprintf('%04i',$a).']'.$tail;
			print "Adding sig: $newname\n";
			rename($file, $newname);
			$NumberedFiles{$newname} = $a;
			$a++;
		}
	}

	# return hash of filenames and their number
	return %NumberedFiles;

}


sub EnforceStrategy ($$%) {
	my $n = shift;
	my $keep = shift;
	my %Files = @_;

	my $maxnum = -1;
	foreach my $file (keys %Files) {
		if ($Files{$file} > $maxnum) { $maxnum = $Files{$file} }
	}

	my %KeepNums;			# Numbers of files to keep
	$KeepNums{0} = 1;
	{
		my $a = $maxnum;
		my $exp = 1;
		while ($a > 0) {
			for (my $b=0; $b < $keep; $b++) {
				$KeepNums{$a-$b*$exp} = 1
			}
			$exp *= $n;
			$a -= $a % $exp;
		}
	}

	# Delete all that are not kept...
	foreach my $file (sort { $Files{$a} <=> $Files{$b} } keys %Files) {
		next if exists $KeepNums{$Files{$file}};
		if ($opt_delete && ! $trouble || $opt_delete && $opt_force) {
			print "Deleting $file (#$Files{$file})...";
			if (unlink($file)) { print "ok.\n" }
			else { print "failed.\n" }
		} else {
			print "Marking $file (#$Files{$file}) for deletion.\n";
			rename ($file, "$file.deleted") unless $file =~ m/\.deleted$/
		}
	}
}

sub Undelete($) {
	my $fileglob = shift;

	while (glob ($fileglob)) {
		if (-f && m/^(.*)\.deleted$/) {
			rename $_, $1
		}
	}
}