#!/usr/local/bin/webwork-perl

####################################################################
# Copyright @ 1995-1998 University of Rochester
# All Rights Reserved
####################################################################



use DB_File;
use Fcntl;
use strict;
use diagnostics;

my $TieMaxTries =30;	# try to tie() 30 times, then fail
my $TieSleepInterval =2; # sleep 2 sec after failed tie()

my $LOCK_SH = 1 ;		# shared lock
my $LOCK_EX = 2 ;		# exclusive lock
my $LOCK_NB = 4 ;		# non-blocking
my $LOCK_UN = 8 ;		# unlock

   
 
sub tie_hash {
    my($FILEHANDLE, $hash_ref, $file_name, $mode_flag, $permission) = @_;

    ## try to achieve tie $Max_Tries times, with a wait of $Sleep_interval
    ## between attempts.  Returns the database object to use for locking.

    my ($fd,$flags,$DbObj,$i);
    
    $DbObj = tie(%$hash_ref, 'DB_File', "$file_name", O_CREAT|O_RDWR, $permission, $DB_HASH) || &Global::error("DB error", "$file_name $!\n");

    $fd = $DbObj->fd; 
    my $time =time;
    
    print   "\n$time  $$: db fd is $fd for file $file_name\n";
    print   "tieing DBObj is $DbObj \n";
    
    open(FILEHANDLE, "+<&=$fd") or &Global::error("DB error", "fdopen $!\n");
    
    ## try to get a lock
    if (($mode_flag eq 'R') or ($mode_flag eq 'r')) {$flags = $LOCK_NB | $LOCK_SH }
    else {$flags = $LOCK_NB | $LOCK_EX }
    
    for ($i=1; $i < $TieMaxTries; $i++) {
    $time =time;
    
    print   "$time  $$: attempt $i: trying for type $flags, fd is $fd for file $file_name\n"; 
       
	if (flock(FILEHANDLE, $flags)) {
		
		print   "   $time  $$: succeeded on type $flags for attempt $i, fd is $fd for file $file_name\n";   
	    
	    return $DbObj ;   # Success! Now get outta here.
	}    
	$time =time;
	
    print   "   $time  $$: failed on type $flags attempt $i, fd is $fd for file $file_name\n"; 
      	
    sleep($TieSleepInterval);	    # Failure. Try again....
    }
    
    ## No luck? Give up.
    
    print   "   $time  $$: GIVING UP, tried and failed 30 times, fd is $fd for file $file_name\n"; 
    
    &Global::error("Database error", "Can't tie $file_name, please try again.");   
}

sub untie_hash {
    my($FILEHANDLE,$DbObj_ref,$hash_ref,$file_name) = @_;
      
    $$DbObj_ref->sync;
    my $time =time;
    print   "$time  $$: untieing DBObj is $$DbObj_ref \n";
  #  flock(FILEHANDLE, $LOCK_UN); ## closing filehandle below releases lock
    untie(%$hash_ref) || &Global::error("WeBWorK database error", "Can't untie database $file_name at");
    undef $$DbObj_ref;   # Removing last ref closes DB.  
    close(FILEHANDLE);
    
    print   "$time  $$: untieing $file_name\n"; 
    
    
    1;              # Explicitly return 1 if successful
}

1;  ## script must return a true value