address fault handling

2 files changed, 161 insertions, 1 deletions

diff --git a/fml/lib/FML/Fault/Address.pm b/fml/lib/FML/Fault/Address.pm
new file mode 100644
index 00000000..efb3f760
--- /dev/null
+++ b/fml/lib/FML/Fault/Address.pm
@@ -0,0 +1,148 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2006 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.10 2006/01/07 13:16:41 fukachan Exp $
+#
+
+package FML::Fault::Address;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+=head1 NAME
+
+FML::Fault::Address - fault handler
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 C<new()>
+
+constructor.
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) OBJ($curproc)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self, $curproc) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = { _curproc => $curproc };
+    return bless $me, $type;
+}
+
+
+=head2 try_subscribe()
+
+check address and subscribe address if it is not a member
+
+=head2 subscribe($addr)
+
+subscribe $addr.
+
+=cut
+
+
+# Descriptions: subscribe address if it is not a member.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: none
+sub try_subscribe
+{
+    my ($self)  = @_;
+    my $curproc = $self->{ _curproc };
+    my $cred    = $curproc->credential();
+    my $list    = $curproc->get_address_fault_list() || [];
+
+    if (@$list) {
+	$curproc->log("address fault requested");
+	for my $addr (@$list) {
+	    unless ($cred->is_member($addr)) {
+		$self->subscribe($addr);
+	    }
+	    else {
+		$curproc->logdebug("$addr is already a member");
+	    }
+	}
+    }
+}
+
+
+# Descriptions: subscribe the specified address.
+#    Arguments: OBJ($self) STR($addr)
+# Side Effects: none
+# Return Value: none
+sub subscribe
+{
+    my ($self, $addr) = @_;
+    my ($curproc) = $self->{ _curproc };
+    my $method = "subscribe";
+    my @options = ($addr);
+
+    $curproc->log("subscribe $addr");
+
+    my $command_args = $curproc->command_context_init("$method $addr");
+    $command_args->{ command_mode } = "Admin";
+    $command_args->{ comname      } = $method;
+    $command_args->{ command      } = "$method @options";
+    $command_args->{ options      } = \@options;
+
+    require FML::Command;
+    my $obj = new FML::Command;
+
+    if (defined $obj) {
+        # execute command ($comname method) under eval().
+        eval q{
+            $obj->$method($curproc, $command_args);
+        };
+        unless ($@) {
+            ; # not show anything
+        }
+        else {
+            my $r = $@;
+            $curproc->logerror("command $method fail");
+            $curproc->logerror($r);
+            if ($r =~ /^(.*)\s+at\s+/) {
+                my $reason = $1;
+                $curproc->logerror($reason); # pick up reason
+                croak($reason);
+            }
+        }
+    }
+}
+
+
+=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) 2006 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::Fault::Address appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Process/Distribute.pm b/fml/lib/FML/Process/Distribute.pm
index 8320b17a..a716fe00 100644
--- a/fml/lib/FML/Process/Distribute.pm
+++ b/fml/lib/FML/Process/Distribute.pm
@@ -3,7 +3,7 @@
 # Copyright (C) 2000,2001,2002,2003,2004,2005,2006 Ken'ichi Fukamachi
 #          All rights reserved.
 #
-# $FML: Distribute.pm,v 1.167 2005/12/19 03:06:02 fukachan Exp $
+# $FML: Distribute.pm,v 1.168 2006/01/09 14:00:54 fukachan Exp $
 #
 
 package FML::Process::Distribute;
@@ -138,6 +138,18 @@ sub verify_request
         # NOT REACH HERE
     }
 
+    # ADDRESS FAULT HANDLING: used in the case of CREATE-ON-POST.
+    unless ($curproc->is_refused()) {
+	if ($curproc->is_address_fault()) {
+	    eval q{
+		use FML::Fault::Address;
+		my $fault = new FML::Fault::Address $curproc;
+		$fault->try_subscribe();
+	    };
+	    $curproc->logerror($@) if $@;
+	}
+    }
+
     $eval  = $config->get_hook( 'distribute_verify_request_end_hook' );
     $eval .= $config->get_hook( 'article_post_verify_request_end_hook' );
     if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }