src/Utilities/DataItem.pm

=head1 NAME

Utilities::DataItem - A data container with a list of lookup keys.

=head1 SYNOPSIS

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

=head1 DESCRIPTION

A data container with a list of lookup keys.

=head1 METHODS

=over

=cut

=item C<new(data,@key)
   A new DataItem object with the data matched to a keylist (See also restore).
   
=item C<keys()>
   Return a list of the fundamental keys for the data object.

=item C<data()>
   Return the data for the object.

=item C<match(@keys)>
   Return 1 if @keys matches those of the data item, else 0.

=item C<alias(@keys)>
   Provide an alternative set of keys for matching.

=item C<unalias(@keys)>
   Remove any aliases. Original keys cannot be removed.
   Returns 1 if successful, 0 otherwise.
   
=item C<store(fh)>
   Store to the given stream.

=item C<restore(fh)>
   Returns a new dataitem, initialised to the data found in fh.

=back

=head1 AUTHOR
   
Originally Written by Christopher Williams.

=head1 MAINTAINER

Shaun ASHBY 

=cut
   
package Utilities::DataItem;
require 5.001;

sub new {
        my $class=shift;
        my $data=shift;
        my @keys=@_;

        $self={};
        bless $self, $class;
        $self->{data}=$data;
        push @{$self->{keys}[0]},@keys; # fundamental keys
        return $self;
}

sub keys {
        my $self=shift;
        return @{$self->{keys}[0]};
}

sub data {
        my $self=shift;
        return $self->{data};
}

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

        my $nm;

        # search over all key aliases
        foreach $keyset ( @{$self->{keys}} ) {
         $nm=0;
         for ( $i=0; (($i <= $#keys) && ($i <=$#{$keyset} )); $i++ ) {
           if ( $$keyset[$i] eq $keys[$i] ) {
                $nm++;
           }
         }
         return 1 , if ( $nm > $#keys ); # Succesful match
        }
        return 0;
}

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

        if ( $#keys<0 ) {
                die "Unable to set an alias with no keys\n";
        }
        push @{$self->{keys}},[@keys];
}

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

        my $rv=0;
        for ( my $i=1; $i<=$#{$self->{keys}}; $i++ ) {
         if ( "@{$self->{keys}[$i]}" eq "@keys" ) {
           undef $self->{keys}[$i];
           splice( @{$self->{keys}}, $i, 1);
           $rv=1;
         }
        }
        return $rv;
}

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

        # print the keys first, aliases, then the data
        foreach $keyset ( @{$self->{keys}} ) {
         foreach $key ( @{$keyset} ) {
           print $fh "#".$key."\n";
         }
         print $fh "#\n"; # alias marker
        }
        print $fh ">".$self->data()."\n";
}

