3 # $Id: Lib.pm,v 1.3 2010/07/16 06:27:11 lace Exp $
4 # Copyright (C) 2002-2003 Jan Kratochvil <project-PerlMail@jankratochvil.net>
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 package PerlMail::Lib;
22 use vars qw($VERSION);
23 $VERSION=do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; };
28 use vars qw(@ISA @EXPORT);
36 require Mail::Address;
39 # return: Mail::Address instance or undef()
44 return undef() if !defined $line;
45 my @r=Mail::Address->parse($line);
46 warn "Got ".scalar(@r)." addresses while wanting just one; when parsing: $line" if 1!=@r;
50 our %muttrc_pending=(); # not exported, just for local()
55 $muttrc||="$HOME/.muttrc";
56 $muttrc=~s/^\~/$HOME/;
57 do { warn "Looping muttrc, ignoring: $muttrc"; return (); } if $muttrc_pending{$muttrc};
58 local $muttrc_pending{$muttrc}=1;
60 open MUTTRC,$muttrc or do { warn "open \"$muttrc\": $!"; return (); };
64 # far emulation mutt/init.c/mutt_parse_rc_line()
69 next if !/^(\S+)\s*/s;
72 do { warn "Wrong 'source' parameters at $muttrc:$.: $_"; next; } if !/^\S+$/;
78 close MUTTRC or warn "close \"$muttrc\": $!";
79 return wantarray() ? @r : join("",map("$_\n",@r));
82 my %mutteval_charmap=( # WARNING: Don't use "" or "0" here, see below for "|| warn"!
90 # mutt/init.c/mutt_extract_token()
95 do { warn "Missing trailing quote in: $_"; return $_; } if !s/"$//;
96 s/\\(.)/$mutteval_charmap{$1} || warn "Undefined '\\$1' sequence in: $_";/ges;
104 my @r=map({ (ref $_ ? $_ : ($_ eq "alternates" ? qr/^\s*\Q$_\E\s+(.*?)\s*$/si : qr/^\s*set\s+\Q$_\E\s*=\s*(.*?)\s*$/si)); } @headers);
105 my %r=map(($_=>undef()),@r);
109 $r{$ritem}=mutteval $1;
112 for my $var (grep { !defined($r{$_}) } @r) {
113 warn "Variable '$var' not found in muttrc";
116 return wantarray() ? %r : $r{$r[0]};