src/Utilities/HashDB.pm

#
# HashDB.pm
#
# Originally Written by Christopher Williams
#

=head1 NAME

Utilities::HashDB - A type of database object.

=head1 SYNOPSIS

        my $obj = Utilities::HashDB->new();

=head1 METHODS

=over

=cut
   
=item C<new()>

   Create a new HashDB object.
   
=item C<setdata(data, @keys)>

   set a data item to the given keys.
   
=item  C<getdata(@keys)>

   return all data items that match the given keys.
   
=item  C<deletedata(@keys)>

   detete all data items that match the given keys.
   
=item  C<match(@keys)>

   return the full DataItem object refs that match keys.
   
=item  C<items()>

   return the number of seperate items in the store.
   
=item  C<store(filename)>

   dump to file.

=item  C<restore(filename)>

   restore from file.

=item  C<alias(\@refofkeys,\@aliaskeys)>

   attatch another set of keys to items that 
   match the refopfkeys (note that these are
   references to the arrays).

=item  unalias(@aliaskeys)

   remove an alias.

=back

=head1 AUTHOR

Originally Written by Christopher Williams.

=head1 MAINTAINER

Shaun ASHBY L<mailTo:Shaun.Ashby@cern.ch>

=cut
   
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.9
Committed:	Wed Aug 10 17:27:32 2005 UTC (19 years, 9 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
Changes since 1.8:	+68 -16 lines
Log Message:	Starting to add POD documentation.
#	User	Rev	Content
1	williamc	1.1	#
2			# HashDB.pm
3			#
4			# Originally Written by Christopher Williams
5			#
6
7	sashby	1.9	=head1 NAME
8
9			Utilities::HashDB - A type of database object.
10
11			=head1 SYNOPSIS
12
13			my $obj = Utilities::HashDB->new();
14
15			=head1 METHODS
16
17			=over
18
19			=cut
20
21			=item C<new()>
22
23			Create a new HashDB object.
24
25			=item C<setdata(data, @keys)>
26
27			set a data item to the given keys.
28
29			=item C<getdata(@keys)>
30
31			return all data items that match the given keys.
32
33			=item C<deletedata(@keys)>
34
35			detete all data items that match the given keys.
36
37			=item C<match(@keys)>
38
39			return the full DataItem object refs that match keys.
40
41			=item C<items()>
42
43			return the number of seperate items in the store.
44
45			=item C<store(filename)>
46
47			dump to file.
48
49			=item C<restore(filename)>
50
51			restore from file.
52
53			=item C<alias(\@refofkeys,\@aliaskeys)>
54
55			attatch another set of keys to items that
56			match the refopfkeys (note that these are
57			references to the arrays).
58
59			=item unalias(@aliaskeys)
60
61			remove an alias.
62
63			=back
64
65			=head1 AUTHOR
66
67			Originally Written by Christopher Williams.
68
69			=head1 MAINTAINER
70
71			Shaun ASHBY L<mailTo:Shaun.Ashby@cern.ch>
72
73			=cut
74
75	williamc	1.1	package Utilities::HashDB;
76	williamc	1.3	use Utilities::DataItem;
77	williamc	1.4	use FileHandle;
78	williamc	1.1	require 5.001;
79
80			sub new {
81			my $class=shift;
82			$self={};
83			bless $self, $class;
84	williamc	1.3	$self->{dataitems}=();
85	williamc	1.1	return $self;
86			}
87
88			sub setdata {
89			my $self=shift;
90			my $data=shift;
91			my @keys=@_;
92
93	williamc	1.3	push @{$self->{dataitems}}, Utilities::DataItem->new($data, @keys);
94	williamc	1.1	}
95
96	williamc	1.6	sub alias {
97			my $self=shift;
98			my $keyref=shift;
99			my $aliaskeys=shift;
100
101			my @objs=$self->match(@{$keyref});
102			foreach $obj ( @objs ) {
103			$obj->alias(@{$aliaskeys});
104			}
105			}
106
107			sub unalias {
108			my $self=shift;
109			my @keys=@_;
110
111			my @objs=$self->match(@keys);
112			foreach $obj ( @objs ) {
113			$obj->unalias(@_);
114			}
115			}
116
117	williamc	1.1	sub items {
118			my $self=shift;
119	williamc	1.3	return $#{$self->{dataitems}};
120	williamc	1.1	}
121
122	williamc	1.3	sub deletedata {
123			my $self=shift;
124			my @keys=@_;
125
126			# first get all the keys we want to delete
127			my @match=$self->_match(@keys);
128			foreach $i ( @match ) {
129			splice (@{$self->{dataitems}}, $i, 1 );
130			}
131			}
132	williamc	1.1
133	williamc	1.3	sub match {
134	williamc	1.1	my $self=shift;
135			my @keys=@_;
136	williamc	1.3
137	williamc	1.1	my @data=();
138			my @match=$self->_match(@keys);
139	williamc	1.3	foreach $i ( @match ) {
140			push @data, $self->{dataitems}[$i];
141	williamc	1.1	}
142			return @data;
143			}
144
145	williamc	1.3	sub getdata {
146	williamc	1.1	my $self=shift;
147			my @keys=@_;
148	williamc	1.3
149			my @data=();
150	williamc	1.1	my @match=$self->_match(@keys);
151	williamc	1.3	my $i;
152	williamc	1.1	foreach $i ( @match ) {
153	williamc	1.3	push @data, ($self->{dataitems}[$i]->data());
154	williamc	1.1	}
155	williamc	1.3	return @data;
156	williamc	1.4	}
157
158			sub store {
159			my $self=shift;
160			my $filename=shift;
161
162			my $fh=FileHandle->new();
163	sashby	1.8	$fh->autoflush(1);
164	williamc	1.4	open ($fh, ">$filename") or die "Unable to open file $filename\n $!\n";
165			foreach $object ( @{$self->{dataitems}} ) {
166	williamc	1.6	print $fh "\n";
167			$object->store($fh);
168	sashby	1.8	}
169	williamc	1.4	close $fh;
170	sashby	1.8	}
171	williamc	1.4
172			sub restore {
173			my $self=shift;
174			my $filename=shift;
175	williamc	1.5	my @arr=();
176			my $data;
177	williamc	1.4
178			my $fh=FileHandle->new();
179			open ($fh, "<$filename") or die "Unable to open file $filename\n $!\n";
180			while ( <$fh> ) {
181	williamc	1.6	push @{$self->{dataitems}}, Utilities::DataItem->restore($fh);
182	williamc	1.4	}
183			close $fh;
184	williamc	1.1	}
185
186			# ------------------- Support Routines ------------
187			# returns list of array indices of items matching the keys
188	williamc	1.3
189	williamc	1.1	sub _match {
190			my $self=shift;
191			my @keys=@_;
192
193	williamc	1.3	my @matches=();
194			my $data;
195			for ( $i=0; $i<=$#{$self->{dataitems}}; $i++ ) {
196			$data=$self->{dataitems}[$i];
197			if ( $data->match(@keys) ) {
198			push @matches, $i;
199	williamc	1.1	}
200			}
201	williamc	1.3	return @matches;
202	williamc	1.1	}