#-*- perl -*- # # Copyright (C) 2002,2003,2004,2005,2006 MURASHITA Takuya # 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.23 2006/10/08 06:06:47 fukachan Exp $ # package FML::Command::User::on; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); use Carp; =head1 NAME FML::Command::User::on - enable real time delivery. =head1 SYNOPSIS See C for more details. =head1 DESCRIPTION "on" command enables real time delivery, so fml8 delivers articles to him/her again. After confirmation succeeds, on process proceeds. =head1 METHODS =head2 new() constructor. =head2 need_lock() need lock or not. =head2 lock_channel() return lock channel name. =head2 verify_syntax($curproc, $command_context) provide command specific syntax checker. =head2 process($curproc, $command_context) main command specific routine. =cut # Descriptions: constructor. # Arguments: OBJ($self) # Side Effects: none # Return Value: OBJ sub new { my ($self) = @_; my ($type) = ref($self) || $self; my $me = {}; return bless $me, $type; } # Descriptions: need lock or not. # Arguments: none # Side Effects: none # Return Value: NUM( 1 or 0) sub need_lock { 1;} # Descriptions: lock channel. # Arguments: none # Side Effects: none # Return Value: STR sub lock_channel { return 'command_serialize';} # Descriptions: change delivery mode from digest to real time # after confirmation. # Arguments: OBJ($self) OBJ($curproc) OBJ($command_context) # Side Effects: update database for confirmation. # prepare reply message. # Return Value: none sub process { my ($self, $curproc, $command_context) = @_; my $config = $curproc->config(); my $cred = $curproc->credential(); # XXX We should always add/rewrite only $primary_*_map maps via # XXX command mail, CUI and GUI. # XXX Rewriting of maps not $primary_*_map is # XXX 1) may be not writable. # XXX 2) ambigous and dangerous # XXX since the map is under controlled by other module. # XXX for example, $member_maps contains different classes. my $member_map = $config->{ primary_member_map }; my $recipient_map = $config->{ primary_recipient_map }; my $cache_dir = $config->{ db_dir }; my $keyword = $config->{ confirm_command_prefix }; my $command = $command_context->get_clean_command(); my $address = $cred->sender(); # fundamental check croak("\$member_map is not specified") unless $member_map; croak("\$recipient_map is not specified") unless $recipient_map; # if not member, on request is wrong. unless ($cred->is_member($address)) { $curproc->reply_message_nl('error.not_member'); $curproc->logerror("on request from not member"); croak("on request from not member"); return; } # if already recipient, on request is wrong. if ($cred->is_recipient($address)) { $curproc->reply_message_nl('error.already_recipient', 'already recipient', { _arg_address => $address }); croak("already recipient"); } # if not, try confirmation before on else { $curproc->log("on request, try confirmation"); use FML::Confirm; my $confirm = new FML::Confirm $curproc, { keyword => $keyword, cache_dir => $cache_dir, class => 'on', address => $address, buffer => $command, }; my $id = $confirm->assign_id; $curproc->reply_message_nl('command.confirm'); $curproc->reply_message("\n$id\n"); } } =head1 CODING STYLE See C on fml coding style guide. =head1 AUTHOR MURASHITA Takuya =head1 COPYRIGHT Copyright (C) 2002,2003,2004,2005,2006 MURASHITA Takuya 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::Command::User::on first appeared in fml8 mailing list driver package. See C for more details. =cut 1;