Parent Directory
| 
Revision Log
Revision 1533 - (view) (download) (as text)
| 1 : | sh002i | 1533 | #!/usr/bin/env perl |
| 2 : | sam | 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 : |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |