import MailTools-2.19MailTools-2-19

1 files changed, 82 insertions, 194 deletions

diff --git a/cpan/lib/Mail/Util.pm b/cpan/lib/Mail/Util.pm
index a1d5be98..af7894a7 100644
--- a/cpan/lib/Mail/Util.pm
+++ b/cpan/lib/Mail/Util.pm
@@ -1,263 +1,151 @@
-# Mail::Util.pm
-#
-# Copyright (c) 1995-2001 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
+# Copyrights 1995-2017 by [Mark Overmeer <perl@overmeer.net>].
+#  For other contributors see ChangeLog.
+# See the manual pages for details on the licensing terms.
+# Pod stripped from pm file by OODoc 2.02.
 package Mail::Util;
+use vars '$VERSION';
+$VERSION = '2.19';
 
-use strict;
-use vars qw($VERSION @ISA @EXPORT_OK);
-use AutoLoader ();
-use Exporter ();
-
-BEGIN {
-    require 5.000;
-
-    $VERSION = "1.52";
-
-    *AUTOLOAD = \&AutoLoader::AUTOLOAD;
-    @ISA = qw(Exporter);
-
-    @EXPORT_OK = qw(read_mbox maildomain mailaddress);
-}
-
-1;
-
-sub Version { $VERSION }
-
-=head1 NAME
-
-Mail::Util - mail utility functions
-
-=head1 SYNOPSIS
-
-use Mail::Util qw( ... );
-
-=head1 DESCRIPTION
-
-This package provides several mail related utility functions. Any function
-required must by explicitly listed on the use line to be exported into
-the calling package.
-
-=head2 read_mbox( $file )
-
-Read C<$file>, a binmail mailbox file, and return a list of  references.
-Each reference is a reference to an array containg one message.
-
-=head2 maildomain()
-
-Attempt to determine the current uers mail domain string via the following
-methods
-
-=over 4
-
-=item *  Look for the MAILDOMAIN enviroment variable, which can be set from outside the program.
-
-=item *  Look for a sendmail.cf file and extract DH parameter
-
-=item *  Look for a smail config file and usr the first host defined in hostname(s)
-
-=item *  Try an SMTP connect (if Net::SMTP exists) first to mailhost then localhost
-
-=item *  Use value from Net::Domain::domainname (if Net::Domain exists)
+use base 'Exporter';
 
-=back
-
-=head2 mailaddress()
-
-Return a guess at the current users mail address. The user can force
-the return value by setting the MAILADDRESS environment variable.
-
-=head1 AUTHOR
+use strict;
+use Carp;
 
-Graham Barr.
+our @EXPORT_OK = qw(read_mbox maildomain mailaddress);
 
-Maintained by Mark Overmeer <mailtools@overmeer.net>
+sub Version { our $VERSION }
 
-=head1 COPYRIGHT
+my ($domain, $mailaddress);
+my @sendmailcf = qw(/etc /etc/sendmail /etc/ucblib
+    /etc/mail /usr/lib /var/adm/sendmail);
 
-Copyright (c) 1995-2001 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
 
