lib/Mail.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Mail.pm,v $
   4
   5 A simplified approach to sending email
   6
   7 =head1 VERSION
   8
   9 =over
  10
  11 =item Author
  12
  13 Andrew DeFaria <Andrew@ClearSCM.com>
  14
  15 =item Revision
  16
  17 $Revision: 1.34 $
  18
  19 =item Created
  20
  21 Thu Jan  5 15:15:29 PST 2006
  22
  23 =item Modified
  24
  25 $Date: 2012/09/25 01:34:10 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Conveniently send email.
  32
  33   my $msg = "<h1>The Daily News</h1><p>Today in the news...</p>";
  34
  35   mail (
  36     to          => "somebody\@somewhere.com",
  37     cc          => "sombody_else\@somewhere.com",
  38     subject     => "Today's News",
  39     mode        => "html",
  40     data        => $msg,
  41   );
  42
  43   open STATUS_REPORT, "status.html";
  44
  45   mail (
  46     to          => "boss\@mycompany.com",
  47     bcc         => "mysecret\@mailbox.com",
  48     subject     => "Weekly Status Report",
  49     data        => STATUS_REPORT,
  50     footing     => "Another day - Another dollar!"
  51   );
  52
  53   close STATUS_REPORT;
  54
  55 =head1 DESCRIPTION
  56
  57 Sending email from Perl scripts is another one of those things that is
  58 often reinvented over and over. Well... This is yet another
  59 reinvention I guess. The goal here is to allow for a simplifed
  60 approach to sending email while still allowing MIME or rich text email
  61 to be sent.
  62
  63 Additionally a multipart (plain text and HTML'ized) email will be send
  64 if mode is set to html. Finally, if attempting to send HTML mail, if
  65 we cannot find the appropriate dependent modules we'll fall back to
  66 plain text only.
  67
  68 =head1 ROUTINES
  69
  70 The following routines are exported:
  71
  72 =cut
  73
  74 package Mail;
  75
  76 use strict;
  77 use warnings;
  78
  79 use base 'Exporter';
  80
  81 use FindBin;
  82 use File::Basename;
  83 use Net::SMTP;
  84
  85 use Display;
  86 use GetConfig;
  87
  88 our @EXPORT = qw(
  89   mail
  90 );
  91
  92 my ($err, %config);
  93
  94 my $mail_conf = dirname(__FILE__) . '/../etc/mail.conf';
  95
  96 if (-r $mail_conf) {
  97   %config = GetConfig $mail_conf;
  98
  99   $config{SMTPHOST} = $ENV{SMTPHOST} || $config{SMTPHOST};
 100
 101   $err = "SMTPHOST not defined in $mail_conf nor in the environment variable SMTPHOST"
 102     unless $config{SMTPHOST};
 103
 104   unless ($err) {
 105     $config{SMTPFROM} = $ENV{SMTPFROM} || $config{SMTPFROM};
 106
 107     $err = "SMTPFROM not defined in $mail_conf nor in the environment variable SMTPFROM"
 108       unless $config{SMTPFROM};
 109   } # unless
 110 } else {
 111   $err = "Unable to read mail config file $mail_conf";
 112 } # if
 113
 114 sub randStr() {
 115   my $length = int(rand 16);
 116
 117   my @charset = ('A'..'Z', 'a'..'z', 0..9);
 118
 119   my $randStr;
 120   $randStr .= $charset[rand @charset] for 0..$length;
 121
 122   return $randStr;
 123 } # randStr
 124
 125 sub mail(%) {
 126   my (%parms) = @_;
 127
 128 =pod
 129
 130 =head2 mail (<parms>)
 131
 132 Send email. The following OO style arguments are supported:
 133
 134 =begin html
 135
 136 <blockquote>
 137
 138 =end html
 139
 140 =over
 141
 142 =item from
 143
 144 The from email address. If not specified then defaults to $ENV{SMTPFROM}.
 145
 146 =item to
 147
 148 Comma separated list of email addresses to set the mail to. At least
 149 one address must be specified.
 150
 151 =item cc
 152
 153 Comma separated list of email addresses to cc the mail to.
 154
 155 =item bcc
 156
 157 Comma separated list of email addresses to bcc the mail to.
 158
 159 =item subject
 160
 161 Subject line for email (Default: "(no subject)")
 162
 163 =item mode
 164
 165 Mode to send the email as. Values can be "plain", "text/plain",
 166 "html", "text/html".
 167
 168 =item randomizeFrom
 169
 170 Generate a random From email address.
 171
 172 =item data
 173
 174 Either a scalar that contains the message or a filehandle to an open
 175 file which contains the message. Can contain HTML if mode = HTML.
 176
 177 =item heading
 178
 179 Text to be included at the beginning of the email message. Can
 180 contain HTML if mode = HTML.
 181
 182 =item footing
 183
 184 Text to be included at the end fo the email message. Can contain HTML
 185 if mode = HTML.
 186
 187 =back
 188
 189 =begin html
 190
 191 </blockquote>
 192
 193 =end html
 194
 195 Returns:
 196
 197 =begin html
 198
 199 <blockquote>
 200
 201 =end html
 202
 203 =over
 204
 205 =item Nothing
 206
 207 =back
 208
 209 =begin html
 210
 211 </blockquote>
 212
 213 =end html
 214
 215 =cut
 216
 217   # If from isn't specified we'll use a default
 218   my $from = $parms{from} || $config{SMTPFROM};
 219
 220   if ($parms{randomizeFrom}) {
 221     # Generate a random From address
 222     my $username = randStr;
 223     my $domain   = randStr;
 224
 225     $from = "$username\@defaria.com";
 226   } # if
 227
 228   my $me = "Mail::mail";
 229
 230   # Make arrays for to, cc and bcc
 231   my @to  = split /, */, $parms{to};
 232   my @cc  = split /, */, $parms{cc}  if $parms{cc};
 233   my @bcc = split /, */, $parms{bcc} if $parms{bcc};
 234
 235   error   "$me: You must specify \"to\""        if @to == 0;
 236   warning "$me: You should specify \"subject\"" unless $parms{subject};
 237
 238   my $subject = $parms{subject} || "(no subject)";
 239
 240   my $mode;
 241
 242   if (!$parms{mode}) {
 243     $mode = "text/plain";
 244   } elsif ($parms{mode} eq "plain" or $parms{mode} eq "text/plain") {
 245     $mode = "text/plain";
 246   } elsif ($parms{mode} eq "html") {
 247     $mode = "text/html";
 248   } elsif ($parms{mode} eq "html") {
 249     $mode = "text/html";
 250     # Make sure we can get our modules...
 251     eval { require MIME::Entity }
 252       or error "Unable to find MIME::Entity module", 1;
 253     eval { require HTML::Parser }
 254       or error "Unable to find HTML::Parser module", 1;
 255     eval { require HTML::FormatText }
 256       or error "Unable to find HTML::FormatText module", 1;
 257     eval { require HTML::TreeBuilder }
 258       or error "Unable to find HTML::TreeBuilder module", 1;
 259   } else {
 260     error "Mode, ${parms{mode}}, is invalid - should be plain or html", 1;
 261   } # if
 262
 263   # Connect to server
 264   my $smtp = Net::SMTP->new($config{SMTPHOST})
 265     or error "Unable to connect to mail server: $config{SMTPHOST}", 1;
 266
 267   # Address the mail
 268   $smtp->mail($from);
 269
 270   # Who are we sending to...
 271   $smtp->to  ($_, {SkipBad => 1}) for (@to);
 272   $smtp->cc  ($_, {SkipBad => 1}) for (@cc);
 273   $smtp->bcc ($_, {SkipBad => 1}) for (@bcc);
 274
 275   # Now write the headers
 276   $smtp->data;
 277   $smtp->datasend("From: $from\n");
 278   $smtp->datasend("To: $_\n") for (@to);
 279   $smtp->datasend("Cc: $_\n") for (@cc);
 280   $smtp->datasend("Subject: $subject\n");
 281   $smtp->datasend("Content-Type: $mode\n");
 282   $smtp->datasend("\n");
 283
 284   # If heading is specified then the user wants this stuff before the main
 285   # message
 286   my $msgdata = $parms{heading};
 287   chomp $msgdata if $msgdata;
 288
 289   # If $parms{data} is a GLOB we'll assume it's a FILE reference.
 290   if (ref ($parms{data}) eq "GLOB") {
 291     my @lines;
 292     my $datafile = $parms{data};
 293
 294     # Just because it's a file reference doesn't mean that it's a valid file
 295     # reference!
 296     unless (eval { @lines = <$datafile> }) {
 297       error "$me: File passed in to mail is invalid - $!", 1
 298     } # unless
 299
 300     $msgdata .= join "", @lines;
 301   } else {
 302     $msgdata .= $parms{data};
 303   } # if
 304
 305   # If footing is specified then the user wants this stuff after the main
 306   # message
 307   $msgdata .= $parms{footing} if defined $parms{footing};
 308
 309   # if the user requested html mode then convert the message to HTML
 310   if ($mode eq "multipart") {
 311     # Create multipart container
 312     my $container = MIME::Entity->build (
 313       Type    => "multipart/alternative",
 314       From    => $from,
 315       Subject => $subject
 316     );
 317
 318     # Create a textual version of the HTML
 319     my $html = HTML::TreeBuilder->new;
 320     $html->parse($msgdata);
 321     new$html->eof;
 322     my $formatter = HTML::FormatText->new(
 323       leftmargin  => 0,
 324       rightmargin => 80
 325     );
 326     my $plain_text = $formatter->format($html);
 327
 328     # Create ASCII attachment first
 329     $container->attach(
 330       Type     => "text/plain",
 331       Encoding => "quoted-printable",
 332       Data     => $plain_text,
 333     );
 334
 335     # Create HTML attachment
 336     $container->attach(
 337       Type     => "text/html",
 338       Encoding => "quoted-printable",
 339       Data     => $msgdata,
 340     );
 341
 342     $container->smtpsend(Host => $smtp);
 343   } else {
 344     # Plain text here
 345     $smtp->datasend($msgdata);
 346   } # if
 347
 348   # All done
 349   $smtp->dataend;
 350   $smtp->quit;
 351
 352   return;
 353 } # mail
 354
 355 1;
 356
 357 =pod
 358
 359 =head2 CONFIGURATION AND ENVIRONMENT
 360
 361 SMTPHOST: Set to the appropriate mail server
 362
 363 SMTPFROM: Set to a from address to be used as a default
 364
 365 =head2 DEPENDENCIES
 366
 367 =head3 Perl Modules
 368
 369 L<Net::SMTP>
 370
 371 L<File::Basename>
 372
 373 =head3 CPAN Modules
 374
 375 (Optionally - i.e. if html email is requested:)
 376
 377 =for html <p><a href="http://search.cpan.org/search?query=MIME::Entity">MIME::Entity</a>
 378
 379 =for html <p><a href="http://search.cpan.org/search?query=HTML::Parser">HTML::Parser</a>
 380
 381 =for html <p><a href="http://search.cpan.org/search?query=HTML::FormatText">HTML::FormatText</a>
 382
 383 =for html <p><a href="http://search.cpan.org/search?query=HTML::TreeBuilder">HTML::TreeBuilder</a>
 384
 385 =head3 ClearSCM Perl Modules
 386
 387 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
 388
 389 =for html <p><a href="/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a></p>
 390
 391 =head2 INCOMPATABILITIES
 392
 393 None yet...
 394
 395 =head2 BUGS AND LIMITATIONS
 396
 397 There are no known bugs in this module.
 398
 399 Please report problems to Andrew DeFaria >Andrew@ClearSCM.com>.
 400
 401 =head2 LICENSE AND COPYRIGHT
 402
 403 This Perl Module is freely available; you can redistribute it and/or
 404 modify it under the terms of the GNU General Public License as
 405 published by the Free Software Foundation; either version 2 of the
 406 License, or (at your option) any later version.
 407
 408 This Perl Module is distributed in the hope that it will be useful,
 409 but WITHOUT ANY WARRANTY; without even the implied warranty of
 410 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 411 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
 412 details.
 413
 414 You should have received a copy of the GNU General Public License
 415 along with this Perl Module; if not, write to the Free Software Foundation,
 416 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 417 reserved.
 418
 419 =cut