Commit | Line | Data |
6fe26b29 |
1 | package DBM::Deep::Hash; |
2 | |
3 | use strict; |
4 | |
5 | use base 'DBM::Deep'; |
6 | |
596e9574 |
7 | sub _get_self { |
8 | tied( %{$_[0]} ) || $_[0] |
9 | } |
10 | |
6fe26b29 |
11 | sub TIEHASH { |
12 | ## |
13 | # Tied hash constructor method, called by Perl's tie() function. |
14 | ## |
15 | my $class = shift; |
16 | my $args; |
17 | if (scalar(@_) > 1) { $args = {@_}; } |
18 | #XXX This use of ref() is bad and is a bug |
19 | elsif (ref($_[0])) { $args = $_[0]; } |
20 | else { $args = { file => shift }; } |
21 | |
22 | $args->{type} = $class->TYPE_HASH; |
23 | |
24 | return $class->_init($args); |
25 | } |
26 | |
27 | sub FIRSTKEY { |
28 | ## |
29 | # Locate and return first key (in no particular order) |
30 | ## |
596e9574 |
31 | my $self = $_[0]->_get_self;#DBM::Deep::_get_self($_[0]); |
6fe26b29 |
32 | |
33 | ## |
34 | # Make sure file is open |
35 | ## |
36 | if (!defined($self->fh)) { $self->_open(); } |
37 | |
38 | ## |
39 | # Request shared lock for reading |
40 | ## |
41 | $self->lock( $self->LOCK_SH ); |
42 | |
43 | my $result = $self->_get_next_key(); |
44 | |
45 | $self->unlock(); |
46 | |
47 | return ($result && $self->root->{filter_fetch_key}) |
48 | ? $self->root->{filter_fetch_key}->($result) |
49 | : $result; |
50 | } |
51 | |
52 | sub NEXTKEY { |
53 | ## |
54 | # Return next key (in no particular order), given previous one |
55 | ## |
596e9574 |
56 | my $self = $_[0]->_get_self;#DBM::Deep::_get_self($_[0]); |
6fe26b29 |
57 | |
58 | my $prev_key = ($self->root->{filter_store_key}) |
59 | ? $self->root->{filter_store_key}->($_[1]) |
60 | : $_[1]; |
61 | |
62 | my $prev_md5 = $DBM::Deep::DIGEST_FUNC->($prev_key); |
63 | |
64 | ## |
65 | # Make sure file is open |
66 | ## |
67 | if (!defined($self->fh)) { $self->_open(); } |
68 | |
69 | ## |
70 | # Request shared lock for reading |
71 | ## |
72 | $self->lock( $self->LOCK_SH ); |
73 | |
74 | my $result = $self->_get_next_key( $prev_md5 ); |
75 | |
76 | $self->unlock(); |
77 | |
78 | return ($result && $self->root->{filter_fetch_key}) |
79 | ? $self->root->{filter_fetch_key}->($result) |
80 | : $result; |
81 | } |
82 | |
83 | ## |
84 | # Public method aliases |
85 | ## |
86 | *first_key = *FIRSTKEY; |
87 | *next_key = *NEXTKEY; |
88 | |
89 | 1; |
90 | __END__ |