Update of /cvsroot/openinteract/SPOPS/SPOPS
In directory usw-pr-cvs1:/tmp/cvs-serv14170
Modified Files:
HashFile.pm
Log Message:
update to always make a backup when a file is opened
Index: HashFile.pm
===================================================================
RCS file: /cvsroot/openinteract/SPOPS/SPOPS/HashFile.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** HashFile.pm 2001/10/12 21:00:26 1.13
--- HashFile.pm 2001/10/30 23:46:50 1.14
***************
*** 4,9 ****
use strict;
- use SPOPS;
use Data::Dumper;
@SPOPS::HashFile::ISA = qw( SPOPS );
--- 4,10 ----
use strict;
use Data::Dumper;
+ use File::Copy qw( cp );
+ use SPOPS;
@SPOPS::HashFile::ISA = qw( SPOPS );
***************
*** 51,84 ****
my ( $self, $p ) = @_;
my $obj = tied %{ $self };
unless ( $obj->{perm} eq 'write' ) {
die "Cannot save $obj->{filename}: it was opened as read-only.\n";
}
unless ( $obj->{filename} ) {
! die "Cannot save data: the filename has been erased. Did you assign an empty hash to the object?\n";
}
! if ( -f "$obj->{filename}.backup" ) {
! unlink( "$obj->{filename}.backup}" ); # just to be sure...
}
if ( -f $obj->{filename} ) {
! rename( $obj->{filename}, "$obj->{filename}.backup" )
|| die "Cannot rename old file to make room for new one. Error: $!";
}
return undef unless ( $self->pre_save_action( $p ) );
my %data = %{ $obj->{data} };
$p->{dumper_level} ||= 2;
local $Data::Dumper::Indent = $p->{dumper_level};
! my $string = Data::Dumper->Dump( [ \%data ], [ 'data' ] );
eval { open( INFO, "> $obj->{filename}" ) || die $! };
if ( $@ ) {
! rename( "$obj->{filename}.backup", $obj->{filename} )
|| die "Cannot open file for writing (reason: $@ ) and ",
"cannot move backup file to original place. Reason: $!";
die "Cannot open file for writing. Backup file restored. Error: $@";
}
! print INFO $string;
close( INFO );
! if ( -f "$obj->{filename}.backup" ) {
! unlink( "$obj->{filename}.backup" )
! || warn "Cannot remove the old data file. It still lingers in $obj->{filename}.old....\n";
}
return undef unless ( $self->post_save_action( $p ) );
--- 52,92 ----
my ( $self, $p ) = @_;
my $obj = tied %{ $self };
+
unless ( $obj->{perm} eq 'write' ) {
die "Cannot save $obj->{filename}: it was opened as read-only.\n";
}
+
unless ( $obj->{filename} ) {
! die "Cannot save data: the filename has been erased. Did you assign ",
! "an empty hash to the object?\n";
}
!
! my $temp_filename = "$obj->{filename}.tmp";
! if ( -f $temp_filename ) {
! unlink( $temp_filename ); # just to be sure...
}
if ( -f $obj->{filename} ) {
! rename( $obj->{filename}, $temp_filename )
|| die "Cannot rename old file to make room for new one. Error: $!";
}
+
return undef unless ( $self->pre_save_action( $p ) );
+
my %data = %{ $obj->{data} };
$p->{dumper_level} ||= 2;
local $Data::Dumper::Indent = $p->{dumper_level};
!
eval { open( INFO, "> $obj->{filename}" ) || die $! };
if ( $@ ) {
! rename( $temp_filename, $obj->{filename} )
|| die "Cannot open file for writing (reason: $@ ) and ",
"cannot move backup file to original place. Reason: $!";
die "Cannot open file for writing. Backup file restored. Error: $@";
}
! print INFO Data::Dumper->Dump( [ \%data ], [ 'data' ] );
close( INFO );
! if ( -f $temp_filename ) {
! unlink( $temp_filename )
! || warn "Cannot remove the old data file. It still lingers in ($temp_filename)\n";
}
return undef unless ( $self->post_save_action( $p ) );
***************
*** 155,158 ****
--- 163,173 ----
my $data = undef;
if ( $file_exists ) {
+
+ # First create a backup...
+
+ cp( $filename, "${filename}.backup" );
+
+ # Then open up the file
+
open( PD, $filename ) || die "Cannot open ($filename). Reason: $!";
local $/ = undef;
|
