Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

get new item name

by mkmcconn (Chaplain)
on Jan 19, 2002 at 03:11 UTC ( #139992=snippet: print w/replies, xml ) Need Help??

You are running a test and want to create a bunch of temporary files in a directory, or tables in a database with unique but not random names, and you want some minimal protection against race conditions. You might use something like nextuniq() for the files:

my $files_like = time; my @existing = map {m/tmp_(\d+)$/} glob('./tmp_*'); my $next_file = nextuniq($files_like,\@existing); open TEMP,">./tmp_$next_file" or die; # do something close TEMP;

or use it like this for the tables:
my $tables_like = 'test001'; my $tables = [$dbh->tables()]; my $test_table = nextuniq($tables_like,$tables); my $sth = $dbh->prepare("CREATE TABLE $test_table (". "RowID INTEGER(3) PRIMARY KEY,". "DrawingNo VARCHAR(6) NULL ,") or die $dbh->errstr; $sth->execute; # do something $dbh->do("DROP TABLE $test_table");

see rob_au's comments for making something like this more safe - the do{}until, is especially nice. (But, his version of the nextunique() procedure won't work the same and I see no advantage).

sub nextuniq{
  my ($test_item,$item_list) = @_;
  my $new_item;
  my $found = 1;
  if (! UNIVERSAL::isa( $item_list, "ARRAY" )){
    require Carp;
    Carp::croak( "Arg 2 must be an array reference\n"); 
  while ($found) {
    $found  = 0;
    foreach $new_item (@$item_list) {
      if ($new_item eq $test_item) {
        $found = 1;
  $new_item = $test_item;
Replies are listed 'Best First'.
Re: get new item name
by rob_au (Abbot) on Jan 19, 2002 at 03:31 UTC
    Your code still exhibits a race condition between the point of generation of the 'unique' name and the later use of it in the code - There is no subsequent check for existence of uniqueness at the point of usage.

    While your code certainly has merit, it would be better written within a while loop, actually creating the destination object rather than simply determing the object name, in the event of the available 'unique' name. Alternatively, there still exists the possibility that a similarly named object is created between the time of your determination of the available unique name and the point of object creation. I dicussed this point in a recent meditation I posted with regard to the usage of temporary files within Perl here.


    perl -e 's&&[@.]/&&s&.com.&_&&&print'

Re: get new item name
by mkmcconn (Chaplain) on Jan 19, 2002 at 06:18 UTC

    Thanks for the comment, rob_au.
    Suppose it were used as follows; I can imagine that neck and neck races would make it go very slow, but would it fail?

    #!/usr/bin/perl -w use strict; my $files_like = 'aaa'; for (1..100){ my $next_file = nextuniq($files_like,[map {m/tmp_(\D+)\.txt$/} glob +('./tmp_*.txt')]); while (-e "./tmp_$next_file.txt"){ $next_file = nextuniq($next_file,[map {m/tmp_(\D+)\.txt$/} glob( +'./tmp_*.txt')]); print "race condition\n"; } open TEMP,">./tmp_$next_file.txt" or die; # do something close TEMP; } sub nextuniq{ my ($test_item,$item_list) = @_; my $new_item; my $found = 1; if (! UNIVERSAL::isa( $item_list, "ARRAY" )){ require Carp; Carp::croak( "Arg 2 must be an array reference\n"); } while ($found) { $found = 0; foreach $new_item (@$item_list) { if ($new_item eq $test_item) { $test_item++; $found = 1; } } } $new_item = $test_item; $new_item; }

    If it would fail, can it be written so that it can't fail?

      Now, first of all, from this point on, I can quite willing to be corrected, however to my mind in order to prevent a race condition, the very next operation which should be carried out following the determination of the file name is the acquisition of an exclusive lock on the file. While your code iterates through the loop until a non-existent file name is determined, to my thinking, the next operation must be to open the file and acquire the lock rather than the test for existent (which should fail, thereby exiting the loop and allowing the file to subsequently opened) - The difference in code is minute and frankly I don't really know if its absolutely necessary, however, if I were requested to rewrite the code, the following is how I would rewrite it:

      (Note that this philosophy with regard to order of actions to prevent race conditions with temporary files is based upon discussions within the comp.lang.perl.moderated newsgroup thread here and a BUGTRAQ post from Tom Christiansen here)

      #!/usr/bin/perl use Fcntl; use strict; my $fname = nextunique( 'aaa', [ map { m/tmp_(\D+).txt$/ } glob('./tmp +_*.txt') ] ); do { $fname = nextunique( $fname, [ map { m/tmp_(\D+).txt$/ } glob('./t +mp_*.txt') ] ); } until open (FH, $fname, O_RDWR|O_CREAT|O_EXCL, 0666); # code follows close FH; sub nextunique { my ($test_item, $item_list) = @_; exit 1 unless UNIVERSAL::isa( $item_list, 'ARRAY' ); foreach ( @{ $item_list } ) { if ( $_ eq $test_item ) { ++$test_item; last; } } return $test_item; }

      You will also note that I have removed the while loop within the nextunique subroutine, thereby minimising the chance of an infinite loop should the element $new_item not exist within @{ $item_list }. A more defensive approach to programming? Maybe, maybe not ...


      perl -e 's&&[@.]/&&s&.com.&_&&&print'

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: snippet [id://139992]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2023-02-04 22:52 GMT
Find Nodes?
    Voting Booth?
    I prefer not to run the latest version of Perl because:

    Results (31 votes). Check out past polls.