Help Me Write Tests

LTLmail.pm

package LTLmail ;

# sends mail for our lab

=pod

=head1 NAME

LTLmail - Simplify the automated sending of mail for the Genomics Core Lab

=head1 SYNOPSYS

use LTLmail qw{ send_mail } ;

my @test_addrs = email_addresses( 'test' ) ;

my $email = {

    user    => 'sequence',
    to      => @test_addrs ,
    cc      => [ 'jacoby@github.test' ],
    subject => 'Testing Account Creation',
    body    => join "\n", 1 .. 20
    } ;

my $response = send_mail( $email ) ;

=head1 DESCRIPTION

Function holding subroutines relating to email for the Genomics Core Lab.

=head1 SUBROUTINES

=cut

use feature qw{ say state } ;
use strict ;
use warnings ;
use utf8 ;

use Carp ;
use Data::Dumper ;
use Exporter qw(import) ;
use Net::SMTP ;
use YAML qw{ DumpFile LoadFile } ;

#use Net::SMTP::TLS ;

our $VERSION = 0.0.1 ;
our @EXPORT  = qw(
    send_mail
    email_addresses
    ) ;

use lib '/group/gcore/apps/lib' ;
use DB qw( db_arrayref ) ;

our %EXPORT_TAGS = ( 'all' => [ @EXPORT ], ) ;
our @EXPORT_OK = ( @{ $EXPORT_TAGS{ 'all' } } ) ;

=head2 send_mail

Sends an email 

=head3 Input

A hash object containing:
    
    * body - the text of the message
    * user - the user whose configuration settings will be used
    * to - the recipients of the email, stored in an array 
    * subject - the subject line of the message ( optional )
    * cc - the carbon-copied recipients of the mail, 
        stored in an array (optional)
    * bcc - the blind-carbon-copied recipients of the mail, 
        stored in an array (optional)
    * debug - contains the response code you want to test 
        instead of actually sending mail, with 221 being
        "success" and 500 being "fail" (optional)
    * verbose - boolean flag to show a greater amount 
        of the input and output of the workings (optional)

=head3 Output

There are three required entries in the hash object: user, to and body.
Messages must come from someone, go to someone, and communicate something.
In the case that any of these is missing, the subroutine returns "0" and
a list of the missing elements.

Otherwise, the subroutine returns the $smtp->code() string, which is the 
SMTP reply code. If the debug flag is set, it returns 221, meaning
"Closing Connection", which indicates success. 

=head3 Notes

For many error codes, the underlying module, Net::SMTP, dies, and 
using Try::Tiny to keep trap the croak also serves to hide successful 
responses. For connecting to smtp.purdue.edu, there should be no problem
with this issue.

This code is set to handle email within Purdue, which doesn't 
require SSL or TLS. 

=head4 "user"

send_mail() is meant for automated email, not personal mail, so there
are two user configurations: gcore and sequence. sequence is the group
account for the lab, and gcore is our user on the RCAC clusters. As a
rule, billing information will be sent from sequence and error reports
will be sent from gcore.

=cut

sub send_mail {
    my $message = shift ;
    my @error ;
    my @required = qw{ user to body } ;
    for my $r ( @required ) {
        push @error , $r if ! defined $message->{ $r } ; 
        }
    if ( scalar @error ) { return '0: ' . ( join ',' , @error ) }

    say Dumper $message if $message->{ verbose } ;
    $message->{ conf } = _config( $message->{ user } ) ;
    return '0: invalid user' if ! defined $message->{ conf } ;

    return _send_mail( $message ) ;
    }

# ----------------------------------------------------------------------
# grabs the configuration for connections to the SMTP server. Fields
# include:
#   addr: the email address associated with the account
#   smtp: the name of the SMTP server
#   user: the username associated with that account
#
# in my case, user would be "djacoby" but addr would be "jacoby@purdue.edu"
sub _config {
    my $from       = shift ;
    my $configfile = '/group/gcore/apps/config/smtp.yaml' ;
    croak q{No config file} if !-f $configfile ;
    my $config = LoadFile( $configfile ) ;
    croak q{Can't open config file or empty config file} if !scalar keys %$config ;
    return $config->{ $from } ;
    }

# ----------------------------------------------------------------------
# Sends the mail. Takes a hashref with configuration set in $message->{ conf }
# returns the response code from the SMTP server, unless debug is set, then
# it returns that value without involving the SMTP server.
sub _send_mail {
    my $message = shift ;
    my %msg     = @_ ;
    my $bcc     = $message->{ bcc } ;

    # my @bcc     = @$bcc ;
    my $cc = $message->{ cc } ;

    # my @cc      = @$cc  || () ;
    my $to = $message->{ to } ;
    my @to = @$to ;

    if ( $message->{ debug } ) {
        return $message->{ debug } ;
        }

    my $from   = $message->{ conf }->{ addr } ;
    my $mailer = Net::SMTP->new(
        $message->{ conf }->{ smtp },
        Timeout => 30,
        Debug   => $message->{ verbose }
        ) ;
    $mailer->mail( $message->{ conf }->{ addr } ) ;
    $mailer->to( @to ) ;
    $mailer->cc( @$cc )   if defined $cc ;
    $mailer->bcc( @$bcc ) if defined $bcc ;
    $mailer->data ;
    $mailer->datasend( "Subject: $message->{ subject } \n" ) if $message->{ subject } ;
    $mailer->datasend( 'From: ' . $from . "\n" ) ;
    $mailer->datasend( 'To: ' . ( join ',', @to ) . "\n" ) ;
    $mailer->datasend( 'Cc: ' . ( join ',', @$cc ) . "\n" ) if defined $cc ;
    $mailer->datasend( "\n" ) ;
    $mailer->datasend( $message->{ body } ) ;
    $mailer->dataend ;
    $mailer->quit ;
    say $mailer->message() if $message->{ verbose } ;
    return $mailer->code() ;
    }


1 ;

=pod

=head1 AUTHOR

Dave Jacoby <jacoby@purdue.edu>

sendmail.t

use Test::Most ;

use LTLmail qw( send_mail ) ;

    my $message = {} ;
    $message->{ debug } = 221 ; #setting debug to "mail sent"

# invalid email --  no user, body, recipients

    my $response ;
    $response = send_mail( $message ) ;
is( $response , '0: user,to,body', 'IDs all required fields' ) ;

# invalid email --  no body, recipients

    $message->{ user } = 'smith' ;
    $response = send_mail( $message ) ;
is( $response , '0: to,body', 'IDs required to,body' ) ;

# invalid email --  no recipients

    $message->{ body } = 'this is an email message' ;
    $response = send_mail( $message ) ;
is( $response , '0: to', 'IDs required to' ) ;

# valid message - proceeds to testing

    $message->{ to } = [ 'test@github.test' ] ;
    $response = send_mail( $message ) ;
is( $response , '0: invalid user' , 'Identifies invalid user' ) ;

# valid message - proceeds to testing

    $message->{ user } = 'gcore' ;
    $response = send_mail( $message ) ;
is( $response , 221 , 'Recognizes user, to and body' ) ;

done_testing();

#End

smtp.yaml

---
comments:   must be viewable by the web server
gcore:
    addr: Developer-Pointed Email address <developers@github.test>
    smtp: bogus.github.test
    user: gcore
biz:
    addr: User-Pointed Email address <business@github.test>
    smtp: bogus.github.test
    user: biz