#!/usr/bin/env perl

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


use DB_File;
use strict;


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

 
sub tie_hash {
    my($fh, $db_obj_ref, $hash_ref, $file_name, $mode_flag, $file_mode) = @_;

    ## \$fh and \$db_obj_ref are not used by this routine.  Other databases may
    ## require them. They are present to maintain a consistent interface
    
    ## try to achieve tie $Max_Tries times, with a wait of $Sleep_interval
    ## between attempts.  Returns the database object to use for locking.

    my $open_flag = O_CREAT|O_RDWR|O_NONBLOCK;
    if (lc($mode_flag) eq 'r') { $open_flag |= O_SHLOCK; }
    else { $open_flag |= O_EXLOCK; }


    for my $i (1..$TieMaxTries) {
        if (tie(%$hash_ref, 'DB_File', $file_name, $open_flag, $file_mode)) {
            # Success! Now get outta here.
            return;
        }
        # Otherwise... failure.  Wait, and try again.
         sleep($TieSleepInterval);
    }
    
    ## No luck? Give up.
    &wwerror($0, "Can't tie $file_name, please try again.");   
}

sub untie_hash {
    my($fh, $db_obj_ref, $hash_ref, $file_name) = @_;
    ## \$fh and \$db_obj_ref are not used by this routine.  Other databases may
    ## require them. They are present to maintain a consistent interface
  
    (tied %$hash_ref)->sync;

    untie(%$hash_ref) or  wwerror($0, "Can't untie database $file_name");
    1;              # Explicitly return 1 if successful
}

1;  ## script must return a true value