view release on metacpan or  search on metacpan

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

		      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;
}

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

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

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

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

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

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

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