package File::Backup;
use strict;
use warnings;
use File::Copy;
use File::Temp;
use File::Basename;
use Exporter;
use re '/aa';
use Carp;
use Errno;

our $VERSION = '1.00';
our @ISA = qw(Exporter);
our @EXPORT = qw(BACKUP_NONE
                 BACKUP_SINGLE
                 BACKUP_SIMPLE
                 BACKUP_NUMBERED
                 BACKUP_AUTO
                 backup);

our @EXPORT_OK = qw(backup_simple backup_numbered backup_auto);

use constant {
    BACKUP_NONE => 0,         # No backups at all (none,off)
    BACKUP_SINGLE => 1,       # Always make single backups (never,simple)
    BACKUP_SIMPLE => 1,
    BACKUP_NUMBERED => 2,     # Always make numbered backups (t,numbered)
    BACKUP_AUTO => 3          # Make numbered if numbered backups exist,
	                      # simple otherwise (nil,existing)
};

my %envtrans = (
    none => BACKUP_NONE,
    off => BACKUP_NONE,
    never => BACKUP_SIMPLE,
    simple => BACKUP_SIMPLE,
    t => BACKUP_NUMBERED,
    numbered => BACKUP_NUMBERED,
    nil => BACKUP_AUTO,
    existing => BACKUP_AUTO
);

my %backup_func = (
    BACKUP_NONE() => sub {},
    BACKUP_SIMPLE() => \&backup_simple,
    BACKUP_NUMBERED() => \&backup_numbered,
    BACKUP_AUTO() => \&backup_auto
);

sub backup {
    my ($file, $type) = @_;
    unless (defined($type)) {
	my $v = $ENV{VERSION_CONTROL} || BACKUP_AUTO;
	if (exists($envtrans{$v})) {
	    $type = $envtrans{$v};
	} else {
	    $type = BACKUP_AUTO;
	}
    }    
    &{$backup_func{$type}}($file);
}

sub backup_simple {
    my ($file_name) = @_;
    my $backup_name = $file_name . '~';
    copy($file_name, $backup_name)
	or croak "failed to copy $file_name to $backup_name: $!";
    return $backup_name;
}

sub backup_numbered_opt {
    my ($file_name, $if_exists) = @_;

    my $fh = File::Temp->new(DIR => dirname($file_name));
    copy($file_name, $fh) or
	croak "failed to make a temporary copy of $file_name: $!";

    my $num = (sort { $b <=> $a }
	       map {
		   if (/.+\.~(\d+)~$/) {
		       $1
		   } else {
		       ()
	           }
               } glob("$file_name.~*~"))[0];

    if (!defined($num)) {
	return backup_simple($file_name) if $if_exists;
	$num = '1';
    }
    
    my $backup_name;
    while (1) {
	$backup_name = "$file_name.~$num~";
	last if symlink($fh->filename, $backup_name);
	unless ($!{EEXIST}) {
	    croak "can't link ".$fh->filename." to $backup_name: $!";
	}
	++$num;
    }
    
    unless (rename($fh->filename, $backup_name)) {
	croak "can't rename temporary file to $backup_name: $!";
    }
    return $backup_name;
}

sub backup_numbered {
    my ($file_name) = @_;
    backup_numbered_opt($file_name, 0);
}

sub backup_auto {
    my ($file_name) = @_;
    backup_numbered_opt($file_name, 1);
}
    
1;
__END__

=head1 NAME

File::Backup - create a backup of the file.
    
=head1 SYNOPSIS

    use File::Backup;

    $backup_name = backup($file_name);

    $backup_name = backup($file_name, BACKUP_NUMBERED);

=head1 DESCRIPTION

The File::Backup module provides functions for creating backup copies of
files.  Normally, the name of the backup copy is created by appending a
single C<~> character to the original file name.  This naming is called
I<simple backup>.  Another naming scheme is I<numbered backup>.  In this
scheme, the name of the backup is created by suffixing the original file
name with C<.~I<N>~>, where I<N> is a decimal number starting with 1.
In this backup naming scheme, the backup copies of file F<test> would be
called F<test.~1~>, F<test.~2~> and so on.

=head2 backup

    $backup_name = backup($orig_name)
    
    $backup_name = backup($orig_name, $scheme)

The B<backup> function is the principal interface for managing backup
copies.  Its first argument specifies the name of the existing file for
which a backup copy is required.  Optional second argument controls the
backup naming scheme.  Its possible values are:

=over 4

=item BACKUP_NONE

Don't create backup.
    
=item BACKUP_SINGLE or BACKUP_SIMPLE

Create simple backup (F<I<FILE>~>).
    
=item BACKUP_NUMBERED

Create numbered backup (F<I<FILE>.~B<N>~>).

=item BACKUP_AUTO

Automatic selection of the naming scheme.  Create numbered backup if the
file has numbered backups already.  Otherwise, make simple backup. 

=back

If the second argument is omitted, the function will consult the value of
the environment variable B<VERSION_CONTROL>.  Its possible values are:

=over 4

=item none, off

Don't create any backups (B<BACKUP_NONE>).

=item simple, never

Create simple backups (B<BACKUP_SIMPLE>).

=item numbered, t

Create numbered backups (B<BACKUP_NUMBERED>).

=item existing, nil    

Automatic selection of the naming scheme (B<BACKUP_AUTO>).

=back

If B<VERSION_CONTROL> is unset or set to any other value than those listed
above, B<BACKUP_AUTO> is assumed.

The function returns the name of the backup file it created (C<undef> if
called with B<BACKUP_NONE>).  On error, it calls B<croak()>.

The following functions are available for using a specific backup naming
scheme.  These functions must be exported explicitly.
    
=head2 backup_simple

    use File::Backup qw(backup_simple);
    $backup_name = backup_simple($orig_name);

Creates simple backup.

=head2 backup_numbered
    
    use File::Backup qw(backup_numbered);
    $backup_name = backup_numbered($orig_name);

Creates numbered backup.

=head2 backup_auto

    use File::Backup qw(backup_auto);
    $backup_name = backup_auto($orig_name);

Creates numbered backup if any numbered backup version already exists for
the file.  Otherwise, creates simple backup.

=cut