1#!/usr/bin/perl 2 3=head1 NAME 4 5MailTool - Handy-dandy MIME mailing class 6 7=head1 SYNOPSIS 8 9 use lib some_directory, depending on where you put the .pm files 10 use MailTool; 11 $msg = MailTool->build ( 12 To => 'Justin.L.Heuser@usa.dupont.com', 13 From => 'Harcourt.F.Mudd@usa.dupont.com', 14 Subject => 'The check is in the mail', 15 Path => standard_reply.txt, 16 ); 17 $msg->send (); 18 19=head1 DESCRIPTION 20 21The MailTool class is actually a subclass of MIME::Lite. It provides 22no new methods, but does 'enhance' (I hope!) some of the existing 23ones. The natures of the enhancements (if enhancements they be) are: 24 25=head2 The default send method is now smtp. 26 27This may not be an enhancement if you're running Unix. The default 28of MIME::Lite is (or was when I wrote this) to spawn SENDMAIL. 29 30=head2 The SMTP host can be specified any number of ways. 31 32If you are using the send method, and are in fact using SMTP (i.e. you 33have not used the class send method to change the default way to send 34mail), the SMTP host comes from the first thing in the following list 35that is actually defined: 36 37 The second argument of the class send method; 38 The contents of environment variable SMTPHOSTS; 39 The contents of smtp_hosts in Net::Config; 40 The name of the host that is executing the script. 41 42If you are calling send_by_smtp explicitly, the information specified 43to the class send method is ignored (because this is consistent with 44the behaviour of MIME::Lite), and the SMTP host is determined by the 45first thing in the following list that is actually defined: 46 47 The first argument passed to send_by_smtp; 48 The contents of environment variable SMTPHOSTS; 49 The contents of smtp_hosts in Net::Config; 50 The name of the host that is executing the script. 51 52Multiple SMTP hosts can be specified, either by passing a reference, 53or by separating the names by colons (the normal way of specifying 54SMTPHOSTS, which is used by Mail::Internet). If you specify multiple 55hosts, they are tried in the order specified until the send succeeds 56or the list of hosts is exhausted. In the latter case, an exception 57is raised which describes the last error encountered. 58 59Specifying multiple hosts while using a send method other than smtp 60is unsupported. 61 62=head2 Mailing lists are supported. 63 64Any address element that begins with an "@" sign is assumed to be 65a reference to a mailing list, with the rest of the address element 66being the name of the file. This file is opened and read, and any 67and all lines in the file are appended to the address list. This 68functionality works for the "To", "Cc", and "Bcc" tags only. 69 70=head2 You get an error message back if send_by_smtp fails. 71 72This message is the first error encountered in the attempt to send 73using the last host on the list. 74 75=head1 REQUIREMENTS 76 77The following Perl modules are required: 78 Carp (standard module) 79 FileHandle (standard module) 80 Mail::Address (from library MailTools) 81 MIME::Lite (from library MIME-lite) 82 Net::Config (from library libnet) 83 Net::SMTP (from library libnet) 84 Sys::Hostname (standard module) 85 86Note that these in turn can have requirements of their own. What these 87requirements are is best found by reading the documentation for the 88libraries themselves, but you can pretty much count on needing at least 89 MIME::Base64 (from MIME-base64). On the other hand, the only known new 90nonstandard requirement (over and above those of MIME::Lite) are 91Mail::Address (because I was lazier than Eryq, and didn't provide a 92hack to cover its absence). Truth to tell, Net::Config is also new, but 93if you have Net::SMTP you should have Net::Config as well. 94 95=over 4 96 97=cut 98 99package MailTool; 100 101use strict; 102use vars qw{@ISA $Debug}; 103use Carp; 104use FileHandle; 105use Mail::Address; 106use MIME::Lite; 107use Net::Config; 108use Net::SMTP; 109use Sys::Hostname; 110 111@ISA = qw{MIME::Lite}; 112 113my %handler = ( 114 bcc => \&_map_addr, 115 cc => \&_map_addr, 116 to => \&_map_addr, 117 ); 118 119# Make the default method SMTP. 120 121MailTool->send ('smtp'); 122 123 124=item $msg->add (tag, value) 125 126This override of MIME::Light::add is the hook where mailing list 127functionality is provided. 128 129It looks up the tag being added in its internal hash table. If a hit 130is found, both tag and value are passed to the subroutine specified 131in the hash table, and the value returned is passed to SUPER::add. If 132no hit is found, the pristine value is passed to SUPER::add. 133 134In the case of the 'to', 'cc', and 'bcc' tags, the effect is to 135try to expand all addresses beginning with "@" as mailing lists. 136No other tags are currently munged. 137 138=cut 139 140sub add { 141my $self = shift; 142my $tag = lc(shift); 143my $value = shift; 144$value = &{$handler{$tag}} ($self, $tag, $value) 145 if exists $handler{$tag}; 146$self->SUPER::add ($tag, $value); 147} 148 149 150=item $msg->send_by_smtp ([smtp_host]) 151 152This override of MIME::Lite's send_by_smtp method does pretty much the 153same thing (it should! the code was stolen shamelessly! Thanks, Eryq!) 154It has, however, the following differences: 155 156 * More error detail (sometimes) 157 * Sensitivity to a number of sources of SMTP server information: 158 - Explicitly in the argument(s) to the method; 159 - From environment variable SMTPHOSTS (colon-separated list); 160 - From Net::Config; 161 - If all else fails, use the local machine. 162 163=cut 164 165sub send_by_smtp { 166my ($self, @args) = @_; 167 168# Get the SMTP hosts we're to use. We do multiple calls to 169# _get_hosts to prevent evaluating any more arguments than 170# necessary. Whether this makes any real difference, deponent 171# sayeth not. 172my $host_list = _get_hosts (shift @args) || 173 _get_hosts ($ENV{SMTPHOSTS}) || 174 _get_hosts ($NetConfig{smtp_hosts}) || 175 _get_hosts (hostname ()) or 176 croak "send_by_smtp: cannot determine smtp host\n"; 177croak "send_by_smtp: host list is empty; this should never happen.\n" 178 unless @$host_list; 179 180# We need the "From:" and "To:" headers to pass to the 181# SMTP mailer: 182my $from = $self->get('From'); 183my $to = $self->get('To'); 184 185# Sanity check: 186defined($to) or croak "send_by_smtp: missing 'To:' address\n"; 187 188# Get the destinations as a simple array of addresses. 189my @to_all = map {$_->format} Mail::Address->parse ($to); 190 191# Duplicate the superclass' cc functionality. 192if ($MIME::Lite::AUTO_CC) { 193 foreach my $field (qw(Cc Bcc)) { 194 my $value = $self->get($field) or next; 195 push @to_all, map {$_->format} Mail::Address->parse ($value); 196 } 197 } 198 199# Try each possible host. 200 201my ($smtp, $err); 202foreach my $svr (@$host_list) { 203 print STDERR "Debug send_by_smtp - Trying SMTP host $svr\n" if $Debug; 204 $smtp = Net::SMTP->new ($svr, @args) or do { 205 $err = "Failed to connect to mail server $svr: $!\n"; 206 next; }; 207 $smtp->mail ($from) or do { 208 $err = "SMTP MAIL command to $svr failed: $!\n" . 209 $smtp->message (); 210 next; }; 211 $smtp->to (@to_all) or do { 212 $err = "SMTP RCPT command to $svr failed: $!\n" . 213 $smtp->message (); 214 next; }; 215 $smtp->data ($self->as_string ()) or do { 216 $err = "SMTP DATA command to $svr failed: $!\n" . 217 $smtp->message (); 218 next; }; 219 $smtp->quit (); 220 $err = ''; 221 print STDERR "Debug send_by_smtp - Host $svr succeeded.\n" if $Debug; 222 last; 223 } 224 continue { 225 print STDERR "Debug send_by_smtp - Host $svr failed: $err\n" if $Debug; 226 $smtp->quit () if $smtp; 227 } 228croak $err if $err; 2291; 230} 231 232 233######################################################################## 234# 235# _get_hosts 236# 237# This subroutine figures out if any of its arguments represents 238# a host specification of any sort. If so, it returns a reference 239# to the list of hosts specified by the first such argument. If 240# not, it returns undef. 241 242sub _get_hosts { 243print STDERR "Debug _get_hosts (", join (', ', 244 map {ref $_ ? '[' . (join (', ', map {"'$_'"} @$_)) . ']' : "'$_'"} @_), 245 ")\n" 246 if $Debug; 247foreach (@_) { 248 next unless $_; 249 return [split ':', $_] unless ref $_; 250 return $_ if @$_; 251 } 252return undef; 253} 254 255######################################################################## 256# 257# _map_addr 258# 259# This subroutine expects the value passed in to look like a list 260# of mailing addresses. If any of the addresses looks like 261# "@xxxxx", everything except the initial "@" is assumed to be 262# the name of a file; this file is read and its records inserted 263# into the list of addressees. No attempt is made to eliminate 264# duplicates. 265 266sub _map_addr { 267my $self = shift; 268my $tag = lc shift; 269my $value = shift; 270my $ad_in = ref $value ? $value : [$value]; 271my @ad_out; 272 273foreach (@$ad_in) { 274 foreach (map {$_->format} Mail::Address->parse ($_)) { 275 s/^\s+//; 276 s/\s+$//; 277 next unless $_; 278 if (m/^\@(.+)/) { 279 my $fn = $1; 280 my $fh = FileHandle->new ("<$fn") or 281 croak "Error - Cannot open mailing list $fn: $!"; 282 while (my $buf = $fh->getline ()) { 283 chomp $buf; 284 $buf =~ s/\#.*//; 285 next unless $buf; 286 push @$ad_in, map {$_->format} Mail::Address->parse ($buf) 287 } 288 $fh->close (); 289 } 290 else { 291 push @ad_out, $_; 292 } 293 } 294 } 295return @ad_out if wantarray; 296return \@ad_out if ref $value; 297return join ',', @ad_out; 298} 299 300 301=back 302 303=head1 COPYRIGHT 304 305Copyright 2001 by E. I. DuPont de Nemours and Company. All rights 306reserved. 307 308This library is free software; you can redistribute it and/or 309modify it under the same terms as Perl itself. 310 311This software comes with no warranty whatsoever, either expressed 312or implied. 313 314=head1 AUTHOR 315 316Tom Wyant (F<Thomas.R.Wyant-III@usa.dupont.com>), E. I. DuPont de 317Nemours and Company, Inc. (F<http://www.dupont.com>, and no, you 318won't find anything about this module there). 319 320=cut 321 3221; 323