View of /trunk/webwork/system/scripts/db_tie.pl

    1 #!/usr/local/bin/webwork-perl
    2 
    3 ####################################################################
    4 # Copyright @ 1995-1999 University of Rochester
    5 # All Rights Reserved
    6 ####################################################################
    7 
    8 
    9 use DB_File;
   10 use strict;
   11 
   12 
   13 my $TieMaxTries =30;  # try to tie() 30 times, then fail
   14 my $TieSleepInterval =1; # sleep 2 sec after failed tie()
   15 
   16 
   17 sub tie_hash {
   18     my($fh, $db_obj_ref, $hash_ref, $file_name, $mode_flag, $file_mode) = @_;
   19 
   20     ## \$fh and \$db_obj_ref are not used by this routine.  Other databases may
   21     ## require them. They are present to maintain a consistent interface
   22 
   23     ## try to achieve tie $Max_Tries times, with a wait of $Sleep_interval
   24     ## between attempts.  Returns the database object to use for locking.
   25 
   26     my $open_flag = O_CREAT|O_RDWR|O_NONBLOCK;
   27     if (lc($mode_flag) eq 'r') { $open_flag |= O_SHLOCK; }
   28     else { $open_flag |= O_EXLOCK; }
   29 
   30 
   31     for my $i (1..$TieMaxTries) {
   32         if (tie(%$hash_ref, 'DB_File', $file_name, $open_flag, $file_mode)) {
   33             # Success! Now get outta here.
   34             return;
   35         }
   36         # Otherwise... failure.  Wait, and try again.
   37          sleep($TieSleepInterval);
   38     }
   39 
   40     ## No luck? Give up.
   41     &wwerror($0, "Can't tie $file_name, please try again.");
   42 }
   43 
   44 sub untie_hash {
   45     my($fh, $db_obj_ref, $hash_ref, $file_name) = @_;
   46     ## \$fh and \$db_obj_ref are not used by this routine.  Other databases may
   47     ## require them. They are present to maintain a consistent interface
   48 
   49     (tied %$hash_ref)->sync;
   50 
   51     untie(%$hash_ref) or  wwerror($0, "Can't untie database $file_name");
   52     1;              # Explicitly return 1 if successful
   53 }
   54 
   55 1;  ## script must return a true value
   56 
   57 
   58 
   59