11 |
|
# setdata(data, @keys) : set a data item to the given keys |
12 |
|
# getdata(@keys) : return all data items that match the given keys |
13 |
|
# deletedata(@keys) : detete all data items that match the given keys |
14 |
+ |
# match(@keys) : return the full DataItem object refs that match keys |
15 |
|
# items() : return the number of seperate items in the store |
16 |
+ |
# store(filename) : dump to file |
17 |
+ |
# restore(filename) : restore from file |
18 |
|
|
19 |
|
package Utilities::HashDB; |
20 |
+ |
use Utilities::DataItem; |
21 |
+ |
use FileHandle; |
22 |
|
require 5.001; |
23 |
|
|
24 |
|
sub new { |
25 |
|
my $class=shift; |
26 |
|
$self={}; |
27 |
|
bless $self, $class; |
28 |
< |
$self->{datahash}=(); |
24 |
< |
$self->{datakey}=(); |
28 |
> |
$self->{dataitems}=(); |
29 |
|
return $self; |
30 |
|
} |
31 |
|
|
34 |
|
my $data=shift; |
35 |
|
my @keys=@_; |
36 |
|
|
37 |
< |
push @{$self->{datakey}}, [ @keys ]; |
34 |
< |
push @{$self->{datahash}}, $data; |
37 |
> |
push @{$self->{dataitems}}, Utilities::DataItem->new($data, @keys); |
38 |
|
} |
39 |
|
|
40 |
|
sub items { |
41 |
|
my $self=shift; |
42 |
< |
return $#{$self->{datahash}}; |
42 |
> |
return $#{$self->{dataitems}}; |
43 |
|
} |
44 |
|
|
45 |
< |
|
43 |
< |
sub getdata { |
45 |
> |
sub deletedata { |
46 |
|
my $self=shift; |
47 |
|
my @keys=@_; |
48 |
|
|
49 |
+ |
# first get all the keys we want to delete |
50 |
+ |
my @match=$self->_match(@keys); |
51 |
+ |
foreach $i ( @match ) { |
52 |
+ |
splice (@{$self->{dataitems}}, $i, 1 ); |
53 |
+ |
} |
54 |
+ |
} |
55 |
+ |
|
56 |
+ |
sub match { |
57 |
+ |
my $self=shift; |
58 |
+ |
my @keys=@_; |
59 |
+ |
|
60 |
|
my @data=(); |
61 |
|
my @match=$self->_match(@keys); |
62 |
< |
foreach $d ( @match ) { |
63 |
< |
push @data, $self->{datahash}[$d]; |
62 |
> |
foreach $i ( @match ) { |
63 |
> |
push @data, $self->{dataitems}[$i]; |
64 |
|
} |
65 |
|
return @data; |
66 |
|
} |
67 |
|
|
68 |
< |
sub deletedata { |
68 |
> |
sub getdata { |
69 |
|
my $self=shift; |
70 |
|
my @keys=@_; |
71 |
< |
|
72 |
< |
# first get all the keys we want to delete |
71 |
> |
|
72 |
> |
my @data=(); |
73 |
|
my @match=$self->_match(@keys); |
74 |
+ |
my $i; |
75 |
|
foreach $i ( @match ) { |
76 |
< |
print $i; |
77 |
< |
splice ( @{$self->{datahash}}, $i, 1 ); |
78 |
< |
splice ( @{$self->{datakey}}, $i, 1 ); |
76 |
> |
push @data, ($self->{dataitems}[$i]->data()); |
77 |
> |
} |
78 |
> |
return @data; |
79 |
> |
} |
80 |
> |
|
81 |
> |
sub store { |
82 |
> |
my $self=shift; |
83 |
> |
my $filename=shift; |
84 |
> |
|
85 |
> |
my $fh=FileHandle->new(); |
86 |
> |
open ($fh, ">$filename") or die "Unable to open file $filename\n $!\n"; |
87 |
> |
foreach $object ( @{$self->{dataitems}} ) { |
88 |
> |
my $temp=join '::', $object->keys(); |
89 |
> |
$temp=$object->data()."::".$temp; |
90 |
> |
print $fh $temp."\n"; |
91 |
> |
} |
92 |
> |
close $fh; |
93 |
> |
} |
94 |
> |
|
95 |
> |
sub restore { |
96 |
> |
my $self=shift; |
97 |
> |
my $filename=shift; |
98 |
> |
my @arr; |
99 |
> |
|
100 |
> |
my $fh=FileHandle->new(); |
101 |
> |
open ($fh, "<$filename") or die "Unable to open file $filename\n $!\n"; |
102 |
> |
while ( <$fh> ) { |
103 |
> |
next if /^#/; |
104 |
> |
@arr=split ':', $_; |
105 |
> |
$self->setdata(@arr); |
106 |
|
} |
107 |
+ |
close $fh; |
108 |
|
} |
109 |
|
|
110 |
|
# ------------------- Support Routines ------------ |
111 |
|
# returns list of array indices of items matching the keys |
112 |
+ |
|
113 |
|
sub _match { |
114 |
|
my $self=shift; |
115 |
|
my @keys=@_; |
116 |
|
|
117 |
< |
my $i; |
118 |
< |
my @matchold; |
119 |
< |
my @matchnew; |
120 |
< |
# At the start everything matches |
121 |
< |
for ( $i=0; $i<=$self->items(); $i++ ) { |
122 |
< |
if ( $#{$self->{datakey}[$i]} >= $#keys ) { |
80 |
< |
push @matchold, $i; |
117 |
> |
my @matches=(); |
118 |
> |
my $data; |
119 |
> |
for ( $i=0; $i<=$#{$self->{dataitems}}; $i++ ) { |
120 |
> |
$data=$self->{dataitems}[$i]; |
121 |
> |
if ( $data->match(@keys) ) { |
122 |
> |
push @matches, $i; |
123 |
|
} |
124 |
|
} |
125 |
< |
|
84 |
< |
# now test against keys |
85 |
< |
for ( $i=0; $i <= $#keys; $i++ ) { |
86 |
< |
undef @matchnew; |
87 |
< |
foreach $dn ( @matchold ){ |
88 |
< |
if ( $self->{datakey}[$dn][$i] eq $keys[$i] ) { |
89 |
< |
push @matchnew,$dn; |
90 |
< |
#print "match at $dn $keys[$i]\n"; |
91 |
< |
} |
92 |
< |
} |
93 |
< |
@matchold=@matchnew; |
94 |
< |
} |
95 |
< |
return @matchold; # list of array indecies |
125 |
> |
return @matches; |
126 |
|
} |
97 |
– |
|