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

    1 #!/usr/local/bin/perl
    2 
    3 ####################################################################
    4 # Copyright @ 1995-1998 University of Rochester
    5 # All Rights Reserved
    6 ####################################################################
    7 
    8 
    9 
   10 use DB_File;
   11 use Fcntl;
   12 use strict;
   13 use diagnostics;
   14 
   15 my $TieMaxTries =30;  # try to tie() 30 times, then fail
   16 my $TieSleepInterval =2; # sleep 2 sec after failed tie()
   17 
   18 my $LOCK_SH = 1 ;   # shared lock
   19 my $LOCK_EX = 2 ;   # exclusive lock
   20 my $LOCK_NB = 4 ;   # non-blocking
   21 my $LOCK_UN = 8 ;   # unlock
   22 
   23 
   24 
   25 sub tie_hash {
   26     my($FILEHANDLE, $hash_ref, $file_name, $mode_flag, $permission) = @_;
   27 
   28     ## try to achieve tie $Max_Tries times, with a wait of $Sleep_interval
   29     ## between attempts.  Returns the database object to use for locking.
   30 
   31     my ($fd,$flags,$DbObj,$i);
   32 
   33     $DbObj = tie(%$hash_ref, 'DB_File', "$file_name", O_CREAT|O_RDWR, $permission, $DB_HASH) || &Global::error("DB error", "$file_name $!\n");
   34 
   35     $fd = $DbObj->fd;
   36     my $time =time;
   37 
   38     print   "\n$time  $$: db fd is $fd for file $file_name\n";
   39     print   "tieing DBObj is $DbObj \n";
   40 
   41     open(FILEHANDLE, "+<&=$fd") or &Global::error("DB error", "fdopen $!\n");
   42 
   43     ## try to get a lock
   44     if (($mode_flag eq 'R') or ($mode_flag eq 'r')) {$flags = $LOCK_NB | $LOCK_SH }
   45     else {$flags = $LOCK_NB | $LOCK_EX }
   46 
   47     for ($i=1; $i < $TieMaxTries; $i++) {
   48     $time =time;
   49 
   50     print   "$time  $$: attempt $i: trying for type $flags, fd is $fd for file $file_name\n";
   51 
   52   if (flock(FILEHANDLE, $flags)) {
   53 
   54     print   "   $time  $$: succeeded on type $flags for attempt $i, fd is $fd for file $file_name\n";
   55 
   56       return $DbObj ;   # Success! Now get outta here.
   57   }
   58   $time =time;
   59 
   60     print   "   $time  $$: failed on type $flags attempt $i, fd is $fd for file $file_name\n";
   61 
   62     sleep($TieSleepInterval);     # Failure. Try again....
   63     }
   64 
   65     ## No luck? Give up.
   66 
   67     print   "   $time  $$: GIVING UP, tried and failed 30 times, fd is $fd for file $file_name\n";
   68 
   69     &Global::error("Database error", "Can't tie $file_name, please try again.");
   70 }
   71 
   72 sub untie_hash {
   73     my($FILEHANDLE,$DbObj_ref,$hash_ref,$file_name) = @_;
   74 
   75     $$DbObj_ref->sync;
   76     my $time =time;
   77     print   "$time  $$: untieing DBObj is $$DbObj_ref \n";
   78   #  flock(FILEHANDLE, $LOCK_UN); ## closing filehandle below releases lock
   79     untie(%$hash_ref) || &Global::error("WeBWorK database error", "Can't untie database $file_name at");
   80     undef $$DbObj_ref;   # Removing last ref closes DB.
   81     close(FILEHANDLE);
   82 
   83     print   "$time  $$: untieing $file_name\n";
   84 
   85 
   86     1;              # Explicitly return 1 if successful
   87 }
   88 
   89 1;  ## script must return a true value
   90 
   91 
   92