Bug in Perl rename() Function - Programmers Heaven

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

Bug in Perl rename() Function

x00sumanx00suman Posts: 7Member
The case of the file that dis appears .....

This issue arises as a result of Perl's inability in
handling files that are accessed simultaneously by multiple processes.
It so happens that if more than one processes Perl scripts are vying for the same file, in particularly if they are trying to access it with the intention to rename the file; the file disappears.

I have placed the script to reproduce the problem.
It uses two files call "a.txt" and "_a.txt", the script goes on renaming one from the other.

You have to change the path of the two files and then run the script.
Suddenly the file disappears.

Then if you replace the perl's rename funtion with your own like...

####
my_ren($old, $new) using system calls and some checks, the problem is resolved.

So the issue is clearly with perl's rename() functions inability to handle this situation.

The script goes here......

=====================================================================
####Change the path of these two files to suit your machines ....
$a = "\\x00suman\e\tmp001\a.txt";
$b = "\\x00suman\e\tmp001\_a.txt";

for( my $index = 1; $index < 1000; $index++ )
{
&Check_Lock_File($a, $b);
chomp($date = localtime());
my $flag = 0;

if (!open(STAT,$b))
{
my $tmp_time = localtime();
print $simbat_log = "$tmp_time, Aborted...Can't open $b : $!
" ;
&Simbat_Log_Func();
&Finalize();
die "Can't open $b : $!
";
}
my @machine_status = ;
close(STAT);
chomp (@machine_status);
sleep( 3 );
open(STAT,">$b");
print STAT "a
";
print STAT "b
";
print STAT "c
";
print STAT "d
";
#&PRINT( STAT, "$_
", 3, "$b" );
close STAT;
sleep( 3 );
&Release_File($a, $b);
#sleep( 1 );
}

#***********************************END*****************************************#

#*******************************************************************************#
#* function : Check_Lock_File *#
#* Inputs : The file and file name to be renamed *#
#* Globals used: *#
#* Returns : *#
#* Description : renames the given file to given name thus locking the file *#
#*******************************************************************************#
sub Check_Lock_File
{
my ($file1,$file2) = @_;
my $attempt = 1;
do
{
###### The bug's here ##########
if (rename($file1,$file2)) #if (-e $file1)
{
chomp( my $h = `hostname` );
my $t = localtime();
print "
Successfully locked by $h : $t
";
return;
}
else
{
if (-e $file2)
{
print $simbat_log = "$file1 file is used by another system
attempt $attempt ";
}
else
{
print $simbat_log = "$file1 or $file2 are not available
attempt $attempt ";
}
&Simbat_Log_Func();
sleep ( 2 );
$attempt++;
}
}while ($attempt <= 600);

if ($attempt >= 600)
{
print $simbat_log = "cld't access the $file1 for 50 minutest
";
&Simbat_Log_Func();
}
}
#***********************************END*****************************************#




#***********************************END*****************************************#

#*******************************************************************************#
#* function : Release_File *#
#* Inputs : file to be released *#
#* Globals used: *#
#* Returns : *#
#* Description : rename the file as before thus releasing the file *#
#*******************************************************************************#
sub Release_File
{
my ($file1,$file2) = @_;
###### The bug's here ###########
if (!rename($file2,$file1))
{
my $tmp_time = localtime();
print $simbat_log = "$tmp_time, cld not rename $file2 to $file1
";
&Simbat_Log_Func();
&Finalize();
exit;
}
else
{
chomp( my $h = `hostname` );
my $t = localtime();
print "Successfully released by $h : $t
";
}
}
#***********************************END*****************************************#




#***********************************END*****************************************#

#*******************************************************************************#
#* function : Simbat_Log_Func *#
#* Inputs : log details *#
#* Globals used: *#
#* Returns : *#
#* Description : logs the given detail in the file created with the hostname *#
#*******************************************************************************#
sub Simbat_Log_Func
{
open(SIMBAT,">>$current_dir$hostname.txt");

print SIMBAT "$simbat_log
";

close(SIMBAT);
}
#***********************************END*****************************************#





#***********************************END*****************************************#

#*******************************************************************************#
#* function : PRINT *#
#* Inputs : File Handle, Print message, Err no, File name + Globals *#
#* Globals used: *#
#* Returns : *#
#* Description : undefine the global all variable *#
#*******************************************************************************#

sub PRINT
{
$! = "";

my $print_attempt = 1;
my $print_flag = 0;

do
{
NO_DISK_SPACE:

print { $_[ 0 ] } $_[ 1 ];

if( $! )
{
my $error_message = $!;
if( $! =~ /No space left on device/i )
{
$no_disk_space = 1;
$print_flag = 0;
print "$error_message, attempt $print_attempt ...
";
sleep( 5 );
goto NO_DISK_SPACE;
}
else
{
$err_no = $_[ 2 ];
$err_string = $!." :Cant write into ".$_[ 3 ] ;
# &Err_Fun();
$print_flag = 1;
}
}
else
{
$print_flag = 1;
$print_attempt = 601;
}
}while( $print_attempt++ <= 600 );

if( ! $print_flag )
{
my $temp_time = localtime();
open DISK_ERROR, "c:\simbat\no_disk_space.txt";
print DISK_ERROR "Regression aborted in $hostname at $temp_time
";
print DISK_ERROR "No disk space left in $common_dir area
";

close DISK_ERROR;

exit( 0 );
}

$! = "";
}


#***********************************END*****************************************#





#***********************************END*****************************************#


#*******************************************************************************#
#* function : Finalize *#
#* Inputs : All the global all variable *#
#* Globals used: *#
#* Returns : *#
#* Description : undefine the global all variable *#
#*******************************************************************************#

sub Finalize
{
($common_dir,$ccs_dir,$tcf_dir,$wks_dir,$ccs_exec_dir,$executing_dir,$cmd_tmp_dir,
$goldenlog_dir,$testrepository,$testcase_logdir,$val_dir,$no_tests,$cc_setup_time,
$cc_app_time,$default_time,$tc_dir,$log_dir,$simbat_log,$tc_path,$type,$init,
$selection_id,$full_name,$tc_path,$setup,$exec,$validation,$testcase_time,
$tc_val,$log_file,@cmp,@val_detail,@val_criteria,@status,@val_element,$val_type,
$defaultstatus,$log_file,$time_difference,$exception_no,$log_name,$fail_no,
$valelement,$date,$element,%log_criteria,$defaultcriteria,$total_executed,
$time_taken,$html_header,@tc_name,@temp_files,@tc_dir_index,@load_index ) = ();
}

#***********************************END*****************************************#

=====================================================================
Sign In or Register to comment.