-=cut
+sub read_mbox($)
+{   my $file  = shift;
 
-__END__
+    local *FH;
+    open FH,'<', $file
+	or croak "cannot open '$file': $!\n";
 
-sub read_mbox {
-    my $file  = shift;
-    my @mail  = ();
+    local $_;
+    my @mbox;
     my $mail  = [];
     my $blank = 1;
-    local *FH;
-    local $_;
 
-    open(FH,"< $file") or
-	do {
-	    require Carp;
-	    Carp::croak("cannot open '$file': $!\n");
-	};
-
-    while(<FH>) {
-	if($blank && /\AFrom .*\d{4}/) {
-	    push(@mail, $mail) if scalar(@{$mail});
-	    $mail = [ $_ ];
-	    $blank = 0;
-	}
-	else {
-	    $blank = m#\A\Z#o ? 1 : 0;
-	    push(@{$mail}, $_);
-	}
+    while(<FH>)
+    {   if($blank && /^From .*\d{4}/)
+        {   push @mbox, $mail if @$mail;
+            $mail  = [ $_ ];
+            $blank = 0;
+        }
+        else
+        {   $blank = m/^$/ ? 1 : 0;
+            push @$mail, $_;
+        }
     }
 
-    push(@mail, $mail) if scalar(@{$mail});
+    push @mbox, $mail if @$mail;
+    close FH;
 
-    close(FH);
-
-    return wantarray ? @mail : \@mail;
+    wantarray ? @mbox : \@mbox;
 }
 
 
-sub maildomain {
-
-    ##
-    ## return imediately if already found
-    ##
-
-    return $domain
-	if(defined $domain);
+sub maildomain()
+{   return $domain
+	if defined $domain;
 
-    ##
-    ## Get mail domain from environment
-    ##
+    $domain = $ENV{MAILDOMAIN}
+        and return $domain;
 
-    $domain = $ENV{MAILDOMAIN};
+    # Try sendmail configuration file
 
-    return $domain
-       if(defined $domain);
-
-    ##
-    ## Try sendmail config file if exists
-    ##
+    my $config = (grep -r, map {"$_/sendmail.cf"} @sendmailcf)[0];
 
     local *CF;
     local $_;
-    my @sendmailcf = qw(/etc
-			/etc/sendmail
-			/etc/ucblib
-			/etc/mail
-			/usr/lib
-			/var/adm/sendmail);
-
-    my $config = (grep(-r, map("$_/sendmail.cf", @sendmailcf)))[0];
-
-    if(defined $config && open(CF,$config)) {
-	my %var;
-	while(<CF>) {
-	    if(my ($v, $arg) = /^D([a-zA-Z])([\w.\$\-]+)/) {
-		$arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$'.$1/eg;
+    if(defined $config && open CF, '<', $config)
+    {   my %var;
+	while(<CF>)
+        {   if(my ($v, $arg) = /^D([a-zA-Z])([\w.\$\-]+)/)
+            {   $arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$'.$1/eg;
 		$var{$v} = $arg;
 	    }
 	}
-	close(CF);
+	close CF;
 	$domain = $var{j} if defined $var{j};
 	$domain = $var{M} if defined $var{M};
 
         $domain = $1
-            if($domain && $domain =~ m/([A-Za-z0-9](?:[\.\-A-Za-z0-9]+))/ );
+            if $domain && $domain =~ m/([A-Za-z0-9](?:[\.\-A-Za-z0-9]+))/;
 
 	return $domain
-	    if(defined $domain);
+	    if defined $domain && $domain !~ /\$/;
     }
 
-    ##
-    ## Try smail config file if exists
-    ##
+    # Try smail config file if exists
 
-    if(open(CF,"/usr/lib/smail/config")) {
-	while(<CF>) {
-	    if(/\A\s*hostnames?\s*=\s*(\S+)/) {
-		$domain = (split(/:/,$1))[0];
+    if(open CF, '<', "/usr/lib/smail/config")
+    {   while(<CF>)
+        {   if( /\A\s*hostnames?\s*=\s*(\S+)/ )
+            {   $domain = (split /\:/,$1)[0];
 		last;
 	    }
 	}
-	close(CF);
+	close CF;
 
 	return $domain
-	    if(defined $domain);
+	    if defined $domain;
     }
 
-    ##
-    ## Try a SMTP connection to 'mailhost'
-    ##
-
-    if(eval { require Net::SMTP }) {
-	my $host;
+    # Try a SMTP connection to 'mailhost'
 
-	foreach $host (qw(mailhost localhost)) {
-	    my $smtp = eval { Net::SMTP->new($host) };
-
-	    if(defined $smtp) {
-		$domain = $smtp->domain;
+    if(eval {require Net::SMTP})
+    {   foreach my $host (qw(mailhost localhost))
+        {   # hosts are local, so short timeout
+            my $smtp = eval { Net::SMTP->new($host, Timeout => 5) };
+	    if(defined $smtp)
+            {   $domain = $smtp->domain;
 		$smtp->quit;
 		last;
 	    }
 	}
     }
 
-    ##
-    ## Use internet(DNS) domain name, if it can be found
-    ##
-
-    unless(defined $domain) {
-	if(eval { require Net::Domain } ) {
-	    $domain = Net::Domain::domainname();
-	}
-    }
-
-    $domain = "localhost"
-	unless(defined $domain);
+    # Use internet(DNS) domain name, if it can be found
+    $domain = Net::Domain::domainname()
+        if !defined $domain && eval {require Net::Domain};
 
-    return $domain;
+    $domain ||= "localhost";
 }
 
 
-sub mailaddress {
-
-    ##
-    ## Return imediately if already found
-    ##
+sub mailaddress(;$)
+{   $mailaddress = shift if @_;
 
     return $mailaddress
-	if(defined $mailaddress);
-
-    ##
-    ## Get user name from environment
-    ##
+        if defined $mailaddress;
 
+    # Get user name from environment
     $mailaddress = $ENV{MAILADDRESS};
 
-    unless ($mailaddress || $^O ne 'MacOS') {
-	require Mac::InternetConfig;
-	Mac::InternetConfig->import();
+    unless($mailaddress || $^O ne 'MacOS')
+    {   require Mac::InternetConfig;
 
+        no strict;
+	Mac::InternetConfig->import;
 	$mailaddress = $InternetConfig{kICEmail()};
     }
 
-    $mailaddress ||= $ENV{USER}    ||
-                     $ENV{LOGNAME} ||
-                     eval {getpwuid($>)} ||
-                     "postmaster";
-
-    ##
-    ## Add domain if it does not exist
-    ##
+    $mailaddress ||= $ENV{USER} || $ENV{LOGNAME} || eval {getpwuid $>}
+                 ||  "postmaster";
 
-    $mailaddress .= '@' . maildomain()
-	unless($mailaddress =~ /\@/);
+    # Add domain if it does not exist
+    $mailaddress .= '@' . maildomain
+	if $mailaddress !~ /\@/;
 
     $mailaddress =~ s/(^.*<|>.*$)//g;
-
     $mailaddress;
 }
+
+1;