Perl: How to check that the Perl Modules are installed at runtime

Often when you write a Perlprogram in Perl, you know which system(s) you’re going to be using the program on and you can ensure the required Perl modules are installed. Other times, you may not. Unless you want to be called simply because a required Perl module wasn’t installed on a system, you probably should check and provide a meaningful error message.

In this example, we’ll use the core module Module::Load in order to load a module. We also declare the %MISSING_MODULE hash:

use Module::Load;

our %MISSING_MODULE;

We populate the %noncore_modules with non-core modules we want to use. If the value for the module is an array, we will import those specific variables/subroutines:

BEGIN {
    # We're going to use:
    #   Pod::Usage with no special imports
    #   My::Secret::Module importing *ONLY* potato and carrot subroutines
    my %noncore_modules = (
        'Pod::Usage'         => 'default',
        'My::Secret::Module' => [ qw(
            potato
            carrot
            ) ],
    );

    foreach my $tmp_module (keys %noncore_modules ) { 
        if (eval { load $tmp_module ; 1; } ) { 
            if ( ref( $noncore_modules{$tmp_module} ) eq 'ARRAY' ) { 
                # Only specified subroutines/variables specified in
                #  %noncore_modules will be imported
                $tmp_module->import( @{ $noncore_modules{$tmp_module} } );
            } else {
                # anything in the @EXPORT of the module will be imported
                #  @EXPORT_OK will not be imported

                $tmp_module->import();
            }   
        } else {
            $MISSING_MODULE{$tmp_module} = 1;
        }   
    }
}

Now that we’ve loaded Perl modules that we could, let’s report on any that failed to load:

if (%MISSING_MODULE) {                                            
    $RC = 1;

    foreach my $perl_module (keys %MISSING_MODULE) {
        printf STDERR "Missing Perl module %s. Please have unix team install the module and verify permissions!\n", $perl_module;
        print STDERR "ABORTING\n";
    }

    exit $RC;
}
Share Button

Sending email with attachments from Perl – the easy way

Since I’ve already had my Linux box set up as an SMTP server, I can just use the built in sendmail capabilities of Mail::Sendmail. I could easily have it use an external SMTP server by specifying it in the $mail{smtp} hash variable.

In this example, I’m going to send a hard coded HTML string to my dbS::EMail along with a jpeg of the Enterprise. Why wrap Mail::Sendmail in a perl module and not use it directly? I wish to make it as simple as possible for myself by hiding the complexities.

#!/usr/bin/perl

use strict;
use warnings;

use dbS::EMail;

my $message < <EOF

This past Sunday my 30GB iPod photo finally died.  It lasted just over three years and it was a true veteran.  It was dropped, kicked, washed (accidentally), and chewed on by Tonks.  Sunday afternoon after returning from the <a href="http://froebe.net/blog/2007/08/26/more-photos-of-our-house/">build site of the new house, I went back out to the car and dropped the iPod three times in 60 seconds.  Low and behind it finally died.  I took it apart, reseated everything but when the iPod started, I heard the click click of a dead hard drive.  After an hour of trying to coax it back to life, <a href="http://www.froebe-fibers.com" onclick="return alinks_click(this);" class="alinks_links" title="Rebecca Froebe" style="background: transparent url('http://froebe.net/blog/wp-content/plugins/alinks/images/external.png') no-repeat scroll right center; padding-right: 13px; -moz-background-clip: -moz-initial; -moz-background-origin: -moz-initial; -moz-background-inline-policy: -moz-initial" rel="external">my wife</a> offered to buy a new 30GB Video iPod for my birthday.

I loaded it up with podcasts, music and video.  What I’ve noticed is that when I go iPod -> Music -> Podcasts -> <a href="http://chris.pirillo.com/media/">The Chris Pirillo Show</a>, I saw a normal podcast and no video.  After a few seconds of thinking I messed something up, I didn’t, I tried iPod -> Video Podcasts -> <a href="http://chris.pirillo.com/media/">The Chris Pirillo Show</a> and video was found <img src="http://froebe.net/blog/wp-includes/images/smilies/icon_smile.gif" alt=":)" class="wp-smiley" />   I would have thought that it wouldn’t make any difference if I played the video podcast from “Podcasts” or “Video Podcasts”, but apparently it does.

EOF

if ( dbS::EMail::simple_send('jason@froebe.net.nospam', $PROC . ': test email with attached jpg' , $message, undef, { type => 'text', 'files' => "/home/jfroebe/enterprise.jpg" } ) ) {
   print "SUCCESS!  Email sent\\n";
} else {
   print "ERROR:  Email send failed\\n";
   printf "ERROR:  Email Transport: %s\\n", $dbS::EMail::error if $dbS::EMail::error;
   printf "ERROR:  Email Transport Log: %s\\n", $dbS::EMail::log if $dbS::EMail::log;
}

