X-Git-Url: http://git.jankratochvil.net/?p=PerlMail.git;a=blobdiff_plain;f=PerlMail%2FLib.pm;fp=PerlMail%2FLib.pm;h=0000000000000000000000000000000000000000;hp=200e4dbd172cbd2f5c3e497c49c77c145f9f165d;hb=c6aeb2044adc46f259f2e78eef7121e627535b52;hpb=adc851054ec9cb7f8338eaa8152e14a846c9a9f1 diff --git a/PerlMail/Lib.pm b/PerlMail/Lib.pm deleted file mode 100644 index 200e4db..0000000 --- a/PerlMail/Lib.pm +++ /dev/null @@ -1,119 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Copyright (C) 2002-2003 Jan Kratochvil -# -# 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 () { - 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;