diff options
Diffstat (limited to 'fml/lib/File/LogStructuredData.pm')
| -rw-r--r-- | fml/lib/File/LogStructuredData.pm | 271 |
1 files changed, 271 insertions, 0 deletions
diff --git a/fml/lib/File/LogStructuredData.pm b/fml/lib/File/LogStructuredData.pm new file mode 100644 index 00000000..885f7408 --- /dev/null +++ b/fml/lib/File/LogStructuredData.pm @@ -0,0 +1,271 @@ +#-*- perl -*- +# +# Copyright (C) 2001 Ken'ichi Fukamachi +# All rights reserved. This program is free software; you can +# redistribute it and/or modify it under the same terms as Perl itself. +# +# $Id$ +# $FML$ +# + +package File::LogStructuredData; + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); +use Carp; + +=head1 NAME + +File::LogStructuredData - hash emulation for a log structered file + +=head1 SYNOPSIS + + use File::LogStructuredData; + $db = new File::LogStructuredData { file => 'cache.txt' }; + + # add value for the key 'rudo' + $db->append('rudo', 'is pretty'); + + # get all entries with the key = 'rudo' + $values = $db->find( 'rudo' ); + +where $values->[0] is "is pretty'. + +If you want to use C<tie()> style, you can use it like this: + + use File::LogStructuredData; + tie %db, 'File::LogStructuredData', { file => 'cache.txt' }; + print $db{ rudo }, "\n"; + +where the format of "cache.txt" is "key value" for each line. +For example + + rudo teddy bear + kenken north fox + ..... + +By default, FETCH() returns the first value with the key. + + use File::LogStructuredData; + tie %db, 'File::LogStructuredData', { first_match => 1, file => 'cache.txt' }; + print $db{ rudo }, "\n"; + +If you print out the latest value (so at the later line somewhere in +the file) for the specified C<$key> + + use File::LogStructuredData; + tie %db, 'File::LogStructuredData', { last_match => 1, file => 'cache.txt' }; + print $db{ rudo }, "\n"; + +=head1 METHODS + +=head2 TIEHASH, FETCH, STORE, FIRSTKEY, NEXTKEY + +standard hash functions. + +=cut + + +# Descriptions: constructor +# Arguments: $self $args +# Side Effects: import _match_style into $self +# Return Value: object +sub new +{ + my ($self, $args) = @_; + my ($type) = ref($self) || $self; + my $me = {}; + + $me->{ _file } = $args->{ file }; + + if ($args->{ first_match }) { + $me->{ _match_style } = 'first'; + } + elsif ($args->{ last_match }) { + $me->{ _match_style } = 'last'; + } + else { + $me->{ _match_style } = 'first'; + } + + return bless $me, $type; +} + + +sub TIEHASH +{ + my ($self, $args) = @_; + my ($type) = ref($self) || $self; + new($self, $args); +} + + +sub FETCH +{ + my ($self, $key) = @_; + $self->_fetch($key, 'scalar'); +} + + +sub STORE +{ + my ($self, $key, $value) = @_; +} + + +sub FIRSTKEY +{ + my ($self) = @_; + + use IO::File; + my $fh = new IO::File; + $fh->open( $self->{ _file }, "r"); + $self->{ _fh } = $fh; + + my $r = <$fh>; + my @r = split(/\s+/, $r); + return $r[0]; +} + + +sub NEXTKEY +{ + my ($self) = @_; + my $fh = $self->{ _fh }; + my $r = <$fh>; + my @r = split(/\s+/, $r); + return $r[0]; +} + + +=head2 C<find(key)> + +return the line with the C<key>. +The line is either first or last mached line. +It is determined by C<last_match> or C<first_match> parameter at +C<new()> method. +C<first_match> by default. + +=cut + +sub find +{ + my ($self, $key) = @_; + return $self->_fetch($key, 'array'); +} + + + +=head2 C<get_value(key)> + +get the latest value for the C<key>. + +=cut + + +sub get_value +{ + my ($self, $key) = @_; + my $ra = $self->_fetch($key, 'array'); + my $x; + for (@$ra) { $x = $_;} + return $x; +} + + +# Descriptions: real function to search $key. +# This routine is used at find() and FETCH() methods. +# return the value with the $key +# $self->{ _match_style } conrolls the matching algorithm +# is either of the fist or last match. +# Arguments: $self $key $mode +# $key is the string to search. +# $mode selects the return value style, scalar or array. +# Side Effects: none +# Return Value: SCALAR or ARRAY with the key +sub _fetch +{ + my ($self, $key, $mode) = @_; + my $prekey = $key; + + # the first 1 byte of the key + if ($key =~ /^(.)/) { $prekey = $1;} + + use IO::File; + my $fh = new IO::File; + $fh->open( $self->{ _file }, "r"); + + my ($xkey, $xvalue) = (); + my (@values) = (); + SEARCH: + while (<$fh>) { + next SEARCH if /^\#*$/; + next SEARCH if /^\s*$/; + next SEARCH unless /^$prekey/i; + next SEARCH unless /^$key/i; + + chop; + + ($xkey, $xvalue) = split(/\s+/, $_, 2); + if ($xkey eq $key) { + if ($mode eq 'array') { + push(@values, $xvalue); + } + if ($mode eq 'scalar') { + # firstmatch: exit loop ASAP if the $key is found. + if ($self->{ _match_style } eq 'first') { + last SEARCH; + } + } + } + } + close($fh); + + if ($mode eq 'scalar') { + return( $xvalue || undef ); + } + if ($mode eq 'array') { + return \@values; + } +} + + +=head2 C<append($key, $value)> + +append C<$key> and C<$value> to the database. + +=cut + + +sub append +{ + my ($self, $key, $value) = @_; + + use IO::File; + my $fh = new IO::File; + $fh->open( $self->{ _file }, "a"); + $fh->autoflush(1); + print $fh $key, " ", $value, "\n"; + $fh->close; +} + + +=head1 AUTHOR + +Ken'ichi Fukamachi + +=head1 COPYRIGHT + +Copyright (C) 2001 Ken'ichi Fukamachi + +All rights reserved. This program is free software; you can +redistribute it and/or modify it under the same terms as Perl itself. + +=head1 HISTORY + +File::LogStructuredData appeared in fml5 mailing list driver package. +See C<http://www.fml.org/> for more details. + +=cut + +1; |