#-*- perl -*- # # Copyright (C) 2001 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: QMail.pm,v 1.7 2001/04/03 09:45:43 fukachan Exp $ # package FML::Process::QMail; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD); use Carp; use FML::Log qw(Log LogWarn LogError); sub new { my ($self) = @_; my ($type) = ref($self) || $self; my $me = {}; return bless $me, $type; } =head1 NAME FML::Process::QMail - emulate C address =head1 SYNOPSIS C. =head1 DESCRIPTION C. =head1 TODO XXX XXX MEMO on TODO XXX we should not use "# command" representation even though internally. check $ext more restrictly. =head1 METHODS =cut sub DotQmailExt { my ($curproc) = @_; my $config = $curproc->{ config }; # get ? my $ext = $ENV{'EXT'}; unless ($ext) { Log("no extension address"); return; } &Log("dot-qmail-ext[0]: $ext"); my ($key) = (split(/\@/, $config->{ address_for_post }))[0]; my ($keyctl) = (split(/\@/, $config->{ address_for_command }))[0]; if ($ext =~ /^($key)$/i) { return ''; } elsif ($keyctl&& ($ext =~ /^($keyctl)$/i)) { return ''; } &Log("dot-qmail-ext: $ext"); $ext =~ s/^$key//i; $ext =~ s/\-\-/\@/i; # since @ cannot be used $ext =~ s/\-/ /g; $ext =~ s/\@/-/g; &Log("\$ext -> $ext"); # XXX: "# command" is internal represention return sprintf("# %s", $ext); } =head1 AUTHOR Ken'ichi Fukamachi =head1 COPYRIGHT Copyright (C) 2001 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::Process::QMail appeared in fml5 mailing list driver package. See C for more details. =cut 1;