src/Utilities/HashDB.pm

=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 

=cut
   
package Utilities::HashDB;
use Utilities::DataItem;
use FileHandle;
require 5.004;

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;

        use FileHandle;      
        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;
        # Make $_ local so it's writable, otherwise you get errors like this:
        # Modification of a read-only value attempted at
        # /afs/cern.ch/user/s/sashby/w2/SCRAM/V1_0_3/src/Utilities/HashDB.pm line 178.
        local $_;

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