File Coverage

blib/lib/POE/Filter/Postfix.pm

Criterion	Covered	Total	%
statement	37	51	72.5
branch	3	6	50.0
condition	0	9	0.0
subroutine	14	19	73.6
pod	13	13	100.0
total	67	98	68.3

use strict;
use warnings;

package POE::Filter::Postfix;
our $VERSION = '0.003';


# ABSTRACT: Postfix (MTA) text attribute communication
use base qw(POE::Filter);

sub _abstract {
  my $name = shift;
  eval sprintf <<'', ($name) x 2;
sub %s {
  my $class = ref($_[0]) || $_[0];
  require Carp;
  Carp::croak("$class must override %s()");
}

}

BEGIN {
  _abstract($_) for qw(
    attribute_separator
    attribute_terminator
    request_terminator
  )
}


sub new {
  my $class = shift;
  bless {
    @_,
    buffer => '',
  } => $class;
}


sub clone {
  my $self = shift;
  $self->new(%$self);
}


sub get_one_start {
  my ($self, $buf) = @_;
  $self->{buffer} .= $_ for @$buf;
}


sub get_one {
  my ($self) = @_;
  my %attr;
  my $buf = $self->{buffer};
  my ($a_s, $a_t, $r_t) = (
    $self->attribute_separator,
    $self->attribute_terminator,
    $self->request_terminator,
  );
  while ($buf =~ s/^([^$r_t]+?)\Q$a_s\E//) {
    my $key = $self->decode_key("$1");
    $buf =~ s/^([^$r_t]*)?\Q$a_t\E// or return [];
    $attr{$key} = $self->decode_value("$1");
  }
  return [] unless $buf =~ s/^\Q$r_t\E//;
  $self->{buffer} = $buf;
  return [ \%attr ];
}


sub get_pending {
  my ($self) = @_;
  return [ $self->{buffer} ] if length $self->{buffer};
  return undef;
}


sub decode_key   { $_[1] }
sub decode_value { $_[1] }


sub put {
  my ($self, $chunks) = @_;

  return [ map { $self->_encode($_) } @$chunks ];
}

sub _encode {
  my ($self, $attr) = @_;
  return join $self->attribute_terminator,
    (map {
      join $self->attribute_separator,
        $self->encode_key($_),
        $self->encode_value($attr->{$_})
    } keys %$attr),
    $self->request_terminator;
}


sub encode_key   { $_[1] }
sub encode_value { $_[1] }


1;


__END__