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 mail {
 115   my (%parms) = @_;
 116
 117 =pod
 118
 119 =head2 mail (<parms>)
 120
 121 Send email. The following OO style arguments are supported:
 122
 123 =begin html
 124
 125 <blockquote>
 126
 127 =end html
 128
 129 =over
 130
 131 =item from
 132
 133 The from email address. If not specified then defaults to $ENV{SMTPFROM}.
 134
 135 =item to
 136
 137 Comma separated list of email addresses to set the mail to. At least
 138 one address must be specified.
 139
 140 =item cc
 141
 142 Comma separated list of email addresses to cc the mail to.
 143
 144 =item bcc
 145
 146 Comma separated list of email addresses to bcc the mail to.
 147
 148 =item subject
 149
 150 Subject line for email (Default: "(no subject)")
 151
 152 =item mode
 153
 154 Mode to send the email as. Values can be "plain", "text/plain",
 155 "html", "text/html".
 156
 157 =item data
 158
 159 Either a scalar that contains the message or a filehandle to an open
 160 file which contains the message. Can contain HTML if mode = HTML.
 161
 162 =item heading
 163
 164 Text to be included at the beginning of the email message. Can
 165 contain HTML if mode = HTML.
 166
 167 =item footing
 168
 169 Text to be included at the end fo the email message. Can contain HTML
 170 if mode = HTML.
 171
 172 =back
 173
 174 =begin html
 175
 176 </blockquote>
 177
 178 =end html
 179
 180 Returns:
 181
 182 =begin html
 183
 184 <blockquote>
 185
 186 =end html
 187
 188 =over
 189
 190 =item Nothing
 191
 192 =back
 193
 194 =begin html
 195
 196 </blockquote>
 197
 198 =end html
 199
 200 =cut
 201
 202   # If from isn't specified we'll use a default
 203   my $from = defined $parms{from} ? $parms{from} : $config{SMTPFROM};
 204
 205   error $err, 1 if $err;
 206
 207   my $me = "Mail::mail";
 208
 209   # Make arrays for to, cc and bcc
 210   my (@to, @cc, @bcc);
 211   @to  = split /, */, $parms{to};
 212   @cc  = split /, */, $parms{cc}  if defined $parms{cc};
 213   @bcc = split /, */, $parms{bcc} if defined $parms{bcc};
 214
 215   error       "$me: You must specify \"to\""        if scalar @to == 0;
 216   warning     "$me: You should specify \"subject\"" if !defined $parms{subject};
 217
 218   my $subject = defined $parms{subject} ? $parms{subject} : "(no subject)";
 219
 220   my $mode;
 221
 222   if (!defined $parms{mode}) {
 223     $mode = "text/plain";
 224   } elsif ($parms{mode} eq "plain" or $parms{mode} eq "text/plain") {
 225     $mode = "text/plain";
 226   } elsif ($parms{mode} eq "html") {
 227     $mode = "text/html";
 228   } elsif ($parms{mode} eq "html") {
 229     $mode = "text/html";
 230     # Make sure we can get our modules...
 231     eval { require MIME::Entity }
 232       or error "Unable to find MIME::Entity module", 1;
 233     eval { require HTML::Parser }
 234       or error "Unable to find HTML::Parser module", 1;
 235     eval { require HTML::FormatText }
 236       or error "Unable to find HTML::FormatText module", 1;
 237     eval { require HTML::TreeBuilder }
 238       or error "Unable to find HTML::TreeBuilder module", 1;
 239   } else {
 240     error "Mode, ${parms{mode}}, is invalid - should be plain or html", 1;
 241   } # if
 242
 243   # Connect to server
 244   my $smtp = Net::SMTP->new ($config{SMTPHOST})
 245     or error "Unable to connect to mail server: $config{SMTPHOST}", 1;
 246
 247   # Address the mail
 248   $smtp->mail ($from);
 249
 250   # Who are we sending to...
 251   $smtp->to  ($_, {SkipBad => 1}) foreach (@to);
 252   $smtp->cc  ($_, {SkipBad => 1}) foreach (@cc);
 253   $smtp->bcc ($_, {SkipBad => 1}) foreach (@bcc);
 254
 255   # Now write the headers
 256   $smtp->data;
 257   $smtp->datasend ("From: $from\n");
 258   $smtp->datasend ("To: $_\n") foreach (@to);
 259   $smtp->datasend ("Cc: $_\n") foreach (@cc);
 260   $smtp->datasend ("Subject: $subject\n");
 261   $smtp->datasend ("Content-Type: $mode\n");
 262   $smtp->datasend ("\n");
 263
 264   # If heading is specified then the user wants this stuff before the main
 265   # message
 266   my $msgdata = $parms{heading};
 267   chomp $msgdata if $msgdata;
 268
 269   # If $parms{data} is a GLOB we'll assume it's a FILE reference.
 270   if (ref ($parms{data}) eq "GLOB") {
 271     my @lines;
 272     my $datafile = $parms{data};
 273
 274     # Just because it's a file reference doesn't mean that it's a valid file
 275     # reference!
 276     unless (eval { @lines = <$datafile> }) {
 277       error "$me: File passed in to mail is invalid - $!", 1
 278     } # unless
 279
 280     $msgdata .= join "", @lines;
 281   } else {
 282     $msgdata .= $parms{data};
 283   } # if
 284
 285   # If footing is specified then the user wants this stuff after the main
 286   # message
 287   $msgdata .= $parms{footing} if defined $parms{footing};
 288
 289   # if the user requested html mode then convert the message to HTML
 290   if ($mode eq "multipart") {
 291     # Create multipart container
 292     my $container = MIME::Entity->build (
 293       Type    => "multipart/alternative",
 294       From    => $from,
 295       Subject => $subject
 296     );
 297
 298     # Create a textual version of the HTML
 299     my $html = HTML::TreeBuilder->new;
 300     $html->parse ($msgdata);
 301     $html->eof;
 302     my $formatter = HTML::FormatText->new (
 303       leftmargin      => 0,
 304       rightmargin     => 80
 305     );
 306     my $plain_text = $formatter->format ($html);
 307
 308     # Create ASCII attachment first
 309     $container->attach (
 310       Type     => "text/plain",
 311       Encoding => "quoted-printable",
 312       Data     => $plain_text,
 313     );
 314
 315     # Create HTML attachment
 316     $container->attach (
 317       Type     => "text/html",
 318       Encoding => "quoted-printable",
 319       Data     => $msgdata,
 320     );
 321
 322     $container->smtpsend (Host => $smtp);
 323   } else {
 324     # Plain text here
 325     $smtp->datasend ($msgdata);
 326   } # if
 327
 328   # All done
 329   $smtp->dataend;
 330   $smtp->quit;
 331
 332   return;
 333 } # mail
 334
 335 1;
 336
 337 =pod
 338
 339 =head2 CONFIGURATION AND ENVIRONMENT
 340
 341 SMTPHOST: Set to the appropriate mail server
 342
 343 SMTPFROM: Set to a from address to be used as a default
 344
 345 =head2 DEPENDENCIES
 346
 347 =head3 Perl Modules
 348
 349 L<Net::SMTP>
 350
 351 L<File::Basename>
 352
 353 =head3 CPAN Modules
 354
 355 (Optionally - i.e. if html email is requested:)
 356
 357 =for html <p><a href="http://search.cpan.org/search?query=MIME::Entity">MIME::Entity</a>
 358
 359 =for html <p><a href="http://search.cpan.org/search?query=HTML::Parser">HTML::Parser</a>
 360
 361 =for html <p><a href="http://search.cpan.org/search?query=HTML::FormatText">HTML::FormatText</a>
 362
 363 =for html <p><a href="http://search.cpan.org/search?query=HTML::TreeBuilder">HTML::TreeBuilder</a>
 364
 365 =head3 ClearSCM Perl Modules
 366
 367 =for html <p><a href="/php/scm_man.php?file=lib/Display.pm">Display</a></p>
 368
 369 =for html <p><a href="/php/scm_man.php?file=lib/GetConfig.pm">GetConfig</a></p>
 370
 371 =head2 INCOMPATABILITIES
 372
 373 None yet...
 374
 375 =head2 BUGS AND LIMITATIONS
 376
 377 There are no known bugs in this module.
 378
 379 Please report problems to Andrew DeFaria >Andrew@ClearSCM.com>.
 380
 381 =head2 LICENSE AND COPYRIGHT
 382
 383 This Perl Module is freely available; you can redistribute it and/or
 384 modify it under the terms of the GNU General Public License as
 385 published by the Free Software Foundation; either version 2 of the
 386 License, or (at your option) any later version.
 387
 388 This Perl Module is distributed in the hope that it will be useful,
 389 but WITHOUT ANY WARRANTY; without even the implied warranty of
 390 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 391 General Public License (L<http://www.gnu.org/copyleft/gpl.html>) for more
 392 details.
 393
 394 You should have received a copy of the GNU General Public License
 395 along with this Perl Module; if not, write to the Free Software Foundation,
 396 Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 397 reserved.
 398
 399 =cut