Re: get new item name

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;
}
[download]

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

Comment on Re: get new item name Download Code

Replies are listed 'Best First'.

Re: Re: get new item name
by rob_au (Abbot) on Jan 19, 2002 at 17:31 UTC

(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;
}
[download]

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&&rob@cowsnet.com.au&&&split/[@.]/&&s&.com.&_&&&print'

[reply]
[d/l]
[select]


"be consistent"
	PerlMonks