From df88fed133dd67f2d6fd34d4d3b3c7642affe890 Mon Sep 17 00:00:00 2001
From: fukachan <fukachan>
Date: Fri, 26 Jan 2001 07:21:32 +0000
Subject: log structured file db

---
 fml/lib/Tie/LogFileDB.pm | 183 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 183 insertions(+)
 create mode 100644 fml/lib/Tie/LogFileDB.pm

diff --git a/fml/lib/Tie/LogFileDB.pm b/fml/lib/Tie/LogFileDB.pm
new file mode 100644
index 00000000..6759a60a
--- /dev/null
+++ b/fml/lib/Tie/LogFileDB.pm
@@ -0,0 +1,183 @@
+#-*- 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 IO::LogFileDB;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+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 _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 NAME
+
+IO::LogFileDB.pm - what is this
+
+=head1 SYNOPSIS
+
+   use IO::LogFileDB;
+   $db = new IO::LogFileDB { file => 'cache.txt' };
+
+   # all entries with the key = 'rudo'
+   @values = $db->grep( rudo );
+
+or
+
+   use IO::LogFileDB;
+   tie %db, 'IO::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 IO::LogFileDB;
+   tie %db, 'IO::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 IO::LogFileDB;
+   tie %db, 'IO::LogFileDB', { last_match => 1, file => 'cache.txt' };
+   print $db{ rudo }, "\n";
+
+
+
+=head1 DESCRIPTION
+
+=head2 new
+
+=item Function()
+
+
+=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
+
+IO::LogFileDB.pm appeared in fml5.
+
+=cut
+
+1;
-- 
cgit v1.2.1