view release on metacpan or  search on metacpan

lib/Activator/Emailer.pm  view on Meta::CPAN

=item *

The following are used with L<Template::Toolkit>

 * tt_include_path - The INCLUDE_PATH for template toolkit. Useful
                     for reusing project templates within an email

=item *

The following are custom to C<Activator::Emailer>:

 * html_header - A template file or string to use for the top of the
                 HTML portion of the email
 * html_footer - A template file or string to use for the bottom of
                 the HTML portion of the email
 * html_body   - A template file or string to use for the html portion.
                 of the email Also, this will be stripped of all HTML
                 tags ( using HTML::Strip ) and used for the body of
                 the text portion of the email.

=back

=cut

sub new {
    my ( $pkg, %args ) = @_;

    my $config = Activator::Registry->get( 'Activator::Emailer' ) || {};
    my $self = Hash::Merge::merge( \%args, $config );
    bless ( $self ), $pkg;

    $self->{attachments} = [];
    my $args = { mailer => $self->{mailer_type} };
    if ( keys %{ $self->{mailer_args} } ) {
	$args->{mailer_args} = [ %{ $self->{mailer_args} } ];
    }
    $self->{sender} = Email::Send->new( $args );
    return $self;
}

=head2 send( $tt_vars )

Send the email using C<$tt_vars> for the L<Template::Toolkit> C<process> method.

=cut

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

    # TODO: test that tt_vars is a hashref

    $tt_vars->{'Activator_Emailer_format'} = 'text';
    $tt_vars->{html_header} = $self->{html_header};
    $tt_vars->{html_body}   = $self->{html_body};
    $tt_vars->{html_footer} = $self->{html_footer};

    my $text_body = '';
    my $html_body = '';

    my $tt = Template->new( $self->{tt_options} ) ||
      Activator::Exception::Emailer->throw( 'tt_new_error', $Template::ERROR, "\n" );

    $tt->process( $self->{email_wrap}, $tt_vars, \$text_body ) ||
      Activator::Exception::Emailer->throw( 'tt_process_error', $tt->error(), "\n" );

    $tt_vars->{'Activator_Emailer_format'} = 'html';
    $tt->process( $self->{email_wrap}, $tt_vars, \$html_body ) ||
      Activator::Exception::Emailer->throw( 'tt_process_error', $tt->error(), "\n" );

    my @email_args = (
		      From    => $self->{From},
		      To      => $self->{To},
		      Cc      => $self->{Cc},
		      Subject => $self->{Subject},
		      SkipBad => 1,
		     );

    push @email_args, ( Type => 'multipart/alternative' );

    my $email = MIME::Lite->new( @email_args );
    $email->attach(
		   Type => 'TEXT',
		   Data => $text_body,
		  );

    $email->attach(
		   Type => 'text/html',
		   Data => $html_body,
		  );

    foreach my $attachment( @{ $self->{attachments} } ) {
	$email->attach( @$attachment );
    }

    DEBUG("----------------------------------------\nCreated email:\n".
	  $email->as_string .
	  "\n----------------------------------------"
	 );

    try eval {
	my $retval = $self->{sender}->send( $email->as_string);
	die $retval unless $retval;
    };
    if ( catch my $e ) {
	Activator::Exception::Emailer->throw( 'send_error', $e );
    }
}

=head2 attach( %args )

Attach an item to this email. When C<send()> is called, C<%args> is
just passed through to the L<MIME::Lite> attach function.

=cut

sub attach {
    my ( $self, %attachment ) = @_;
    push @{ $self->{attachments} }, [ %attachment ];
}

=head2 valid_email ( $email )

Sanity check on the email address. Throws exception on failure.

=cut

sub valid_email {
    my $addr = shift;   

    #characters allowed on name: 0-9a-Z-._ on host: 0-9a-Z-. on between: @
    return 0 if ( $addr !~ /^[0-9a-zA-Z\.\-\_]+\@[0-9a-zA-Z\.\-]+$/ ); 

    #must start or end with alpha or num
    return 0 if ( $addr =~ /^[^0-9a-zA-Z]|[^0-9a-zA-Z]$/); 

    #name must end with alpha or num
    return 0 if ( $addr !~ /([0-9a-zA-Z]{1})\@./ ); 

    #host must start with alpha or num
    return 0 if ( $addr !~ /.\@([0-9a-zA-Z]{1})/ ); 

    #pair .- or -. or -- or .. not allowed
    return 0 if ( $addr =~ /.\.\-.|.\-\..|.\.\..|.\-\-./g ); 

    #pair ._ or -_ or _. or _- or __ not allowed
    return 0 if ( $addr =~ /.\.\_.|.\-\_.|.\_\..|.\_\-.|.\_\_./g ); 

    #host must end with '.' plus 2, 3 or 4 alpha for TopLevelDomain (MUST be modified in future!)
    return 0 if ( $addr !~ /\.([a-zA-Z]{2,4})$/ ); 

    return 1;
}

=head2 setters

Each value that can be passed to C<new()> can be modified by calling
C<set_E<lt>VALUEE<gt>>, where value is lowercased.

=cut

sub set_from {
    my ( $self, $value ) = @_;
    $self->{From} = $value;
}