#-*- 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: Address.pm,v 1.2 2006/03/05 08:08:37 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 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_context = $curproc->command_context_init("$method $addr");
$command_context->set_mode("Admin");
$command_context->set_cooked_command($method);
$command_context->set_clean_command("$method @options");
$command_context->set_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_context);
};
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 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 for more details.
=cut
1;