| … | |
… | |
| 21 | use constant MAX_TIE_ATTEMPTS => 30; |
21 | use constant MAX_TIE_ATTEMPTS => 30; |
| 22 | use constant TIE_RETRY_DELAY => 2; |
22 | use constant TIE_RETRY_DELAY => 2; |
| 23 | use constant TIE_PERMISSION => 0660; |
23 | use constant TIE_PERMISSION => 0660; |
| 24 | |
24 | |
| 25 | ################################################################################ |
25 | ################################################################################ |
| 26 | # static function |
26 | # static functions |
| 27 | ################################################################################ |
27 | ################################################################################ |
| 28 | |
28 | |
| 29 | sub style() { |
29 | sub style() { |
| 30 | return STYLE; |
30 | return STYLE; |
| 31 | } |
31 | } |
| … | |
… | |
| 53 | my ($self, $mode) = @_; |
53 | my ($self, $mode) = @_; |
| 54 | my $hash = $self->{hash}; |
54 | my $hash = $self->{hash}; |
| 55 | my $source = $self->{source}; |
55 | my $source = $self->{source}; |
| 56 | |
56 | |
| 57 | return 1 if tied %$hash; # already tied! |
57 | return 1 if tied %$hash; # already tied! |
|
|
58 | die "$source: must exist to open for reading" |
|
|
59 | if lc $mode eq "ro" and not -e $source; |
| 58 | my $flags = lc $mode eq "rw" ? GDBM_WRCREAT() : GDBM_READER(); |
60 | my $flags = lc $mode eq "rw" ? GDBM_WRCREAT() : GDBM_READER(); |
| 59 | return 0 if lc $mode eq "ro" and not -e $self->{source}; |
|
|
| 60 | foreach (1 .. MAX_TIE_ATTEMPTS) { |
61 | foreach (1 .. MAX_TIE_ATTEMPTS) { |
| 61 | return 1 if tie %$hash, |
62 | return 1 if tie %$hash, |
| 62 | "GDBM_File", # class |
63 | "GDBM_File", # class |
| 63 | $source, # file name |
64 | $source, # file name |
| 64 | $flags, # I/O flags |
65 | $flags, # I/O flags |
| 65 | TIE_PERMISSION; # access mode |
66 | TIE_PERMISSION; # access mode |
| 66 | sleep TIE_RETRY_DELAY; |
67 | sleep TIE_RETRY_DELAY; |
| 67 | } |
68 | } |
| 68 | return 0; |
69 | die "$source: connection failed"; |
| 69 | } |
70 | } |
| 70 | |
71 | |
| 71 | sub disconnect($) { |
72 | sub disconnect($) { |
| 72 | my $self = shift; |
73 | my $self = shift; |
| 73 | return 1 unless tied %{$self->{hash}}; # not tied! |
74 | return 1 unless tied %{$self->{hash}}; # not tied! |
| … | |
… | |
| 78 | # hash-style methods |
79 | # hash-style methods |
| 79 | ################################################################################ |
80 | ################################################################################ |
| 80 | |
81 | |
| 81 | sub hash($) { |
82 | sub hash($) { |
| 82 | my ($self) = @_; |
83 | my ($self) = @_; |
| 83 | return 0 unless tied %{$self->{hash}}; # not tied! |
84 | die "hash not tied" |
|
|
85 | unless tied %{$self->{hash}}; |
| 84 | return $self->{hash}; |
86 | return $self->{hash}; |
| 85 | } |
87 | } |
| 86 | |
88 | |
| 87 | 1; |
89 | 1; |
Parent Directory
| 
Revision Log
| 
Patch