separete database part in FML::Confirm to FML::Cache::Journal which

can be shared between other modules.

change FML::Confirm::new() to take $curproc.

9 files changed, 372 insertions, 62 deletions

diff --git a/fml/lib/FML/Cache/Journal.pm b/fml/lib/FML/Cache/Journal.pm
new file mode 100644
index 00000000..70e44b72
--- /dev/null
+++ b/fml/lib/FML/Cache/Journal.pm
@@ -0,0 +1,111 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2003 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.
+#
+# $FML: @template.pm,v 1.7 2003/01/01 02:06:22 fukachan Exp $
+#
+
+package FML::Cache::Journal;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+=head1 NAME
+
+FML::Cache::Journal - inteface into Tie::JournaledDir
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 new($curproc)
+
+=head2 open_db()
+
+=head2 close_db() 
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) OBJ($curproc)
+# Side Effects: create object
+# Return Value: OBJ
+sub new
+{
+    my ($self, $curproc) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = { _curproc => $curproc };
+
+    return bless $me, $type;
+}
+
+
+# Descriptions: open database by Tie::JournaledDir.
+#    Arguments: OBJ($self) STR($cache_dir) STR($class)
+# Side Effects: open database, mkdir if needed
+# Return Value: HASH_REF to dabase
+sub open
+{
+    my ($self, $cache_dir, $class) = @_;
+    my (%db) = ();
+
+    # XXX-TODO: dir_mode hard-coded.
+    my $mode = $self->{ _dir_mode } || 0700;
+
+    use File::Spec;
+    my $dir  = File::Spec->catfile($cache_dir, $class);
+    unless (-d $dir) {
+	my $curproc = $self->{ _curproc };
+	$curproc->mkdir($dir, $mode);
+    }
+
+    use Tie::JournaledDir;
+    tie %db, 'Tie::JournaledDir', { dir => $dir };
+
+    $self->{ _db } = \%db;
+
+    return \%db;
+}
+
+
+# Descriptions: close database.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: none
+sub close
+{
+    my ($self) = @_;
+    my $db = $self->{ _db };
+    untie %$db;
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 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
+
+FML::Cache::Journal appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Command/User/chaddr.pm b/fml/lib/FML/Command/User/chaddr.pm
index e56f8b28..66cf9f55 100644
--- a/fml/lib/FML/Command/User/chaddr.pm
+++ b/fml/lib/FML/Command/User/chaddr.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: chaddr.pm,v 1.22 2003/08/29 15:34:00 fukachan Exp $
+# $FML: chaddr.pm,v 1.23 2003/10/17 14:00:52 fukachan Exp $
 #
 
 package FML::Command::User::chaddr;
@@ -116,7 +116,7 @@ sub process
 
 	# XXX-TODO: should be FML::Confirm { ... address => [ @addr ] } ?
 	use FML::Confirm;
-	my $confirm = new FML::Confirm {
+	my $confirm = new FML::Confirm $curproc, {
 	    keyword   => $keyword,
 	    cache_dir => $cache_dir,
 	    class     => 'chaddr',
diff --git a/fml/lib/FML/Command/User/confirm.pm b/fml/lib/FML/Command/User/confirm.pm
index 5dab826b..6002b102 100644
--- a/fml/lib/FML/Command/User/confirm.pm
+++ b/fml/lib/FML/Command/User/confirm.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: confirm.pm,v 1.24 2003/08/29 15:34:00 fukachan Exp $
+# $FML: confirm.pm,v 1.25 2003/11/17 13:06:12 fukachan Exp $
 #
 
 package FML::Command::User::confirm;
@@ -103,7 +103,7 @@ sub process
     }
 
     use FML::Confirm;
-    my $confirm = new FML::Confirm {
+    my $confirm = new FML::Confirm $curproc, {
 	keyword   => $keyword,
 	cache_dir => $cache_dir,
 	class     => $class,
diff --git a/fml/lib/FML/Command/User/off.pm b/fml/lib/FML/Command/User/off.pm
index f5a13769..8cf3db33 100644
--- a/fml/lib/FML/Command/User/off.pm
+++ b/fml/lib/FML/Command/User/off.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: off.pm,v 1.10 2003/08/23 07:24:44 fukachan Exp $
+# $FML: off.pm,v 1.11 2003/08/29 15:34:00 fukachan Exp $
 #
 
 package FML::Command::User::off;
@@ -108,7 +108,7 @@ sub process
 	$curproc->log("off request, try confirmation");
 
         use FML::Confirm;
-	my $confirm = new FML::Confirm {
+	my $confirm = new FML::Confirm $curproc, {
 	    keyword   => $keyword,
 	    cache_dir => $cache_dir,
 	    class     => 'off',
diff --git a/fml/lib/FML/Command/User/on.pm b/fml/lib/FML/Command/User/on.pm
index 3703eb4f..35128b6f 100644
--- a/fml/lib/FML/Command/User/on.pm
+++ b/fml/lib/FML/Command/User/on.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: on.pm,v 1.10 2003/08/23 07:24:44 fukachan Exp $
+# $FML: on.pm,v 1.11 2003/08/29 15:34:00 fukachan Exp $
 #
 
 package FML::Command::User::on;
@@ -110,7 +110,7 @@ sub process
     else {
 	$curproc->log("on request, try confirmation");
 	use FML::Confirm;
-	my $confirm = new FML::Confirm {
+	my $confirm = new FML::Confirm $curproc, {
 	    keyword   => $keyword,
 	    cache_dir => $cache_dir,
 	    class     => 'on',
diff --git a/fml/lib/FML/Command/User/subscribe.pm b/fml/lib/FML/Command/User/subscribe.pm
index 370db4cc..343cb07c 100644
--- a/fml/lib/FML/Command/User/subscribe.pm
+++ b/fml/lib/FML/Command/User/subscribe.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: subscribe.pm,v 1.21 2003/08/23 07:24:44 fukachan Exp $
+# $FML: subscribe.pm,v 1.22 2003/08/29 15:34:01 fukachan Exp $
 #
 
 package FML::Command::User::subscribe;
@@ -103,7 +103,7 @@ sub process
     else {
 	$curproc->log("new subscriber, try confirmation");
 	use FML::Confirm;
-	my $confirm = new FML::Confirm {
+	my $confirm = new FML::Confirm $curproc, {
 	    keyword   => $keyword,
 	    cache_dir => $cache_dir,
 	    class     => 'subscribe',
diff --git a/fml/lib/FML/Command/User/unsubscribe.pm b/fml/lib/FML/Command/User/unsubscribe.pm
index d9e9123e..6a17305a 100644
--- a/fml/lib/FML/Command/User/unsubscribe.pm
+++ b/fml/lib/FML/Command/User/unsubscribe.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: unsubscribe.pm,v 1.21 2003/08/23 07:24:44 fukachan Exp $
+# $FML: unsubscribe.pm,v 1.22 2003/08/29 15:34:01 fukachan Exp $
 #
 
 package FML::Command::User::unsubscribe;
@@ -101,7 +101,7 @@ sub process
 	$curproc->log("unsubscribe request, try confirmation");
 
         use FML::Confirm;
-	my $confirm = new FML::Confirm {
+	my $confirm = new FML::Confirm $curproc, {
 	    keyword   => $keyword,
 	    cache_dir => $cache_dir,
 	    class     => 'unsubscribe',
diff --git a/fml/lib/FML/Confirm.pm b/fml/lib/FML/Confirm.pm
index fa3c6e6e..e7c02702 100644
--- a/fml/lib/FML/Confirm.pm
+++ b/fml/lib/FML/Confirm.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: Confirm.pm,v 1.11 2003/08/23 15:33:11 fukachan Exp $
+# $FML: Confirm.pm,v 1.12 2003/11/17 13:06:11 fukachan Exp $
 #
 
 package FML::Confirm;
@@ -19,7 +19,7 @@ FML::Confirm - manipulate confirmation database
 =head1 SYNOPSIS
 
     use FML::Confirm;
-    my $confirm = new FML::Confirm {
+    my $confirm = new FML::Confirm $curproc, {
             keyword   => $keyword,
             cache_dir => $cache_dir,
             class     => 'subscribe',
@@ -56,21 +56,24 @@ usual constructor.
 
 
 # Descriptions: constructor.
-#    Arguments: OBJ($self) HASH_REF($args)
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($cargs)
 # Side Effects: create object
 # Return Value: OBJ
 sub new
 {
-    my ($self, $args) = @_;
+    my ($self, $curproc, $cargs) = @_;
     my ($type) = ref($self) || $self;
-    my $me     = {};
+    my $me     = { _curproc => $curproc };
 
     for my $id ('keyword', 'class', 'address', 'buffer', 'cache_dir') {
-	if (defined $args->{ $id }) {
-	    $me->{ "_$id" } = $args->{ $id };
+	if (defined $cargs->{ $id }) {
+	    $me->{ "_$id" } = $cargs->{ $id };
 	}
     }
 
+    use FML::Cache::Journal;
+    $me->{ _journal_db } = new FML::Cache::Journal $curproc;
+
     return bless $me, $type;
 }
 
@@ -109,49 +112,6 @@ sub assign_id
 }
 
 
-# Descriptions: open database by Tie::JournaledDir.
-#    Arguments: OBJ($self) STR($id) STR($comment)
-# Side Effects: open database, mkdir if needed
-# Return Value: HASH_REF to dabase
-sub _open_db
-{
-    my ($self, $id, $comment) = @_;
-    my (%db) = ();
-
-    # XXX-TODO: dir_mode hard-coded.
-    my $mode = $self->{ _dir_mode } || 0700;
-
-    use File::Spec;
-    my $cache_dir = $self->{ _cache_dir };
-    my $class     = $self->{ _class };
-    my $dir       = File::Spec->catfile($cache_dir, $class);
-
-    unless (-d $dir) {
-	use File::Path;
-	mkpath( [ $dir ], 0, $mode );
-    }
-
-    use Tie::JournaledDir;
-    tie %db, 'Tie::JournaledDir', { dir => $dir };
-
-    $self->{ _db } = \%db;
-
-    return \%db;
-}
-
-
-# Descriptions: close database.
-#    Arguments: OBJ($self)
-# Side Effects: none
-# Return Value: none
-sub _close_db
-{
-    my ($self) = @_;
-    my $db = $self->{ _db };
-    untie %$db;
-}
-
-
 =head2 store_id($id, $comment)
 
 save id into databse with comment if specified.
@@ -279,6 +239,46 @@ sub is_expired
 }
 
 
+=head1 Cache database
+
+This cache uses C<FML::Cache::Journal> based on C<Tie::JournaledDir>.
+
+=head2 _open_db()
+
+=head2 _close_db()
+
+=cut
+
+
+# Descriptions: open cache database.
+#    Arguments: OBJ($self)
+# Side Effects: close db
+# Return Value: HASH_REF
+sub _open_db
+{
+    my ($self) = @_;
+    my $db    = $self->{ _journal_db };
+    my $dir   = $self->{ _cache_dir };
+    my $class = $self->{ _class };
+    my $_db   = $db->open($dir, $class);
+
+    $self->{ _db } = $_db;
+    return $_db;
+}
+
+
+# Descriptions: close database interface.
+#    Arguments: OBJ($self)
+# Side Effects: close db
+# Return Value: none
+sub _close_db
+{
+    my ($self) = @_;
+    my $db = $self->{ _journal_db };
+    $db->close();
+}
+
+
 =head1 CODING STYLE
 
 See C<http://www.fml.org/software/FNF/> on fml coding style guide.
diff --git a/fml/lib/FML/Data/Deadline.pm b/fml/lib/FML/Data/Deadline.pm
new file mode 100644
index 00000000..121b5a95
--- /dev/null
+++ b/fml/lib/FML/Data/Deadline.pm
@@ -0,0 +1,199 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2003 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.
+#
+# $FML: @template.pm,v 1.7 2003/01/01 02:06:22 fukachan Exp $
+#
+
+package FML::Data::Deadline;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+=head1 NAME
+
+FML::Data::Deadline - maintain data with expiration.
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 C<new()>
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($cargs)
+# Side Effects: create object
+# Return Value: OBJ
+sub new
+{
+    my ($self, $curproc, $cargs) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = { _curproc => $curproc };
+
+    for my $id ('keyword', 'class', 'address', 'buffer', 'cache_dir') {
+	if (defined $cargs->{ $id }) {
+	    $me->{ "_$id" } = $cargs->{ $id };
+	}
+    }
+
+    use FML::Cache::Journal;
+    $me->{ _journal_db } = new FML::Cache::Journal $curproc;
+
+    return bless $me, $type;
+}
+
+
+=head2 add($key, $value)
+
+=cut
+
+
+# Descriptions: add { $key => $value }.
+#    Arguments: OBJ($self) STR($key) STR($value)
+# Side Effects: update database
+# Return Value: none
+sub add
+{
+    my ($self, $key, $value) = @_;
+    my $class = $self->{ _class };
+    my $addr  = $self->{ _address };
+
+    # update database.
+    my $db    = $self->_open_db();
+    $db->{ $key } = sprintf("%s submitted_time=%s", $value, time);
+    $self->_close_db();
+}
+
+
+=head2 find($key)
+
+find value for $key not expired yet.
+
+=cut
+
+
+# Descriptions: find value for $key
+#    Arguments: OBJ($self) STR($key)
+# Side Effects: none
+# Return Value: STR
+sub find
+{
+    my ($self, $key) = @_;
+
+    if ($self->is_expired($key)) {
+	return '';
+    }
+    else {
+	# search
+	my $db    = $self->_open_db();
+	my $found = $db->{ $key } || '';
+	$self->_close_db();
+
+	($found)  = split(/\s+/, $found);
+	return( $found || '' );
+    }
+}
+
+
+=head2 is_expired($key)
+
+check if $key is is_expired.
+
+=cut
+
+
+# Descriptions: check if $key is is_expired
+#    Arguments: OBJ($self) STR($key)
+# Side Effects: none
+# Return Value: NUM(1 or 0)
+sub is_expired
+{
+    my ($self, $key) = @_;
+    my $now = time;
+
+    # get value
+    my $db    = $self->_open_db();
+    my $found = $db->{ $key } || '';
+    $self->_close_db();
+
+    my ($xkey, $time)  = split(/\s+/, $found);
+    if ($time > $now) {
+	return 1;
+    }
+    else {
+	return 0;
+    }
+}
+
+
+=head1 Cache database
+
+This cache uses C<FML::Cache::Journal> based on C<Tie::JournaledDir>.
+
+=head2 _open_db()
+
+=head2 _close_db()
+
+=cut
+
+
+# Descriptions: open cache database.
+#    Arguments: OBJ($self)
+# Side Effects: close db
+# Return Value: HASH_REF
+sub _open_db
+{
+    my ($self) = @_;
+    my $db    = $self->{ _journal_db };
+    my $dir   = $self->{ _cache_dir };
+    my $class = $self->{ _class };
+    my $_db   = $db->open($dir, $class);
+
+    $self->{ _db } = $_db;
+    return $_db;
+}
+
+
+# Descriptions: close database interface.
+#    Arguments: OBJ($self)
+# Side Effects: close db
+# Return Value: none
+sub _close_db
+{
+    my ($self) = @_;
+    my $db = $self->{ _journal_db };
+    $db->close();
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2003 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
+
+FML::Data::Deadline appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;