src/Utilities/HashDB.pm

#
# HashDB.pm
#
# Originally Written by Christopher Williams
#
# Description
#
# Interface
# ---------
# new()         : A new HashDB object
# setdata(data, @keys)   : set a data item to the given keys
# getdata(@keys)         : return all data items that match the given keys
# deletedata(@keys)      : detete all data items that match the given keys
# match(@keys)           : return the full DataItem object refs that match keys
# items()                : return the number of seperate items in the store
# store(filename)        : dump to file
# restore(filename)      : restore from file
# alias(\@refofkeys,\@aliaskeys) : attatch another set of keys to items that 
#                                  match the refopfkeys
#                                  note that these are references to the arrays
# unalias(@aliaskeys) :remove an alias 

package Utilities::HashDB;
use Utilities::DataItem;
use FileHandle;
require 5.001;

sub new {
        my $class=shift;
        $self={};
        bless $self, $class;
        $self->{dataitems}=();
        return $self;
}

sub setdata {
        my $self=shift;
        my $data=shift;
        my @keys=@_;
        
        push @{$self->{dataitems}}, Utilities::DataItem->new($data, @keys);
}

sub alias {
        my $self=shift;
        my $keyref=shift;
        my $aliaskeys=shift;

        my @objs=$self->match(@{$keyref});
        foreach $obj ( @objs ) {
          $obj->alias(@{$aliaskeys});
        }
}

sub unalias {
        my $self=shift;
        my @keys=@_;

        my @objs=$self->match(@keys);
        foreach $obj ( @objs ) {
          $obj->unalias(@_);
        }
}

sub items {
        my $self=shift;
        return $#{$self->{dataitems}};
}

sub deletedata {
        my $self=shift;
        my @keys=@_;

        # first get all the keys we want to delete
        my @match=$self->_match(@keys);
        foreach $i ( @match ) {
          splice (@{$self->{dataitems}}, $i, 1 );
        }
}

sub match {
        my $self=shift;
        my @keys=@_;
        
        my @data=();
        my @match=$self->_match(@keys);
        foreach $i ( @match ) {
          push @data, $self->{dataitems}[$i];
        }
        return @data;
}

sub getdata {
        my $self=shift;
        my @keys=@_;
        
        my @data=();
        my @match=$self->_match(@keys);
        my $i;
        foreach $i ( @match ) {
          push @data, ($self->{dataitems}[$i]->data());
        }
        return @data;
}

sub store {
        my $self=shift;
        my $filename=shift;

        my $fh=FileHandle->new();
        $fh->autoflush(1);
        open ($fh, ">$filename") or die "Unable to open file $filename\n $!\n";
        foreach $object ( @{$self->{dataitems}} ) {
          print $fh "\n";
          $object->store($fh);
        }
        close $fh;
}

sub restore {
        my $self=shift;
        my $filename=shift;
        my @arr=();
        my $data;

        my $fh=FileHandle->new();
        open ($fh, "<$filename") or die "Unable to open file $filename\n $!\n";
        while ( <$fh> ) {
          push @{$self->{dataitems}}, Utilities::DataItem->restore($fh);
        }
        close $fh;
}

# ------------------- Support Routines ------------
# returns list of array indices of items matching the keys