sub restore {
        my $class=shift;
        my $fh=shift;

        $self={};
        bless $self, $class;

        my @arr=();
        while ( <$fh> ) {
          chomp;
          if ( $_ eq "#") { # set aliases
            $self->alias(@arr);
            @arr=();
          }
          elsif ( $_=~/^#(.*)/ ) {
            push @arr, $1;
          }
          elsif ( $_=~/^>(.*)/ ) { # load in data
            $data=$1;
            $self->{data}=$data;
            last;
          }
          else {
            print "Data corruption detected\n";
            last;
          }
        }
        return $self;
}
Revision:	1.5
Committed:	Wed Aug 17 11:11:48 2005 UTC (19 years, 8 months ago) by sashby
Content type:	text/plain
Branch:	MAIN
CVS Tags:	V1_0_4p1, V1_0_2, V1_0_2_p1
Branch point for:	v103_branch
Changes since 1.4:	+1 -1 lines
Log Message:	Added more POD doc.
#	User	Rev	Content
1	sashby	1.4	=head1 NAME
2	williamc	1.1
3	sashby	1.4	Utilities::DataItem - A data container with a list of lookup keys.
4
5			=head1 SYNOPSIS
6
7			my $obj = Utilities::DataItem->new();
8
9			=head1 DESCRIPTION
10
11			A data container with a list of lookup keys.
12
13			=head1 METHODS
14
15			=over
16
17			=cut
18
19			=item C<new(data,@key)
20			A new DataItem object with the data matched to a keylist (See also restore).
21
22			=item C<keys()>
23			Return a list of the fundamental keys for the data object.
24
25			=item C<data()>
26			Return the data for the object.
27
28			=item C<match(@keys)>
29			Return 1 if @keys matches those of the data item, else 0.
30
31			=item C<alias(@keys)>
32			Provide an alternative set of keys for matching.
33
34			=item C<unalias(@keys)>
35			Remove any aliases. Original keys cannot be removed.
36			Returns 1 if successful, 0 otherwise.
37
38			=item C<store(fh)>
39			Store to the given stream.
40
41			=item C<restore(fh)>
42			Returns a new dataitem, initialised to the data found in fh.
43
44			=back
45
46			=head1 AUTHOR
47
48			Originally Written by Christopher Williams.
49
50			=head1 MAINTAINER
51
52	sashby	1.5	Shaun ASHBY
53	sashby	1.4
54			=cut
55
56	williamc	1.1	package Utilities::DataItem;
57			require 5.001;
58
59			sub new {
60			my $class=shift;
61			my $data=shift;
62			my @keys=@_;
63
64			$self={};
65			bless $self, $class;
66			$self->{data}=$data;
67	williamc	1.3	push @{$self->{keys}[0]},@keys; # fundamental keys
68	williamc	1.1	return $self;
69			}
70
71			sub keys {
72			my $self=shift;
73	williamc	1.3	return @{$self->{keys}[0]};
74	williamc	1.1	}
75
76			sub data {
77			my $self=shift;
78			return $self->{data};
79			}
80
81			sub match {
82			my $self=shift;
83			my @keys=@_;
84
85	williamc	1.3	my $nm;
86	williamc	1.1
87	williamc	1.3	# search over all key aliases
88			foreach $keyset ( @{$self->{keys}} ) {
89			$nm=0;
90			for ( $i=0; (($i <= $#keys) && ($i <=$#{$keyset} )); $i++ ) {
91			if ( $$keyset[$i] eq $keys[$i] ) {
92	williamc	1.1	$nm++;
93	williamc	1.3	}
94			}
95			return 1 , if ( $nm > $#keys ); # Succesful match
96			}
97			return 0;
98			}
99
100			sub alias {
101			my $self=shift;
102			my @keys=@_;
103
104			if ( $#keys<0 ) {
105			die "Unable to set an alias with no keys\n";
106			}
107			push @{$self->{keys}},[@keys];
108			}
109
110			sub unalias {
111			my $self=shift;
112			my @keys=@_;
113
114			my $rv=0;
115			for ( my $i=1; $i<=$#{$self->{keys}}; $i++ ) {
116			if ( "@{$self->{keys}[$i]}" eq "@keys" ) {
117			undef $self->{keys}[$i];
118			splice( @{$self->{keys}}, $i, 1);
119			$rv=1;
120			}
121			}
122			return $rv;
123			}
124
125			sub store {
126			my $self=shift;
127			my $fh=shift;
128
129			# print the keys first, aliases, then the data
130			foreach $keyset ( @{$self->{keys}} ) {
131			foreach $key ( @{$keyset} ) {
132			print $fh "#".$key."\n";
133			}
134			print $fh "#\n"; # alias marker
135			}
136			print $fh ">".$self->data()."\n";
137			}
138
139			sub restore {
140			my $class=shift;
141			my $fh=shift;
142
143			$self={};
144			bless $self, $class;
145
146			my @arr=();
147			while ( <$fh> ) {
148			chomp;
149			if ( $_ eq "#") { # set aliases
150			$self->alias(@arr);
151			@arr=();
152			}
153			elsif ( $_=~/^#(.*)/ ) {
154			push @arr, $1;
155			}
156			elsif ( $_=~/^>(.*)/ ) { # load in data
157			$data=$1;
158			$self->{data}=$data;
159			last;
160			}
161			else {
162			print "Data corruption detected\n";
163			last;
164	williamc	1.1	}
165			}
166	williamc	1.3	return $self;
167	williamc	1.1	}