| … | |
… | |
| 3 | use GDBM_File; |
3 | use GDBM_File; |
| 4 | |
4 | |
| 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 TIE_PERMISSION => 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 = { |
| … | |
… | |
| 18 | return $self; |
18 | return $self; |
| 19 | } |
19 | } |
| 20 | |
20 | |
| 21 | sub connect($$) { |
21 | sub connect($$) { |
| 22 | my $self = shift; |
22 | my $self = shift; |
| 23 | my $accessMode = shift; |
23 | my $symbolicFlags = shift; # "ro" or "rw" |
| 24 | return if tied %$self->{hashRef}; # already tied! |
24 | return if tied %$self->{hashRef}; # already tied! |
| 25 | my $mode = lc $accessMode eq "rw" ? GDBM_WRCREAT() : GDBM_READER(); |
25 | my $flags = lc $symbolicFlags 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}}, |
|
|
28 | "GDBM_File", # class |
| 28 | $self->{gdbm_file}, |
29 | $self->{gdbm_file}, # file name |
| 29 | $mode, |
30 | $flags, # I/O flags |
| 30 | $accessMode; |
31 | TIE_PERMISSION; # access mode |
| 31 | sleep TIE_RETRY_DELAY; |
32 | sleep TIE_RETRY_DELAY; |
| 32 | } |
33 | } |
| 33 | die "unable to tie ", $self->{gdbm_file}, ": $!"; |
34 | die "unable to tie ", $self->{gdbm_file}, ": $!"; |
| 34 | } |
35 | } |
| 35 | |
36 | |
Parent Directory
| 
Revision Log
| 
Patch