sub _match {
        my $self=shift;
        my @keys=@_;

        my @matches=();
        my $data;
        for ( $i=0; $i<=$#{$self->{dataitems}}; $i++ ) {
          $data=$self->{dataitems}[$i];
          if ( $data->match(@keys) ) {
            push @matches, $i;
          }
        }
        return @matches;
}
Revision:	1.7
Committed:	Tue Feb 8 13:59:20 2000 UTC (25 years, 3 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_0, V1_pre0, SCRAM_V1, SCRAMV1_IMPORT, V0_19_7, V0_19_6, V0_19_6p1, V0_19_5, SFATEST, V0_19_4, V0_19_4_pre3, V0_19_4_pre2, V0_19_4_pre1, V0_19_3, V0_19_2, V0_19_1, V0_19_0, V0_18_5, V0_18_4, V_18_3_TEST, VO_18_3, V0_18_2, V0_18_1, ProtoEnd
Branch point for:	V1_pre1, SCRAM_V1_BRANCH, V0_19_4_B, HPWbranch, V0_9branch
Changes since 1.6:	+0 -1 lines
Log Message:	remove debug output
#	User	Rev	Content
1	williamc	1.1	#
2			# HashDB.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6			# Description
7			#
8			# Interface
9			# ---------
10			# new() : A new HashDB object
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	williamc	1.3	# match(@keys) : return the full DataItem object refs that match keys
15	williamc	1.1	# items() : return the number of seperate items in the store
16	williamc	1.4	# store(filename) : dump to file
17			# restore(filename) : restore from file
18	williamc	1.6	# alias(\@refofkeys,\@aliaskeys) : attatch another set of keys to items that
19			# match the refopfkeys
20			# note that these are references to the arrays
21			# unalias(@aliaskeys) :remove an alias
22	williamc	1.1
23			package Utilities::HashDB;
24	williamc	1.3	use Utilities::DataItem;
25	williamc	1.4	use FileHandle;
26	williamc	1.1	require 5.001;
27
28			sub new {
29			my $class=shift;
30			$self={};
31			bless $self, $class;
32	williamc	1.3	$self->{dataitems}=();
33	williamc	1.1	return $self;
34			}
35
36			sub setdata {
37			my $self=shift;
38			my $data=shift;
39			my @keys=@_;
40
41	williamc	1.3	push @{$self->{dataitems}}, Utilities::DataItem->new($data, @keys);
42	williamc	1.1	}
43
44	williamc	1.6	sub alias {
45			my $self=shift;
46			my $keyref=shift;
47			my $aliaskeys=shift;
48
49			my @objs=$self->match(@{$keyref});
50			foreach $obj ( @objs ) {
51			$obj->alias(@{$aliaskeys});
52			}
53			}
54
55			sub unalias {
56			my $self=shift;
57			my @keys=@_;
58
59			my @objs=$self->match(@keys);
60			foreach $obj ( @objs ) {
61			$obj->unalias(@_);
62			}
63			}
64
65	williamc	1.1	sub items {
66			my $self=shift;
67	williamc	1.3	return $#{$self->{dataitems}};
68	williamc	1.1	}
69
70	williamc	1.3	sub deletedata {
71			my $self=shift;
72			my @keys=@_;
73
74			# first get all the keys we want to delete
75			my @match=$self->_match(@keys);
76			foreach $i ( @match ) {
77			splice (@{$self->{dataitems}}, $i, 1 );
78			}
79			}
80	williamc	1.1
81	williamc	1.3	sub match {
82	williamc	1.1	my $self=shift;
83			my @keys=@_;
84	williamc	1.3
85	williamc	1.1	my @data=();
86			my @match=$self->_match(@keys);
87	williamc	1.3	foreach $i ( @match ) {
88			push @data, $self->{dataitems}[$i];
89	williamc	1.1	}
90			return @data;
91			}
92
93	williamc	1.3	sub getdata {
94	williamc	1.1	my $self=shift;
95			my @keys=@_;
96	williamc	1.3
97			my @data=();
98	williamc	1.1	my @match=$self->_match(@keys);
99	williamc	1.3	my $i;
100	williamc	1.1	foreach $i ( @match ) {
101	williamc	1.3	push @data, ($self->{dataitems}[$i]->data());
102	williamc	1.1	}
103	williamc	1.3	return @data;
104	williamc	1.4	}
105
106			sub store {
107			my $self=shift;
108			my $filename=shift;
109
110			my $fh=FileHandle->new();
111	williamc	1.6	$fh->autoflush(1);
112	williamc	1.4	open ($fh, ">$filename") or die "Unable to open file $filename\n $!\n";
113			foreach $object ( @{$self->{dataitems}} ) {
114	williamc	1.6	print $fh "\n";
115			$object->store($fh);
116	williamc	1.4	}
117			close $fh;
118			}
119
120			sub restore {
121			my $self=shift;
122			my $filename=shift;
123	williamc	1.5	my @arr=();
124			my $data;
125	williamc	1.4
126			my $fh=FileHandle->new();
127			open ($fh, "<$filename") or die "Unable to open file $filename\n $!\n";
128			while ( <$fh> ) {
129	williamc	1.6	push @{$self->{dataitems}}, Utilities::DataItem->restore($fh);
130	williamc	1.4	}
131			close $fh;
132	williamc	1.1	}
133
134			# ------------------- Support Routines ------------
135			# returns list of array indices of items matching the keys
136	williamc	1.3
137	williamc	1.1	sub _match {
138			my $self=shift;
139			my @keys=@_;
140
141	williamc	1.3	my @matches=();
142			my $data;
143			for ( $i=0; $i<=$#{$self->{dataitems}}; $i++ ) {
144			$data=$self->{dataitems}[$i];
145			if ( $data->match(@keys) ) {
146			push @matches, $i;
147	williamc	1.1	}
148			}
149	williamc	1.3	return @matches;
150	williamc	1.1	}