package Net::SMTP::IPMM;

use strict;
use warnings;

use base 'Net::SMTP';

# import CMD_* constants
use Net::Cmd;

our $VERSION = '0.02';

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__


=head1 NAME

Net::SMTP::IPMM - IronPort Mail-Merge interface

=head1 VERSION

Version 0.01

=head1 SYNOPSIS

    use Net::SMTP::IPMM;
    my $ipmm = Net::SMTP::IPMM->new( 'ipmmhost' );

    # define parts
    my $part1 = "From: me\@mydomain.org\n" .
                "To: &*TO;\n" .
                "Subject: This is a message\n\n" .
                "Dear &FNAME;,\n";
         
    my $part2 = "Your last name is &LNAME;.\n"; 

    # from addresss
    $self->xmrg( 'me@mydomain.com' );

    # first person, both parts
    $self->xdfn( parts => "1,2", 
                 fname => "Some",
                 lname => "Guy", );
    $self->to( 'someguy@example.com' );

    # second person, first part only
    $self->xdfn( parts => "1", 
                 fname => "Another",
                 lname => "Guy", );
    $self->to( 'anotherguy@somewhereelse.com' );

    # send the parts.
    $self->xprt( $part1, $part2 );


=head1 METHODS

=over 2

=item new 

Constructor. Pass the hostname of the IronPort as the first parameter:

    my $ipmm = Net::SMTP::IPMM->new( 'ironport.foo.com' );

For additional configuration options see the docs for L<Net::SMTP>.

=item ackrcpt( BOOL )

Turn RCPT acknowledgements on or off.  Off means less traffic and 
higher performance (which is probably why you bought an IronPort).
Pass any true value to turn RCPT acknowledgements on, false for off.

=item xmrg( ADDRESS )
 
This sends an XMRG FROM command (replacing MAIL FROM from regular SMTP.)
You must use this method to tell the IronPort that mail-merge data is coming.

    $ipmm->xmrg( 'me@mydomain.com' );

=item xdfn( PARTS => PART_NUMBERS,
            key   => value,
            key   => value,
            ...  )

This sends an XDFN command. XDFN is used to send each recipient's data to 
the IronPort. PART_NUMBERS is a string containing a comma-separated list
of "parts" for the recipient. The key/value pairs will be substituted
into the message by the IronPort. Note that message parts are not 
zero-indexed (the first one is "1".)

    $ipmm->xdfn( PARTS => "1,2,5",
                 fname => 'Mike',
                 lname => 'Friedman',
                 zip   => '11106' );
    $ipmm->to( 'mfriedman@plusthree.com' );

=item xprt( MESSAGE_PARTS )

This sends all the message parts to the IronPort and begins the mailing.
MESSAGE_PARTS is a list of strings containing the message parts with
the appropriate variables in them.

    my $part1 = "From: sender\@mydomain.org$CRLF" .
                "To: &*TO;$CRLF" .
                "Subject: message$CRLF$CRLF" .
                "Dear &FNAME;,$CRLF";

    my $part2 = "Your last name is &LNAME;.$CRLF";

    $ipmm->xprt( $part1, $part2 );


=back

=head1 THANKS

Thanks to Douglas Hunter for doing most of the work. :) 

=head1 AUTHORS

Mike Friedman C<< <mfriedman@plusthree.com> >>

Douglas Hunter, C<< <dug@plusthree.com> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-net-smtp-ipmm@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-SMTP-IPMM>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 COPYRIGHT & LICENSE

Copyright 2005 PlusThree LP, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut


