From aeef9fb9368030a4e60eadd14dfefbf49dddf296 Mon Sep 17 00:00:00 2001 From: fukachan Date: Tue, 20 Feb 2001 08:07:38 +0000 Subject: rename LogFileDB to JournaledFile --- fml/lib/Tie/JournaledFile.pm | 202 +++++++++++++++++++++++++++++++++++++++++++ fml/lib/Tie/LogFileDB.pm | 202 ------------------------------------------- 2 files changed, 202 insertions(+), 202 deletions(-) create mode 100644 fml/lib/Tie/JournaledFile.pm delete mode 100644 fml/lib/Tie/LogFileDB.pm (limited to 'fml') diff --git a/fml/lib/Tie/JournaledFile.pm b/fml/lib/Tie/JournaledFile.pm new file mode 100644 index 00000000..b4707aac --- /dev/null +++ b/fml/lib/Tie/JournaledFile.pm @@ -0,0 +1,202 @@ +#-*- 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 Tie::JournaledFile; + +use strict; +use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); +use Carp; + +=head1 NAME + +Tie::JournaledFile - hash emulation for a log structered file + +=head1 SYNOPSIS + + use Tie::JournaledFile; + $db = new Tie::JournaledFile { file => 'cache.txt' }; + + # all entries with the key = 'rudo' + @values = $db->grep( rudo ); + +or + + use Tie::JournaledFile; + tie %db, 'Tie::JournaledFile', { file => 'cache.txt' }; + print $db{ rudo }, "\n"; + +where cache file "cache.txt" format 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 Tie::JournaledFile; + tie %db, 'Tie::JournaledFile', { first_match => 1, file => 'cache.txt' }; + print $db{ rudo }, "\n"; + +if you find the latest value (so at the later line somewhere in the +file) for the $key + + use Tie::JournaledFile; + tie %db, 'Tie::JournaledFile', { last_match => 1, file => 'cache.txt' }; + print $db{ rudo }, "\n"; + +=cut + + +require Exporter; +@ISA = qw(Exporter); + +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 grep +{ + my ($self, $key) = @_; + my $rarray = $self->_fetch($key, 'array'); + return @$rarray; +} + + +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]; +} + + +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; + } +} + + +=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 + +Tie::JournaledFile appeared in fml5 mailing list driver package. +See C for more details. + +=cut + +1; diff --git a/fml/lib/Tie/LogFileDB.pm b/fml/lib/Tie/LogFileDB.pm deleted file mode 100644 index 0dcb4ade..00000000 --- a/fml/lib/Tie/LogFileDB.pm +++ /dev/null @@ -1,202 +0,0 @@ -#-*- 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 Tie::LogFileDB; - -use strict; -use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); -use Carp; - -=head1 NAME - -Tie::LogFileDB - hash emulation for a log structered file - -=head1 SYNOPSIS - - use Tie::LogFileDB; - $db = new Tie::LogFileDB { file => 'cache.txt' }; - - # all entries with the key = 'rudo' - @values = $db->grep( rudo ); - -or - - use Tie::LogFileDB; - tie %db, 'Tie::LogFileDB', { file => 'cache.txt' }; - print $db{ rudo }, "\n"; - -where cache file "cache.txt" format 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 Tie::LogFileDB; - tie %db, 'Tie::LogFileDB', { first_match => 1, file => 'cache.txt' }; - print $db{ rudo }, "\n"; - -if you find the latest value (so at the later line somewhere in the -file) for the $key - - use Tie::LogFileDB; - tie %db, 'Tie::LogFileDB', { last_match => 1, file => 'cache.txt' }; - print $db{ rudo }, "\n"; - -=cut - - -require Exporter; -@ISA = qw(Exporter); - -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 grep -{ - my ($self, $key) = @_; - my $rarray = $self->_fetch($key, 'array'); - return @$rarray; -} - - -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]; -} - - -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; - } -} - - -=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 - -Tie::LogFileDB appeared in fml5 mailing list driver package. -See C for more details. - -=cut - -1; -- cgit v1.2.1