Mail::Qmail::Queue::Send - Send a message to a program implementing the qmail-queue interface

  use Mail::Qmail::Queue::Send;

  my $qq = Mail::Qmail::Queue::Send->new()
      or die "Couldn't create qmail-queue sender: $!\n";

  $qq_send->body("Test message\n")
      or die "Couldn't write body: $!\n";

  $qq_send->from('sgifford@suspectclass.com')
      or die "Couldn't write envelope from: $!\n";
  $qq_send->to('GIFF@cpan.org')
      or die "Couldn't write envelope to #1: $!\n";
  $qq_send->to('gifford@umich.edu')
      or die "Couldn't write envelope to #2: $!\n";
  $qq_send->envelope_done()
      or die "Couldn't finish writing envelope: $!\n";

  $qq_send->wait_exitstatus() == 0
      or die "Error sending message: exit status $?\n";

package Mail::Qmail::Queue::Send;
our $VERSION = 0.02;
#
# Copyright 2006 Scott Gifford
#
# This library is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

use warnings;
use strict;

use constant DEFAULT_QMAIL_QUEUE => '/var/qmail/bin/qmail-queue';
use constant QQ_ENV_FD => 1;
use constant QQ_BODY_FD => 0;

use POSIX;
use FileHandle;

use Mail::Qmail::Queue::Error qw(:errcodes :fail);

sub new
{
    my $class = shift;
    my %o = @_;
    my $self = bless {}, $class;
    
    my $qq_path = $o{QmailQueue} || $ENV{QMAILQUEUE} || DEFAULT_QMAIL_QUEUE;
    $self->{_qq_pid} = $self->_start_qmail_queue($qq_path,\%o)
	or tempfail QQ_EXIT_NETFAIL, "Couldn't start up '$qq_path': $!\n";
    $self;
}

sub send
{
    my $self = shift;
    $self->body(shift)
	or return undef;
    $self->from(shift)
	or return undef;
    $self->to(@_)
	or return undef;
    $self->envelope_done
	or return undef;
    return $self->wait_exitstatus;
}

sub body_fh
{
    my $self = shift;
    return $self->{_msg_fh};
}

sub body_close
{
    my $self = shift;

    $self->{_body_sent}=1;
    return close($self->{_msg_fh});
}

sub body
{
    my $self = shift;
    my $fh = $self->{_msg_fh}
        or tempfail QQ_EXIT_BUG,"Body filehandle not available!";
    print $fh @_
	or tempfail QQ_EXIT_WRITEERR,"Write error: $!\n";
    $self->body_close()
	or tempfail QQ_EXIT_WRITEERR,"Error closing write pipe: $!\n";
    return 1;
}

sub from
{
    my $self = shift;

    my($from)=@_;
    $self->{_from}=$from;
    $self->put_envelope_entry('F'.$from);
}

sub to
{
    my $self = shift;
    defined($self->{_from})
	or tempfail QQ_EXIT_BUG,"envelope from must be set before envelope to\n";
    $self->put_envelope_entry(map { 'T'.$_ } @_);
}

sub envelope_done
{
    my $self = shift;
    $self->put_envelope_entry('')
	or return undef;
    my $fh = $self->{_env_fh}
        or tempfail QQ_EXIT_BUG, "No envelope filehandle\n";
    close($fh)
	or tempfail QQ_EXIT_WRITEERR,"Error closing envelope filehandle: $!\n";
    return 1;
}

sub put_envelope_entry
{
    my $self = shift;

    $self->envelope_write(join("\0",@_)."\0");
}

sub envelope_write
{
    my $self = shift;
    my $fh = $self->{_env_fh}
        or tempfail QQ_EXIT_BUG, "No envelope filehandle\n";
    return print $fh @_;
}

sub envelope_fh
{
    my $self = shift;
    return $self->{_env_fh};
}

sub wait_exitstatus
{
    my $self = shift;

    $self->wait;
    if ($? == 0)
    {
	return 0;
    }
    elsif ($? >> 8)
    {
	return $? >> 8;
    }
    else
    {
	return QQ_EXIT_BUG;
    }
}

sub wait
{
    my $self = shift;
    waitpid($self->{_qq_pid},@_);
}

sub _start_qmail_queue
{
    my $self = shift;
    my($path,$o)=@_;
    my(@env_pipe,@body_pipe);
    
    unless ($o->{LeaveEnvHandle})
    {
	@env_pipe = POSIX::pipe()
	    or tempfail QQ_EXIT_WRITEERR, "Couldn't create envelope pipe: $!\n";
    }
    unless ($o->{LeaveMsgHandle})
    {
	@body_pipe = POSIX::pipe()
	    or tempfail QQ_EXIT_WRITEERR, "Couldn't create envelope pipe: $!\n";
    }
    
    my $f = fork();

    if (!defined($f))
    {
	tempfail QQ_EXIT_TEMPREFUSE, "Fork failed: $!\n";
    }
    elsif ($f)
    {
	# Parent
	if (@body_pipe)
	{
	    POSIX::close($body_pipe[0])
		or tempfail QQ_EXIT_READERR, "Couldn't close body pipe reader in parent: $!\n";
	    $self->{_msg_fh} = FileHandle->new_from_fd($body_pipe[1],"w")
		or tempfail QQ_EXIT_READERR, "Couldn't create FileHandle for body writer fd $body_pipe[1] in parent: $!\n";
	}
	if (@env_pipe)
	{
	    POSIX::close($env_pipe[0])
		or tempfail QQ_EXIT_READERR, "Couldn't close envelope pipe reader in parent: $!\n";
	    $self->{_env_fh} = FileHandle->new_from_fd($env_pipe[1],"w")
		or tempfail QQ_EXIT_READERR, "Couldn't create FileHandle for envelope pipe writer fd $env_pipe[1] in parent: $!\n";
	}
	return $f;
    }
    else
    {
	# Child
	if (@body_pipe)
	{
	    POSIX::close($body_pipe[1])
		or tempfail QQ_EXIT_WRITEERR, "Couldn't close body pipe writer in child: $!\n";
            POSIX::close(QQ_BODY_FD); # Ignore errors
	    POSIX::dup2($body_pipe[0],QQ_BODY_FD)
		or tempfail QQ_EXIT_WRITEERR, "Couldn't dup body pipe reader to fd 1 in child: $!\n";
	    POSIX::close($body_pipe[0])
		or tempfail QQ_EXIT_WRITEERR, "Couldn't close body pipe reader after dup in child: $!\n";
	}
	if (@env_pipe)
	{
	    POSIX::close($env_pipe[1])
		or tempfail QQ_EXIT_WRITEERR, "Couldn't close envelope pipe writer in child: $!\n";
            POSIX::close(QQ_ENV_FD); # Ignore errors
	    POSIX::dup2($env_pipe[0],QQ_ENV_FD)
		or tempfail QQ_EXIT_WRITEERR, "Couldn't dup envelope pipe reader to fd 0 in child: $!\n";
	    POSIX::close($env_pipe[0])
		or tempfail QQ_EXIT_WRITEERR, "Couldn't close envelope pipe reader after dup in child: $!\n";
	}
	exec($path)
	    or tempfail QQ_EXIT_TEMPREFUSE, "exec failed: $!\n";
    }
}

1;