File Coverage

blib/lib/Mail/File.pm

Criterion	Covered	Total	%
statement	60	61	98.3
branch	17	18	94.4
condition	23	23	100.0
subroutine	13	14	92.8
pod	3	3	100.0
total	116	119	97.4

package Mail::File;

use warnings;
use strict;

use vars qw($VERSION $AUTOLOAD);
$VERSION = '0.13';

#----------------------------------------------------------------------------

=head1 NAME

Mail::File - mail module which writes to a flat file.

=head1 SYNOPSIS

  use Mail::File;

  my $mail = Mail::File->new(template => 'mailXXXX.tmp');
  $mail->From('[e-mail]');
  $mail->To('[e-mail]');
  $mail->Cc('Them ');
  $mail->Bcc('Us ; [e-mail]');
  $mail->Subject('Blah Blah Blah');
  $mail->Body('Yadda Yadda Yadda');
  $mail->XHeader('X-Header' => 'Blah Blah Blah');
  $mail->send;

  # Or use a hash
  my %hash = (
	From       => '[e-mail]',
	To         => '[e-mail]',
	Cc         => 'Them ',
	Bcc        => 'Us , [e-mail]',
	Subject    => 'Blah Blah Blah',
	Body       => 'Yadda Yadda Yadda',
	'X-Header' => 'Blah Blah Blah',
	template   => 'mailXXXX.tmp'
  );

  my $mail = Mail::File->new(%hash);
  $mail->send;

=head1 DESCRIPTION

This module was written to overcome the problem of sending mail messages,
where there is no mail application available.

The aim of the module is to write messages to a text file, that will format
the contents to include all the key elements of the message, such that the
file can be transported to another machine, which is then capable of sending
mail messages.

Notes that the filename template defaults to 'mail-XXXXXX.eml'.

=cut

#----------------------------------------------------------------------------
# Library Modules

use File::Basename;
use File::Path;
use File::Temp	qw(tempfile);
use Time::Piece;

#----------------------------------------------------------------------------
# Variables

my %autosubs = map {$_ => 1} qw( From To Cc Bcc Subject Body );

#----------------------------------------------------------------------------
# Interface Functions

=head1 METHODS

=over 4

=item new()

Create a new mailer object. Returns the object on success or undef on
failure.

All the following can be passed as part of an anonymous hash:

  From
  To
  Cc
  Bcc
  Subject
  Body
  template

The template entry is optional, and is only supplied when you call the
constructor. The format of the string to template follows the format as
for File::Temp. However, a suffix is automatically extracted. An example
template would be:

  mail-XXXX.tmp

Where the temnplate to File::Temp would be 'mail-XXXX' and the suffix
would be '.tmp'.

The default template, if none is supplied is:

  mail-XXXXXX.eml

=cut

sub new {
	my ($self, %hash) = @_;

	# create an attributes hash
	my $atts = {
		'From'		=> $hash{From}		|| '',
		'To'		=> $hash{To}		|| '',
		'Cc'		=> $hash{Cc}		|| '',
		'Bcc'		=> $hash{Bcc}		|| '',
		'Subject'	=> $hash{Subject}	|| '',
		'Body'		=> $hash{Body}		|| '',
		'template'	=> $hash{template}	|| 'mail-XXXXXX.eml',
	};

	# store the x-headers
	my @xheaders = grep /^X-/, keys %hash;
	foreach my $xhdr (@xheaders) { $atts->{$xhdr} = $hash{$xhdr} }

	# create the object
	bless $atts, $self;
	return $atts;
}

sub DESTROY {}

#----------------------------------------------------------------------------
# The Get & Set Methods Interface Subs

=item Accessor Methods

The following accessor methods are available:

  From
  To
  Cc
  Bcc
  Subject
  Body

All functions can be called to return the current value of the associated
object variable, or be called with a parameter to set a new value for the
object variable.

=cut

sub AUTOLOAD {
	no strict 'refs';
	my $name = $AUTOLOAD;
	$name =~ s/^.*:://;
	die "Unknown sub $AUTOLOAD\n"	unless($autosubs{$name});

	*$name = sub { @_==2 ? $_[0]->{$name} = $_[1] : $_[0]->{$name};	};
	goto &$name;
}

=item XHeader($xheader,$value)

Adds a header in the style of 'X-Header' to the headers of the message.
Returns undef if header cannot be added.

=cut

sub XHeader {
	my ($self,$xheader,$value) = @_;
	return	unless($xheader =~ /^X-/);
	$value ? $self->{$xheader} = $value : $self->{$xheader};
}

=item send()

Sends the message. Returns the filename on success, 0 on failure.

Really just writes to a file.

=cut

sub send {
	my ($self) = @_;

	# create output directory if necessary
	if((my $path = dirname($self->{template})) ne '.') {
        eval { mkpath($path) };
        return  if($@);
    }

	# we need a basic message fields
	return	unless(	$self->{From} &&
					$self->{To} &&
					$self->{Subject} &&
					$self->{Body});

    # use the date we write the file
    my $t = localtime;
    my $date = $t->strftime();

	# Build the message
	my $msg  =  "From: $self->{From}\n" .
		    	"To: $self->{To}\n" .
			    "Subject: $self->{Subject}\n".
                "Date: $date\n";
	$msg .= "Cc: $self->{Cc}\n"				if($self->{Cc});
	$msg .= "Bcc: $self->{Bcc}\n"			if($self->{Bcc});

	# store the x-headers
	my @xheaders = grep /^X-/, keys %$self;
	foreach my $xhdr (@xheaders) { $msg .= "$xhdr: $self->{$xhdr}\n"; }

	$msg .= "\n$self->{Body}\n";

	my ($template,$suffix) = ($self->{template} =~ /(.*)(\.\w+)$/);
	my ($fh, $filename) = tempfile( $template, SUFFIX => $suffix, UNLINK => 0 );
	print $fh $msg;
	undef $fh;

	return $filename;
}

1;

__END__