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