X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=perlmail-sendmail;h=6a4e31e2d1fd4d5cbeb2d2a5a7742b7c0a6f9c05;hp=366f830db8c788be3d7e9d4f90cf33500e125e57;hb=cf13558ac1b01fd521a7bb727cd8ab3acecb1211;hpb=c23c7da69d6fabcd20481ca42cfe551626bfbcc5 diff --git a/perlmail-sendmail b/perlmail-sendmail index 366f830..6a4e31e 100755 --- a/perlmail-sendmail +++ b/perlmail-sendmail @@ -7,87 +7,17 @@ $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; use strict; use warnings; -use PerlMail::Config; +use File::Basename; +BEGIN { + use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0); + use PerlMail::Config; + use PerlMail::Lib; + } require Getopt::Long; use POSIX qw(WIFEXITED WEXITSTATUS WIFSIGNALED WTERMSIG WIFSTOPPED WSTOPSIG); require MIME::Head; # inherits Mail::Header require Mail::Address; -require File::Basename; -require Mail::Alias; - - -# 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)); } @@ -159,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