#! /usr/bin/perl
# 
#	$Id$
# Copyright (C) 2002-2003 Jan Kratochvil <project-PerlMail@jankratochvil.net>
# 
# 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;