File Coverage

blib/lib/Net/SMTP/IPMM.pm

Criterion	Covered	Total	%
statement	12	56	21.4
branch	0	22	0.0
condition	0	3	0.0
subroutine	4	14	28.5
pod	4	4	100.0
total	20	99	20.2

package Net::SMTP::IPMM;

use strict;
use warnings;

use base 'Net::SMTP';

# import CMD_* constants
use Net::Cmd;

our $VERSION = '0.03';

sub ackrcpt {
    my ( $self, $command ) = @_;

    # object is a globref
    ${ *$self }{ipmm_ackrcpt} = $command ? 1 : 0;

    $self->_ACKRCPT( $command ? 'on' : 'off' );
}

sub xmrg {
    my ( $self, $address ) = @_;
    my $sender = $self->_addr( $address );

    $self->_XMRG( $sender );
}

sub xdfn {
    my $self = shift;
    my %args = @_;

    my $command = '*PARTS="' . delete( $args{ 'PARTS' } ) . '"';
    while ( my ( $key, $value ) = each %args ) {
	$command .= " $key=\"$value\"";
    }

    $self->_XDFN( $command );
}

sub xprt {
    my ( $self, @parts ) = @_;

    my $count = @parts;
    my $i = 1;

    foreach my $part( @parts ) {
	my $command = $i;
	$command .= ' LAST' if $i == $count;

	$self->_XPRT( $command )   or return;
	$self->datasend( $part )   or return;

	$i++;
    }

    $self->dataend;
}

# _addr isn't in our contract, so we define it since it may change
# between releases.  For example, see the difference between Net::SMTP
# 2.24 and 2.26.
sub _addr {
    my $self = shift;
    my $addr = shift;
    $addr = "" unless defined $addr;

    if ( ${ *$self }{net_smtp_exact_addr} ) {
	return $1 if $addr =~ /^\s*(<.*>)\s*$/s;
    }
    else {
	return $1 if $addr =~ /(<[^>]*>)/;
	$addr =~ s/^\s+|\s+$//sg;
    }

    "<$addr>";
}

sub _ACKRCPT { shift->command( "XLSMTP-ACKRCPT", @_ )->response == CMD_OK   }
sub _XMRG    { shift->command( "XMRG FROM:"    , @_ )->response == CMD_OK   }
sub _XDFN    { shift->command( "XDFN",           @_ )->response == CMD_OK   }

# XPRT returns OK on the first part and MORE on subsequent parts
# for no reason that I can figure out.
sub _XPRT    {
    my $r = shift->command( "XPRT", @_ )->response;
    return 1 if ( $r == CMD_OK ) or ( $r == CMD_MORE );
    return;
}


sub _RCPT {
    my $self = shift;

    if( ${ *$self }{ipmm_ackrcpt} ) {
	return $self->command( "RCPT", @_ )->response == CMD_OK;
    } else {
	return $self->command( "RCPT", @_ );
    }

    return undef;
}


1;

__END__