Qmail::Envelope - Perl module modifying qmail envelope strings.

  use Qmail::Envelope;

  ## When you have received the envelope from qmail-smtpd
  my $E = Qmail::Envelope->new (data => $Envelope);

  ## or if you want to create one on the fly ...
  my $E = Qmail::Envelope->new();

  ## add a recipient
  $E->add_recip('foo@bar.com');

  ## remove a recipient
  $E->remove_recip('foo@ack.com');

  ## remove all recipients for a specific domain
  $E->remove_recips_for_host('quux.com');

  ## clear the entire recipient list
  $E->remove_all_recips;

  ## get ref to an array containing the list of hosts in the envelope
  my $host_list = $E->rcpt_hosts;

  ## get envelope sender
  my $sender = $E->sender;

  ## set envelope sender 
  $E->sender('blarch@chunk.com');

  ## get the total number of recipients in the envelope.
  ## duplicates are counted.
  my $number_of_recips = $E->total_recips;

  ## get the total numbers of recips for a specific host
  my $number_of_recips = $E->total_recips_for_host('frobnicate.com');

  ## remove duplicate recipient entries in the envelope
  $E->remove_duplicate_recips;

  ## pretty print the envelope
  print $E->as_string;

  ## complete formatted envelope, with terminating null bytes and all.
  my $envelope = $E->gen;

package Qmail::Envelope;
use strict;

use vars qw/$VERSION/;
$VERSION = '0.53';


## constructor
sub new {
    my $class = shift;
    my $self = {
        data   => '',
        recips => '',
        sender => '',
        @_
    };

    bless($self, $class);

    $self->{'sender'} = '';
    $self->{'recips'} = [];
    $self->{'rcpt_hosts'} = {};
    $self->{'recips_map'} = {};

    if ($self->{'data'}) {
        $self->init_envelope_data;
    }

    return $self;

}

## if the constructor is called with the 'data' attribute defined ...
sub init_envelope_data {
    my $self = shift;

    ## elegant rewrite by Peter Pentchev -- thanks!
    return 0 unless $self->{'data'} =~ /^F([^\0]+)\0T(.*?)\0\0/;
    my ($sender, @recips) = ($1, split(/\0T/, $2));

    $self->{'sender'} = $sender;
    $self->{'recips'} = [ @recips ];

    $self->map_recips;

}

sub add_recip {
    my $self = shift;
    push (@{$self->{'recips'}}, shift());
    $self->map_recips;
}

sub remove_recip {
    my $self = shift;
    my $recip = shift;

    my $new_recips = [];
    foreach my $r (@{$self->{'recips'}}) {
        next if ($r eq $recip);
        push (@$new_recips, $r);
    }

    $self->{'recips'} = $new_recips;
    $self->map_recips;

}

sub remove_recips_for_host {
    my $self = shift;
    my $rcpt_host = shift;

    my $new_recips = [];
    foreach my $r (@{$self->{'recips'}}) {
        $r =~ /^.*@(\S+)$/io;
        next if ($1 eq $rcpt_host);

        push (@$new_recips, $r);

    }

    $self->{'recips'} = $new_recips;

    $self->map_recips;

}

sub remove_all_recips {
    my $self = shift;
    $self->{'recips_map'} = {};
    $self->{'recips'} = [];
    $self->{'rcpt_hosts'} = {};
}


sub map_recips {
    my $self = shift;

    ## maps instances of a recipient within the 'recips' array
    $self->{'recips_map'} = {};

    ## maps instances of a host in the 'recips' array
    $self->{'rcpt_hosts'} = {};

    my $index = 0;

    foreach my $r (@{$self->{'recips'}}) {

        if (exists($self->{'recips_map'}->{$r})) {
            push(@{$self->{'recips_map'}->{$r}}, $index);
        }

        else {
            $self->{'recips_map'}->{$r}->[0] = $index;
        }

        ## pull off the host
        $r =~ /^.*@(\S+)$/io;

        unless ($self->{'rcpt_hosts'}->{$1}) {
            $self->{'rcpt_hosts'}->{$1} = [];
        }

        push(@{$self->{'rcpt_hosts'}->{$1}}, $index);

        $index++;
    }
}

sub gen {

    my $self = shift;
    my $e = 'F' . $self->{'sender'} . "\0";

    foreach my $r (@{$self->{'recips'}}) {
        $e .= 'T' . $r . "\0";
    }

    $e .= "\0";

    return $e;

}

sub as_string {

    my $self = shift;
    my $e = 'F' . $self->{'sender'};

    foreach my $r (@{$self->{'recips'}}) {
        $e .= 'T' . $r;
    }

    return $e;

}

sub rcpt_hosts {
    return [ keys %{ shift()->{'rcpt_hosts'} }];
}


sub sender {
    my $self = shift;
    my $sender = shift || '';

    return $self->{'sender'} unless ($sender);

    $self->{'sender'} = $sender;
}

sub total_recips {
    return scalar(@{ shift()->{'recips'} });
}

sub total_recips_for_host {
    my $self = shift;
    return scalar(@{ $self->{'rcpt_hosts'}->{shift()} });
}

sub remove_duplicate_recips {
    my $self = shift;

    my $recip_hash = {};

    foreach my $r (@{$self->{'recips'}}) {
        $recip_hash->{$r} = 1;
    }

    $self->{'recips'} = keys %$recip_hash;

    $self->map_recips;
}


1;
__END__