File Coverage

blib/lib/Mail/Postfix/Attr.pm

Criterion	Covered	Total	%
statement	88	96	91.6
branch	10	24	41.6
condition	1	3	33.3
subroutine	18	19	94.7
pod	4	16	25.0
total	121	158	76.5

use strict;
use warnings;
package Mail::Postfix::Attr;
{
  $Mail::Postfix::Attr::VERSION = '0.06';
}
# ABSTRACT: encode and decode Postfix attributes

use Carp;


# I do not understand the terminal slash in \0/
# -- rjbs, 2013-01-02
my %codecs = (
  '0'     => [ \&encode_0,     \&decode_0,     q(\0/) ],
  '64'    => [ \&encode_64,    \&decode_64,    q(\n) ],
  'plain' => [ \&encode_plain, \&decode_plain, q(\n) ],
);

sub new {
	my ($class, %args) = @_;
	my $self = bless {}, $class;
	my $codec_ref = $codecs{ $args{codec} } || $codecs{plain};

	$self->{sock_path} = $args{path};
	$self->{inet} = $args{inet};
	$self->{fh} = $args{fh};

	@{$self}{qw(encode decode delimiter)} = @{$codec_ref};

	return $self;
}

sub fh {
  my $self = shift;
  my $fh;
  unless ($self->{fh}) {
    if ( $self->{sock_path} ) {
      require IO::Socket::UNIX;
      $fh = IO::Socket::UNIX->new( $self->{sock_path} );
      $fh or croak "Mail::Postfix::Attr can't connect to '$self->{sock_path}' $!\n";
      $self->{fh} = $fh;
    } elsif ( $self->{inet} ) {
      require IO::Socket::INET;
      $fh = IO::Socket::INET->new( $self->{inet} );
      $fh or croak "Mail::Postfix::Attr can't connect to '$self->{inet}' $!\n";
      $self->{fh} = $fh;
    } elsif ($self->{fh}) {
      $fh = $self->{fh}
    } else {
      croak "must have 'path' or 'inet' or 'fh' set to use send";
    }
  }
  croak "can't find filehandle for $self" unless $self->{fh};
  return $self->{fh};
}


sub send {
  my ($self) = shift;
  $self->write(@_);
  return $self->read;
}

sub write {
  my ($self) = shift;
  $self->raw_write($self->encode(@_));
}

sub raw_write {
  my $self = shift;
  my $fh = $self->fh;
  my $count = syswrite($fh, shift);
  croak "syswrite: error: $!" unless $count;
}

sub read {
  my ($self) = shift;
  return map @$_, $self->decode($self->raw_read);
}

sub raw_read {
  my $self = shift;
  my $fh = $self->fh;
  my $buf;
  my $r = sysread($fh, $buf, 64000);
  die "sysread error: $!" unless defined $r;
  return $buf;
}


sub encode {
  my ($self) = @_;
  goto $self->{encode};
}


sub decode {
  my ($self) = @_;
  goto $self->{decode};
}

sub delimiter {
  my ($self) = @_;
  return $self->{delimiter};
}

sub encode_0 {
  my ($self) = shift;
  my $attr_text;
  while (my ($attr, $val) = splice(@_, 0, 2)) {
    $val = "" unless defined $val;
    $attr_text .= "$attr\0$val\0";
  }
  return "$attr_text\0";
}

sub encode_64 {
  my ($self) = shift;
  my $attr_text;
  require MIME::Base64;
  while (my ($attr, $val) = splice(@_, 0, 2)) {
    $val = "" unless defined $val;
    $attr_text .= MIME::Base64::encode_base64( $attr, '' ) . ':' .
      MIME::Base64::encode_base64( $val, '' ) . "\n";
  }
  return "$attr_text\n";
}

sub encode_plain {
  my ($self) = shift;
  my $attr_text;
  while (my ($attr, $val) = splice(@_, 0, 2)) {
    $val = "" unless defined $val;
    $attr_text .= "$attr=$val\n";
  }
  return "$attr_text\n";
}

sub decode_0 {
  my ($self, $text) = @_;
  my @attrs;
  # the lookahead avoids a situation where (x => "") is
  # encoded as "x\0\0\0" but then decoded into [ "x" ], []
  foreach my $section ( split /(?<=\0\0)(?!\0)/, $text ) {
    # count is here to make sure that trailing attributes with empty values are correctly given
    # previously (a => 1, b => 2, c => "") would come out as [ "a", 1, "b", 2, "c" ]
    my $count = ($section =~ tr/\0//) - 1;
    $section = substr($section, 0, length($section) - 2);
    push( @attrs, [ split /\0/, $section, $count ] );
  }
  return @attrs;
}

sub decode_64 {
  my ($self, $text) = @_;
  require MIME::Base64;
  my @attrs;
  foreach my $section (split /(?<=\n\n)/, $text) {
    push (@attrs, [ map MIME::Base64::decode_base64 $_,
		    $section =~ /^([^:]+):(.+)$/mg ]);
  }
  return @attrs;
}

sub decode_plain {
  my ($self, $text) = @_;
  my @attrs;
  foreach my $section (split /(?<=\n\n)/, $text) {
    push (@attrs, [ map { split /=/, $_, 2 } split /\n/, $section ]);
  }
  return @attrs;
}

1;

__END__