| … | |
… | |
| 16 | }; |
16 | }; |
| 17 | bless $self, $class; |
17 | bless $self, $class; |
| 18 | return $self; |
18 | return $self; |
| 19 | } |
19 | } |
| 20 | |
20 | |
|
|
21 | # connect($self, $symbolicFlags) |
|
|
22 | # $self implicitly set by caller |
|
|
23 | # $symbolicFlags "ro" = read-only, "rw" = read-write |
|
|
24 | # returns: |
|
|
25 | # -1 = already tied |
|
|
26 | # 0 = file doesn't exist when being opened for reading |
|
|
27 | # >0 = success! (number of attempts to tie) |
| 21 | sub connect($$) { |
28 | sub connect($$) { |
| 22 | my $self = shift; |
29 | my $self = shift; |
| 23 | my $symbolicFlags = shift; # "ro" or "rw" |
30 | my $symbolicFlags = shift; # "ro" or "rw" |
| 24 | return if tied %$self->{hashRef}; # already tied! |
31 | return -1 if tied %$self->{hashRef}; # already tied! |
| 25 | my $flags = lc $symbolicFlags eq "rw" ? GDBM_WRCREAT() : GDBM_READER(); |
32 | my $flags = lc $symbolicFlags eq "rw" ? GDBM_WRCREAT() : GDBM_READER(); |
|
|
33 | return 0 if lc $symbolicFlags eq "ro" and not -e $self->{gdbm_file}; |
| 26 | foreach (1 .. MAX_TIE_ATTEMPTS) { |
34 | foreach (1 .. MAX_TIE_ATTEMPTS) { |
| 27 | return if tie %{$self->{hashRef}}, |
35 | return 1 if tie %{$self->{hashRef}}, |
| 28 | "GDBM_File", # class |
36 | "GDBM_File", # class |
| 29 | $self->{gdbm_file}, # file name |
37 | $self->{gdbm_file}, # file name |
| 30 | $flags, # I/O flags |
38 | $flags, # I/O flags |
| 31 | TIE_PERMISSION; # access mode |
39 | TIE_PERMISSION; # access mode |
| 32 | sleep TIE_RETRY_DELAY; |
40 | sleep TIE_RETRY_DELAY; |
| … | |
… | |
| 41 | } |
49 | } |
| 42 | |
50 | |
| 43 | sub disconnect($) { |
51 | sub disconnect($) { |
| 44 | my $self = shift; |
52 | my $self = shift; |
| 45 | return unless tied %{$self->{hashRef}}; # not tied! |
53 | return unless tied %{$self->{hashRef}}; # not tied! |
| 46 | return 1 if untie %{$self->{hashRef}}; |
54 | return untie %{$self->{hashRef}}; |
| 47 | } |
55 | } |
| 48 | |
56 | |
| 49 | 1; |
57 | 1; |
Parent Directory
| 
Revision Log
| 
Patch