[system] / trunk / webwork-modperl / lib / WeBWorK / DB / GDBM.pm Repository:
ViewVC logotype

Annotation of /trunk/webwork-modperl/lib/WeBWorK/DB/GDBM.pm

Parent Directory Parent Directory | Revision Log Revision Log


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

1 : sh002i 310 package WeBWorK::DB::GDBM;
2 :    
3 :     use GDBM_File;
4 :    
5 :     # these should probably be in a constants file somewhere...
6 :     use constant MAX_TIE_ATTEMPTS => 30;
7 :     use constant TIE_RETRY_DELAY => 2;
8 :     use constant CREATE_MODE => 0660;
9 :    
10 :     sub new($$$) {
11 :     my $proto = shift;
12 :     my $class = ref($proto) || $proto;
13 :     my $self = {
14 :     hashRef => {},
15 :     gdbm_file => shift,
16 :     accessMode => shift,
17 :     };
18 :     bless $self, $class;
19 :     return $self;
20 :     }
21 :    
22 :     sub connect($) {
23 :     my $self = shift;
24 :     return if tied %$self->{hashRef}; # already tied!
25 :     my $mode = lc $self->{accessMode} eq "w" ? GDBM_WRCREAT() : GDBM_READER();
26 :     foreach (1 .. MAX_TIE_ATTEMPTS) {
27 :     return if tie %{$self->{hashRef}}, "GDBM_File",
28 :     $self->{gdbm_file},
29 :     $mode,
30 :     $self->{accessMode};
31 :     sleep TIE_RETRY_DELAY;
32 :     }
33 :     die "WeBWorK::Tie::GDBM::connect: unable to tie ", $self->{gdbm_file}, ": $!";
34 :     }
35 :    
36 :     sub hashRef($) {
37 :     my $self = shift;
38 :     return unless tied %{$self->{hashRef}}; # not tied!
39 :     return $self->{hashRef};
40 :     }
41 :    
42 :     sub disconnect($) {
43 :     my $self = shift;
44 :     return unless tied %{$self->{hashRef}}; # not tied!
45 :     return 1 if untie %{$self->{hashRef}};
46 :     }
47 :    
48 :     1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9