exit;

The following is the dbS::EMail Perl Module. Note that when we are sending regular text, we are still sending MIME encoded. That’s not a bad thing but could annoy some people on antique email clients. Attachments are handled by sending a filename path to the module which will attempt to determine what type of file it is by using File::MMagic and then encode the file using MIME::Base64. All subroutines starting with the underscore “_” are considered internal subroutines and shouldn’t be accessed outside of the module.

package dbS::EMail;

use warnings;
use strict;

use File::Basename;
use File::MMagic;
use Mail::Sendmail;
use MIME::Base64;
use MIME::QuotedPrint;

our $PROC = basename($0);

BEGIN {
    use Exporter ();

    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
    $VERSION = 1.0.0;

    @ISA = qw(Exporter);
    @EXPORT_OK = qw(&amp;simple_send $error $log);
}

#=========================
our $error;
our $log;
our $boundary = "====" . time() . "====";
our $start_attachment = "--" . $boundary;
our $end_ALL_attachments = "--" . $boundary . '--';
#=========================
sub _attach_file {
   my ($mail, $filename) = @_;

   my $FH;
   my $mm = new File::MMagic;
   my $content_type = $mm->checktype_filename($filename);

   if ( open($FH, "< ", $filename) ) {
      my $tmp_file = basename($filename);

      binmode $FH;
      undef $/;

      my $mime_header =
         $start_attachment
         . "\\nContent-Type: $content_type; name=\\"$tmp_file\\"\\n"
         . "Content-Transfer-Encoding: base64\\n"
         . "Content-Disposition: attachment; filename=\\"$tmp_file\\"\\n";

      $mail->{body} .=
         $mime_header
         . encode_base64(< $FH>)
         . "\\n";
   } else {
      warn("Unable to attach file: $filename\\n");
   }

   return $mail;
}

sub _email_content_type {
   my $mail = shift;

   $mail->{'content-type'} = "multipart/mixed; boundary=\\"$boundary\\"";

   return %$mail;
}

sub _email_type {
   my ($parms, $mail) = @_;

   if ($parms->{'options'}->{'type'} &amp;&amp; $parms->{'options'}->{'type'} =~ m/^html$/i ) {
      my $mime_header =
         $start_attachment
         . "\\nContent-Type: text/html; charset=\\"iso-8859-1\\"\\n"
         . "Content-Transfer-Encoding: quoted-printable\\n";

      $mail->{'body'} =
         $mime_header
         . "\\n"
         . encode_qp($parms->{Body})
         . "\\n";
   } else {
      my $mime_header =
         $start_attachment
         . "\\nContent-Type: text/plain; charset=\\"iso-8859-1\\"\\n"
         . "Content-Transfer-Encoding: quoted-printable\\n";

      $mail->{'body'} =
         $mime_header
         . encode_qp($parms->{Body})
         . "\\n";
   }

   return %$mail;
}

sub _email_file {
   my ($parms, $mail) = @_;

   if ($parms->{'options'}->{'files'}) {
      if ( ref($parms->{'options'}->{'files'}) eq 'ARRAY') {
         # We need to attach multiple files
         foreach my $filename ( $parms->{'options'}->{'files'} ) {
            $mail = _attach_file($mail, $filename);
         }
      } else {
         # We need to attach a single file
         $mail = _attach_file($mail, $parms->{'options'}->{'files'});
      }
   }

   return %$mail;
}

sub _send_email {
   my $parms = shift;

   if ($parms &amp;&amp; $parms->{To} &amp;&amp; $parms->{Subject} &amp;&amp; $parms->{Body} ) {
      $parms->{From} = 'sis-dba@example.com' unless $parms->{From};

      my %mail = (
         To      => $parms->{To},
         From   => $parms->{From},
         Subject   => $parms->{Subject}
      );

      %mail = _email_content_type(\\%mail);
      %mail = _email_type($parms, \\%mail);
      %mail = _email_file($parms, \\%mail) if $parms->{'options'}->{'files'};

      $mail{'body'} .= $end_ALL_attachments;

      if ( sendmail(%mail) ) {
         return 1;
      } else {
         $error = $Mail::Sendmail::error;
         $log = $Mail::Sendmail::log;
      }
   } else {
      warn ("ERROR:  dbS::EMail\\n");
      warn ("\\t'To' parameter is required\\n") unless $parms->{To};
      warn ("\\t'Subject' parameter is required\\n") unless $parms->{Subject};
      warn ("\\t'Body' parameter is required\\n") unless $parms->{Body};
   }
}

sub simple_send {
   my ($To, $Subject, $Body, $From, $options) = @_;

   return _send_email( {
      To      => $To,
      Subject   => $Subject,
      From   => $From,
      Body   => $Body,
      options   => $options
   } );
}

1;
Share Button