make File::LogStructuredData to build { key => value } pair in the log

structured file.

3 files changed, 309 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;
diff --git a/fml/lib/File/idea.ja.html b/fml/lib/File/idea.ja.html
new file mode 100644
index 00000000..f957e7ad
--- /dev/null
+++ b/fml/lib/File/idea.ja.html
@@ -0,0 +1,31 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+2, 3 のアイデアメモ
+</TITLE>
+<META http-equiv="Content-Type"
+	content="text/html; charset=EUC-JP">
+</HEAD>
+
+<BODY BGCOLOR="#E6E6FA">
+<!-- ================== body =========================================== -->
+
+<P> メモ:
+
+バッファのスタイルは２つある。
+<UL>
+
+	<LI>
+	ファイルに append していくもの。
+	Log Structured File Buffer とでもいうべきか？
+
+	<LI>
+	あるディレクトリ。その中にあるどれかのファイル
+	File::RingBuffer はそういったディレクトリを操作するためのもの。
+	db/ には 1 〜 100 のファイルがつくられ、順番に使われる。
+
+</UL>
+
+</BODY>
+</HTML>
diff --git a/fml/lib/File/index.ja.html b/fml/lib/File/index.ja.html
index 40c4d631..6dd50b8c 100644
--- a/fml/lib/File/index.ja.html
+++ b/fml/lib/File/index.ja.html
@@ -14,6 +14,13 @@ File::* classes
 <TABLE>
 <TR>
 <TD>
+ LogStructuredData.pm <TD>
+<A HREF="LogStructuredData.pm">[source]</A>
+<TD>
+<A HREF="@@doc/LogStructuredData.txt">[manual]</A>
+<TD>
+<TR>
+<TD>
  RingBuffer.pm <TD>
 <A HREF="RingBuffer.pm">[source]</A>
 <TD>