=head2 sub get_file

This sub inputs the script specified by path, and unless the $no_backu
+p 
argument flag is set to true, it writes and verifies a backup before r
+eturning
contents of the file in an array.

The name of the backup file is guaranteed to be unique and is returned
+ via the 
global var $backup_file. This sub is dependent on make_unique_filename
+().

=head2 Synopsis

To get the contents of a file './test.pl' and save its contents into @
+file

    my $file = './test.pl';
    @file = get_file( $file, 'no backup' );

Note any true value will do for the string 'no backup' to supress writ
+ing of 
the backup file.

To also generate and verify a backup file -> './test.pl.bak'

    my $file = './test.pl';
    @file = get_file( $file );
    print "Backup of $file written to $backup_file\n";

Note if base target bakup files './test.pl.bak' and './test.pl1.bak' a
+lready 
exist backup will be written to './test.pl2.bak'. This behaviour relie
+s on
make_unique_filename(). The name of the backup file is returned in the
+ global 
$backup_file.

Finally a straight call simply writes and verifies a backup:

    get_file( $file );

as we are simply ignoring the return value. We could use wantarray but
+ as 
@file goes out of scope and is destroyed there seems no purpose to thi
+s.

=cut

my $backup_file;

sub get_file {
    my $path = shift;
    my $no_backup = shift || 0;
    $backup_file = '';
    open (FILE, "<", "$path") or die "Unable to open file $path $!\n";
    my @file = <FILE>;
    close FILE;
    unless ($no_backup) {
        $backup_file = "$path.bak";
        $backup_file = &make_unique_filename($backup_file) if -e $back
+up_file;
        open (FILE, ">", $backup_file) or die "Unable to write backup 
+file $backup_file $!\n";
        for (@file) {print FILE $_;}
        close FILE;
        open (BACKUP, "<", $backup_file) or die "Backup file failure, 
+aborting! $!\n";
        my @backup = <BACKUP>;
        close BACKUP;
        for my $i (0..$#backup) {
            die "Backup file corrupt, aborting!\n" unless $file[$i] eq
+ $backup[$i];
        }
    }
  return @file;
}

sub make_unique_filename {
    my $filename = shift;
    my ($main, $ext) = $filename =~ m/^(.*)(\..*?)$/;
    ($main,$ext) = ($filename,'') unless $main and $main !~ /[\.\/\\]$
+/;
    no warnings;
    while (-e $main.$ext) {
        $main =~ s/^(.*?)(\d*)$/$1.eval(($2||0)+1)/e;
      die "Unable to make unique filename after 101 tries!\n" if $2 > 
+100;
    }
  return $main.$ext;
}

=head2 Commented code

    sub get_file {
    
        # get arguments
        my $path = shift;
        my $no_backup = shift || 0; # optional arg, by default we writ
+e backup
    
        # get script to process
        open (FILE, "<", "$path") or die "Unable to open file $path $!
+\n";
        my @file = <FILE>;
        close FILE;
    
        # we will write a backup unless this has been specifically out
+lawed
        unless ($no_backup) {
            
            # make a uniquely named backup file
            $backup_file = "$path.bak";
            $backup_file = &make_unique_filename($backup_file) if -e $
+backup_file;
            
            # write script to script.bak before proceeding
            open (FILE, ">", $backup_file) or die "Unable to write bac
+kup file $backup_file $!\n";
            for (@file) {
                print FILE $_;
            }
            close FILE;
    
            # varify backup is a perfect copy, rampant paranoia is OK 
+because ..it happens
            open (BACKUP, "<", $backup_file) or die "Backup file failu
+re, aborting! $!\n";
            my @backup = <BACKUP>;
            close BACKUP;
            for my $i (0..$#backup) {
                die "Backup file corrupt, aborting!\n" unless $file[$i
+] eq $backup[$i];
            }
        }
      return @file; # if all has proceeded as expected we return the f
+ile
    }

    sub make_unique_filename {
        my $filename = shift;
        # try to chop off extension (may not be present)
        # if this fails we have simply declared our vars
        my ($main, $ext) = $filename =~ m/^(.*)(\..*?)$/;
        # check for 'valid' main, needed if: 
        # no extension; or /.foo; or /../foo
        # if suspect we use filename whole and add to end 
        ($main,$ext) = ($filename,'') unless $main and $main !~ /[\.\/
+\\]$/;
        # we need no warnings a $2 may be undef (not numeric)
        # and triggers a warning in the die statement
        no warnings;
        # iterate while the filename main.$ext exists
        while (-e $main.$ext) {
            # modify main, incrementing the numeric extension
            $main =~ s/^(.*?)(\d*)$/$1.eval(($2||0)+1)/e;
          die "Unable to make unique filename after 101 tries!\n" if $
+2 > 100;
        }
      return $main.$ext;
    }

=head2 Version 1.0

I<Last update 2nd May 2001>

=head1 Author

(c) Dr James Freeman 2000-01 E<lt>jfreeman@tassie.net.auE<gt> 
All rights reserved.

This package is free software and is provided ``as is'' without expres
+s or 
implied warranty. It may be used, redistributed and/or modified under 
+the terms 
of the Perl Artistic License (see http://www.perl.com/perl/misc/Artist
+ic.html)

=cut
[download]