--- /dev/null
+#! /usr/bin/perl
+#
+# $Id$
+# Copyright (C) 2002-2003 Jan Kratochvil <short@ucw.cz>
+#
+# 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 (<MUTTRC>) {
+ 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;
BEGIN {
use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0);
use PerlMail::Config;
+ use PerlMail::Lib;
}
use Mail::Audit qw(MAPS);
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 (<MUTTRC>) {
- 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=();
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
BEGIN {
use lib $ENV{"PERLMAIL_BASEDIR"} || File::Basename::dirname($0);
use PerlMail::Config;
+ use PerlMail::Lib;
}
require Getopt::Long;
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 (<MUTTRC>) {
- 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
}
}
-# 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
git://git.jankratochvil.net / PerlMail.git / commitdiff