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

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 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();
        open ($fh, ">$filename") or die "Unable to open file $filename\n $!\n";
        foreach $object ( @{$self->{dataitems}} ) {
          # print the keys first then the data item
          foreach $key ( $object->keys() ) { 
            print $fh "#".$key."\n";
          }
          print $fh ">".$object->data()."\n";
        }
        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> ) {
          if ( $_=~/^#(.*)/ ) {
            push @arr, $1;      
          }
          if ( $_=~/^>(.*)/ ) {
            $data=$1;
            if ( $#arr >= 0 ) {
             $self->setdata($data,@arr);
            }
            undef @arr;
          }
        }
        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.5
Committed:	Thu Oct 21 16:37:50 1999 UTC (25 years, 6 months ago) by williamc
Content type:	text/plain
Branch:	MAIN
Changes since 1.4:	+17 -7 lines
Log Message:	Update storage mechanism to remove limitations on data strings - newlines are the only field seperator
#	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.1
19			package Utilities::HashDB;
20	williamc	1.3	use Utilities::DataItem;
21	williamc	1.4	use FileHandle;
22	williamc	1.1	require 5.001;
23
24			sub new {
25			my $class=shift;
26			$self={};
27			bless $self, $class;
28	williamc	1.3	$self->{dataitems}=();
29	williamc	1.1	return $self;
30			}
31
32			sub setdata {
33			my $self=shift;
34			my $data=shift;
35			my @keys=@_;
36
37	williamc	1.3	push @{$self->{dataitems}}, Utilities::DataItem->new($data, @keys);
38	williamc	1.1	}
39
40			sub items {
41			my $self=shift;
42	williamc	1.3	return $#{$self->{dataitems}};
43	williamc	1.1	}
44
45	williamc	1.3	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	williamc	1.1
56	williamc	1.3	sub match {
57	williamc	1.1	my $self=shift;
58			my @keys=@_;
59	williamc	1.3
60	williamc	1.1	my @data=();
61			my @match=$self->_match(@keys);
62	williamc	1.3	foreach $i ( @match ) {
63			push @data, $self->{dataitems}[$i];
64	williamc	1.1	}
65			return @data;
66			}
67
68	williamc	1.3	sub getdata {
69	williamc	1.1	my $self=shift;
70			my @keys=@_;
71	williamc	1.3
72			my @data=();
73	williamc	1.1	my @match=$self->_match(@keys);
74	williamc	1.3	my $i;
75	williamc	1.1	foreach $i ( @match ) {
76	williamc	1.3	push @data, ($self->{dataitems}[$i]->data());
77	williamc	1.1	}
78	williamc	1.3	return @data;
79	williamc	1.4	}
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	williamc	1.5	# print the keys first then the data item
89			foreach $key ( $object->keys() ) {
90			print $fh "#".$key."\n";
91			}
92			print $fh ">".$object->data()."\n";
93	williamc	1.4	}
94			close $fh;
95			}
96
97			sub restore {
98			my $self=shift;
99			my $filename=shift;
100	williamc	1.5	my @arr=();
101			my $data;
102	williamc	1.4
103			my $fh=FileHandle->new();
104			open ($fh, "<$filename") or die "Unable to open file $filename\n $!\n";
105			while ( <$fh> ) {
106	williamc	1.5	if ( $_=~/^#(.*)/ ) {
107			push @arr, $1;
108			}
109			if ( $_=~/^>(.*)/ ) {
110			$data=$1;
111			if ( $#arr >= 0 ) {
112			$self->setdata($data,@arr);
113			}
114			undef @arr;
115			}
116	williamc	1.4	}
117			close $fh;
118	williamc	1.1	}
119
120			# ------------------- Support Routines ------------
121			# returns list of array indices of items matching the keys
122	williamc	1.3
123	williamc	1.1	sub _match {
124			my $self=shift;
125			my @keys=@_;
126
127	williamc	1.3	my @matches=();
128			my $data;
129			for ( $i=0; $i<=$#{$self->{dataitems}}; $i++ ) {
130			$data=$self->{dataitems}[$i];
131			if ( $data->match(@keys) ) {
132			push @matches, $i;
133	williamc	1.1	}
134			}
135	williamc	1.3	return @matches;
136	williamc	1.1	}