+#! /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;