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_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_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,
    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)) {
	if (exists($envtrans{$v})) {
	    $type = $envtrans{$v};
	} else {
	    $type = BACKUP_AUTO;

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+)~$/) {
		   } 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: $!";
    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);

=head1 NAME

File::Backup - create a backup of the file.

    use File::Backup;

    $backup_name = backup($file_name);

    $backup_name = backup($file_name, BACKUP_NUMBERED);


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


Don't create backup.

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

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


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


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>).


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.