From cf13558ac1b01fd521a7bb727cd8ab3acecb1211 Mon Sep 17 00:00:00 2001 From: short <> Date: Sat, 18 Oct 2003 18:47:03 +0000 Subject: [PATCH 1/1] Common code moved to PerlMail::Lib. --- PerlMail/Lib.pm | 119 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ perlmail-accept | 84 +------------------------------------- perlmail-sendmail | 85 +------------------------------------- 3 files changed, 121 insertions(+), 167 deletions(-) create mode 100644 PerlMail/Lib.pm diff --git a/PerlMail/Lib.pm b/PerlMail/Lib.pm new file mode 100644 index 0000000..ccd7671 --- /dev/null +++ b/PerlMail/Lib.pm @@ -0,0 +1,119 @@ +#! /usr/bin/perl +# +# $Id$ +# Copyright (C) 2002-2003 Jan Kratochvil +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +package PerlMail::Lib; +use vars qw($VERSION); +$VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; +use strict; +use warnings; + +require Exporter; +use vars qw(@ISA @EXPORT); +@ISA=qw(Exporter); +@EXPORT=qw( + &parseone + &muttrc &muttrc_get); + +use PerlMail::Config; + +require Mail::Address; + + +# return: Mail::Address instance or undef() +sub parseone +{ +my($line)=@_; + + return undef() if !defined $line; + my @r=Mail::Address->parse($line); + warn "Got ".scalar(@r)." addresses while wanting just one; when parsing: $line" if 1!=@r; + return $r[0]; +} + +our %muttrc_pending=(); # not exported, just for local() +sub muttrc +{ +my($muttrc)=@_; + + $muttrc||="$HOME/.muttrc"; + $muttrc=~s/^\~/$HOME/; + do { warn "Looping muttrc, ignoring: $muttrc"; return (); } if $muttrc_pending{$muttrc}; + local $muttrc_pending{$muttrc}=1; + local *MUTTRC; + open MUTTRC,$muttrc or do { warn "open \"$muttrc\": $!"; return (); }; + local $/="\n"; + local $_; + my @r=(); + # far emulation mutt/init.c/mutt_parse_rc_line() + while () { + s/^[\s;]*//s; + s/[#;].*$//s; + s/\s*$//s; + next if !/^(\S+)\s*/s; + if ($1 eq "source") { + $_=$'; + do { warn "Wrong 'source' parameters at $muttrc:$.: $_"; next; } if !/^\S+$/; + push @r,muttrc($_); + next; + } + push @r,$_; + } + close MUTTRC or warn "close \"$muttrc\": $!"; + return wantarray() ? @r : join("",map("$_\n",@r)); +} + +my %mutteval_charmap=( # WARNING: Don't use "" or "0" here, see below for "|| warn"! + '\\'=>"\\", + 'r'=>"\r", + 'n'=>"\n", + 't'=>"\t", + 'f'=>"\f", + 'e'=>"\e", + ); +# mutt/init.c/mutt_extract_token() +sub mutteval +{ + local $_=$_[0]; + return $_ if !s/^"//; + do { warn "Missing trailing quote in: $_"; return $_; } if !s/"$//; + s/\\(.)/$mutteval_charmap{$1} || warn "Undefined '\\$1' sequence in: $_";/ges; + return $_; +} + +sub muttrc_get +{ +my(@headers)=@_; + + my @r=map({ (ref $_ ? $_ : qr/^\s*set\s+\Q$_\E\s*=\s*(.*?)\s*$/si); } @headers); + my %r=map(($_=>undef()),@r); + for (muttrc()) { + for my $ritem (@r) { + /$ritem/si or next; + $r{$ritem}=mutteval $1; + } + } + for my $var (grep { !defined($r{$_}) } @r) { + warn "Variable '$var' not found in muttrc"; + return undef(); + } + return wantarray() ? %r : $r{$r[0]}; +} + +1; diff --git a/perlmail-accept b/perlmail-accept index 30e7833..ae9da06 100755 --- a/perlmail-accept +++ b/perlmail-accept @@ -31,6 +31,7 @@ use File::Basename; BEGIN { use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0); use PerlMail::Config; + use PerlMail::Lib; } use Mail::Audit qw(MAPS); @@ -535,75 +536,6 @@ my($domain,$full,$timeout)=@_; return Mail::Audit::rblcheck($self_faked,$timeout); } -our %muttrc_pending=(); -sub muttrc -{ -my($muttrc)=@_; - - $muttrc||="$HOME/.muttrc"; - $muttrc=~s/^\~/$HOME/; - do { warn "Looping muttrc, ignoring: $muttrc"; return (); } if $muttrc_pending{$muttrc}; - local $muttrc_pending{$muttrc}=1; - local *MUTTRC; - open MUTTRC,$muttrc or do { warn "open \"$muttrc\": $!"; return (); }; - local $/="\n"; - local $_; - my @r=(); - # far emulation mutt/init.c/mutt_parse_rc_line() - while () { - s/^[\s;]*//s; - s/[#;].*$//s; - s/\s*$//s; - next if !/^(\S+)\s*/s; - if ($1 eq "source") { - $_=$'; - do { warn "Wrong 'source' parameters at $muttrc:$.: $_"; next; } if !/^\S+$/; - push @r,muttrc($_); - next; - } - push @r,$_; - } - close MUTTRC or warn "close \"$muttrc\": $!"; - return wantarray() ? @r : join("",map("$_\n",@r)); -} - -my %mutteval_charmap=( # WARNING: Don't use "" or "0" here, see below for "|| warn"! - '\\'=>"\\", - 'r'=>"\r", - 'n'=>"\n", - 't'=>"\t", - 'f'=>"\f", - 'e'=>"\e", - ); -# mutt/init.c/mutt_extract_token() -sub mutteval -{ - local $_=$_[0]; - return $_ if !s/^"//; - do { warn "Missing trailing quote in: $_"; return $_; } if !s/"$//; - s/\\(.)/$mutteval_charmap{$1} || warn "Undefined '\\$1' sequence in: $_";/ges; - return $_; -} - -sub muttrc_get -{ -my(@headers)=@_; - - my @r=map({ (ref $_ ? $_ : qr/^\s*set\s+\Q$_\E\s*=\s*(.*?)\s*$/si); } @headers); - my %r=map(($_=>undef()),@r); - for (muttrc()) { - for my $ritem (@r) { - /$ritem/si or next; - $r{$ritem}=mutteval $1; - } - } - for my $var (grep { !defined($r{$_}) } @r) { - warn "Variable '$var' not found in muttrc"; - return undef(); - } - return wantarray() ? %r : $r{$r[0]}; -} - sub muttrc_aliases { my %r=(); @@ -618,20 +550,6 @@ sub muttrc_aliases return %r; } -# FIXME: Unify -# BEGIN perlmail-sendmail -# return: Mail::Address instance or undef() -sub parseone -{ -my($line)=@_; - - return undef() if !defined $line; - my @r=Mail::Address->parse($line); - warn "Got ".scalar(@r)." addresses while wanting just one; when parsing: $line" if 1!=@r; - return $r[0]; -} -# END perlmail-sendmail - # FIXME: host may get multiple recipients and thus not showing "for <...>" # FIXME: muttrc_get("from") is too strict sub store_muttrc_alternates diff --git a/perlmail-sendmail b/perlmail-sendmail index f819bcc..6a4e31e 100755 --- a/perlmail-sendmail +++ b/perlmail-sendmail @@ -11,6 +11,7 @@ use File::Basename; BEGIN { use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0); use PerlMail::Config; + use PerlMail::Lib; } require Getopt::Long; @@ -19,79 +20,6 @@ require MIME::Head; # inherits Mail::Header require Mail::Address; -# FIXME: modularized unification with 'perlmail-accept' -# BEGIN perlmail-accept -our %muttrc_pending=(); -sub muttrc -{ -my($muttrc)=@_; - - $muttrc||="$HOME/.muttrc"; - $muttrc=~s/^\~/$HOME/; - do { warn "Looping muttrc, ignoring: $muttrc"; return (); } if $muttrc_pending{$muttrc}; - local $muttrc_pending{$muttrc}=1; - local *MUTTRC; - open MUTTRC,$muttrc or do { warn "open \"$muttrc\": $!"; return (); }; - local $/="\n"; - local $_; - my @r=(); - # far emulation mutt/init.c/mutt_parse_rc_line() - while () { - s/^[\s;]*//s; - s/[#;].*$//s; - s/\s*$//s; - next if !/^(\S+)\s*/s; - if ($1 eq "source") { - $_=$'; - do { warn "Wrong 'source' parameters at $muttrc:$.: $_"; next; } if !/^\S+$/; - push @r,muttrc($_); - next; - } - push @r,$_; - } - close MUTTRC or warn "close \"$muttrc\": $!"; - return wantarray() ? @r : join("",map("$_\n",@r)); -} - -my %mutteval_charmap=( # WARNING: Don't use "" or "0" here, see below for "|| warn"! - '\\'=>"\\", - 'r'=>"\r", - 'n'=>"\n", - 't'=>"\t", - 'f'=>"\f", - 'e'=>"\e", - ); -# mutt/init.c/mutt_extract_token() -sub mutteval -{ - local $_=$_[0]; - return $_ if !s/^"//; - do { warn "Missing trailing quote in: $_"; return $_; } if !s/"$//; - s/\\(.)/$mutteval_charmap{$1} || warn "Undefined '\\$1' sequence in: $_";/ges; - return $_; -} - -sub muttrc_get -{ -my(@headers)=@_; - - my @r=map({ (ref $_ ? $_ : qr/^\s*set\s+\Q$_\E\s*=\s*(.*?)\s*$/si); } @headers); - my %r=map(($_=>undef()),@r); - for (muttrc()) { - for my $ritem (@r) { - /$ritem/si or next; - $r{$ritem}=mutteval $1; - } - } - for my $var (grep { !defined($r{$_}) } @r) { - warn "Variable '$var' not found in muttrc"; - return undef(); - } - return wantarray() ? %r : $r{$r[0]}; -} -# END perlmail-accept - - sub sendmail_show { return "\"$sendmail_orig\" ".join(",",map("\"$_\"",@ARGV)); } sub sendmail_orig_exec @@ -161,17 +89,6 @@ if ($opt_t) { } } -# return: Mail::Address instance or undef() -sub parseone -{ -my($line)=@_; - - return undef() if !defined $line; - my @r=Mail::Address->parse($line); - warn "Got ".scalar(@r)." addresses while wanting just one; when parsing: $line" if 1!=@r; - return $r[0]; -} - sub matches { return -- 1.8.3.1