#-*- perl -*- # # Copyright (C) 2006,2007,2008 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: CreateOnPost.pm,v 1.4 2007/01/16 11:06:16 fukachan Exp $ # package FML::CreateOnPost; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); use Carp; =head1 NAME FML::CreateOnPost - CREATE-ON-POST =head1 SYNOPSIS use FML::CreateOnPost; my $cop = new FML::CreateOnPost $curproc; $cop->distribute_ml($ml); =head1 DESCRIPTION This class provides CREATE-ON-POST. =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 create_ml($ml_addr) create a ML. Actually it runs "makefml newml" process to create a new ML. The ML's ml_home_dir contais log, articles and so on to log them. But include files in the ml_home_dir are not used. Only FML::Process::CreateOnPost process emulates all ML's but saves articles and log messages in each ml_home_dir. =cut # Descriptions: create a ML. # Arguments: OBJ($self) STR($ml_addr) # Side Effects: none # Return Value: none sub create_ml { my ($self, $ml_addr) = @_; my $curproc = $self->{ _curproc }; my $myname = "fml"; my $hints = {}; # prepare parameters; my ($ml_name, $ml_domain) = split(/\@/, $ml_addr); $hints->{ ARGV } = [ $ml_addr, "newml" ]; $hints->{ argv } = [ $ml_addr, "newml", '-O', 'update-alias=no' ]; $hints->{ options } = { 'O' => { 'update-alias' => 'no' } }; eval q{ $curproc->log("emulate $myname to create $ml_name\@$ml_domain"); use FML::Process::Switch; &FML::Process::Switch::NewProcess($curproc, $myname, $ml_name, $ml_domain, $hints); }; $curproc->logerror($@) if $@; } =head2 distribute_ml($ml_addr) run distribute process. =cut # Descriptions: run distribute process. # Arguments: OBJ($self) STR($ml_addr) # Side Effects: none # Return Value: none sub distribute_ml { my ($self, $ml_addr) = @_; my $curproc = $self->{ _curproc }; my $myname = "distribute"; my $maintainer = 'fukachan@home.fml.org'; # prepare parameters; my ($ml_name, $ml_domain) = split(/\@/, $ml_addr); my $hints = {}; $hints->{ ARGV } = [ $ml_addr ]; $hints->{ argv } = [ $ml_addr ]; $hints->{ config_overload } = { 'article_post_restrictions' => 'permit_anyone', 'maintainer' => $maintainer, }; # open STDIO my $queue = $curproc->incoming_message_get_current_queue(); if (defined $queue) { my $class = "incoming"; close(STDIN); unless ($queue->open($class, { in_channel => *STDIN{IO} })) { my $qid = $queue->id(); $curproc->logerror("cannot open qid=$qid"); return; } } else { $curproc->logerror("queue not found"); return; } eval q{ $curproc->log("emulate $myname for $ml_name\@$ml_domain"); use FML::Process::Switch; &FML::Process::Switch::NewProcess($curproc, $myname, $ml_name, $ml_domain, $hints); }; $curproc->logerror($@) if $@; } =head1 CODING STYLE See C on fml coding style guide. =head1 AUTHOR Ken'ichi Fukamachi =head1 COPYRIGHT Copyright (C) 2006,2007,2008 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::CreateOnPost appeared in fml8 mailing list driver package. See C for more details. =cut 1;