[system] / trunk / webwork / system / scripts / db_tie.pl Repository:
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 11 - (view) (download) (as text)

1 : sam 11 #!/usr/local/bin/webwork-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