An Object Oriented Perl Module to Send an Email - One Component of a Larger OO Perl Application
The below module is a simple OO wrapper to the CPAN module Net::SMTP, oriented towards being a component of a much larger application. It is a great example to show many basic as well as some advanced concepts and techniques of OO Perl programming. We do not add much if any functionality to Net::SMTP with this wrapper module, in fact we hide other functionality available in Net::SMTP and in some cases it might be the goal of such a wrapper to encapsulate and hide capabilities which you do not want to be accessible to the users of your class or module. The main OO features in this code mostly come from the best practices taught by Damian Conway in his authoritative book on the subject, Object Oriented Perl. Let's have a look at some of them.
First, here is the sendit.pl program which uses my module. There are lots of useful comments in the code.
#!/usr/bin/perl
# All code by Jim Mannix - 2009.
use strict;
use warnings;
use EmSend;
# We pass an array ref to EmSend/Net::SMTP for the whole message body
# Note that the newlines at the end of each line/element need to be included in our array
# We could probably pass a large multi-line string as well
my @message_body = (
"Line 1 of the message body.\n",
"Line 2 of the message body and the second element of this array.\n",
".\n",
"\n",
"Above this line is a blank line, above which is a single . on a line.\n",
"We want to make sure that we can send a . and blank line like this in our message body.\n",
"In SMTP, the . blank line combo singnals the end of the email data (message body).\n",
"This pattern should be possible to send in an email,\n",
"using an SMTP escape sequence or some other facility.\n",
"There is no guarantee that this will be handled by Net::SMTP and we want to find out.\n",
"\n",
"Another blank line above this. Now were done with this message body.\n",
);
my %em_arg =
( smtp_host => '192.168.1.101',
envelope_sender => 'sendit_program@ethernet',
from => 'mua_displayed_from',
recipient => 'electric',
subject => 'Subject of Test Email',
message_body => \@message_body,
);
my $email = EmSend->new( \%em_arg );
$email->send;
##
#
And now the module itself. Have a look at the code comments for a fairly detailed explanation of the important parts.
#
# All code by Jim Mannix - 2009.
##
package EmSend;
$VERSION = 1.00;
# ElectricLinux@DeepVirtual 2009 - deepvirtual.com
use strict;
use vars qw( $AUTOLOAD );
use warnings;
use diagnostics;
use Carp;
use Net::SMTP;
{
# Encapsulated class data
my %_attr_data = # DEFAULT ACCESSIBILITY
( _smtp_host => [ '192.168.1.101', 'read/write' ],
_envelope_sender => [ $ENV{USER}, 'read/write' ],
_from => [ 'mua_displayed_from', 'read/write' ],
_recipient => [ '???', 'read/write' ],
_subject => [ '???', 'read/write' ],
_message_body => [ ['Test1', 'Test2'], 'read/write' ],
_smtp_code => [ '???', 'read/write' ],
_smtp_message => [ '???', 'read/write' ],
_status => [ 'initialized', 'read/write' ],
_delivery_time => [ '???', 'read/write' ],
);
my $_count = 0;
# Class methods to operate on encapsulated class data
# Is a specified object attribute accessible in a given mode
sub _accessible
{
my ( $self, $attr, $mode ) = @_;
$_attr_data{$attr}[1] =~ /$mode/;
}
# Classwide default value for a specified object attribute
sub _default_for
{
my ( $self, $attr ) = @_;
$_attr_data{$attr}[0];
}
# Private method returns list of names of all specified object attributes
sub _standard_keys { keys %_attr_data }
sub get_count { $_count } # Public method to retrieve the object count
sub _incr_count { ++$_count } # Private method to increment object count
sub _decr_count { --$_count } # Private method to decrement object count
} # end block enclosing class data and class methods
# new Constructor, also can be considered a class method when called through the
# class name such as Class->new( %arg_for_new_object ) and sets standard defaults,
# but if called through an object reference,
# like $obj_ref->new( %arg_to_customize_cloned_object ) would be considered
# an object method, effectively cloning+tweaking the existing object and its attributes
sub new
{
my ( $caller, $arg_hash_ref ) = @_; # Take all args to public methods as a hash ref
my %arg = %{$arg_hash_ref};
my $caller_is_obj = ref( $caller );
# If cloning via object method by calling new through an object reference,
# use the class name of the object. If this new was inheritied, class could be
# different. **** CLARIFY THIS STATEMENT ****
my $class = $caller_is_obj || $caller;
my $self = bless {}, $class; # Generate new empty anonymous hash, bless as $class
foreach my $attrname ( $self->_standard_keys() )
{
my ( $argname ) = ( $attrname =~ /^_(.*)/);
if ( exists $arg{$argname} )
{ $self->{$attrname} = $arg{$argname} } # Class makes fresh attributes
elsif ( $caller_is_obj )
{ $self->{$attrname} = $caller->{$attrname} } # Cloning uses attrs of orig object
else
{ $self->{$attrname} = $self->_default_for( $attrname ) }
} # end foreach _standard_keys
$self->_incr_count();
return $self;
} # end new constructor
# Destructor adjusts class count
sub DESTROY
{
$_[0]->_decr_count();
# If the SMTP connection might still exist here (unlikely) then clean that up.
# If we are in multi-send mode and the data file is open, close it.
}
# Object methods go here, operating on the attributes or instance data of
# this object (instance of the class).
# Send the email of this object
sub send
{
my ( $self, %arg ) = @_;
$self->set_delivery_time( time() );
$self->set_status( 'sending' );
my $smtp = Net::SMTP->new( $self->get_smtp_host );
unless ( $smtp ) {
die( localtime( time ) . " Failed to make a connection to " . $self->get_smtp_host . "\n" );
}
$smtp->mail( $self->get_envelope_sender );
$smtp->to( $self->get_recipient );
$smtp->data();
# Below we pass an array ref to Net::SMTP for the whole message body
# Note that the newlines at the end of each line/element need to be included in our array
# We could probably pass a large multi-line string as well
$smtp->datasend( $self->get_message_body );
$smtp->dataend();
$smtp->quit;
$self->set_status( 'sent' );
} # end sub send
# Dynamically generate basic attribute accessor methods (get/set) for elements
# of our object's %_attr_data hash, honoring the accessibility settings.
# The basic accessor subroutines spring into existence when first called if
# access is permitted and those dynamic subs remain after their first invocation,
# so subsequent calls are as efficient as a hardcoded subrountine.
sub AUTOLOAD
{
no strict "refs";
my ( $self, $newval ) = @_;
# Was it a get_* method?
if ( $AUTOLOAD =~ /.*::get(_\w+)/ && $self->_accessible( $1, 'read' ) )
{
my $attr_name = $1;
*{$AUTOLOAD} = sub { return $_[0]->{$attr_name} };
return $self->{$attr_name}
}
# Was is a set_* method?
if ( $AUTOLOAD =~ /.*::set(_\w+)/ && $self->_accessible( $1, 'write' ) )
{
my $attr_name = $1;
*{$AUTOLOAD} = sub { $_[0]->{$attr_name} = $_[1]; return };
$self->{$1} = $newval;
return
}
croak( "No such method: $AUTOLOAD" );
} # end sub AUTOLOAD
1;
##
#
