File Coverage

blib/lib/Email/Simple/Test/TraceHeaders.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	11	12	91.6
condition			n/a
subroutine	13	13	100.0
pod	2	2	100.0
total	75	76	98.6

use strict;
use warnings;
package Email::Simple::Test::TraceHeaders;
{
  $Email::Simple::Test::TraceHeaders::VERSION = '0.091702';
}
# ABSTRACT: generate sample trace headers for testing

use Carp ();
use Email::Date::Format ();
use Email::Simple;
use Email::Simple::Creator;
use Sub::Exporter::Util ();

use Sub::Exporter -setup => {
  exports => [ prev    => \'_build_prev' ],
  groups  => [ helpers => [ qw(prev) ] ],
};

# For now, we'll only generate one style of Received header: postfix
# It's what I encounter the most, and it's simple and straightforward.
# In the future, we'll be flexible, maybe. -- rjbs, 2009-06-19
my %POSTFIX_FMT = (
  for   => q{from %s (%s [%s]) by %s (Postfix) with ESMTP id %s for <%s>; %s},
  nofor => q{from %s (%s [%s]) by %s (Postfix) with ESMTP id %s%s; %s},
);


sub trace_headers {
  my ($self, $arg) = @_;

  Carp::confess("no hops provided") unless $arg->{hops};

  my @received;
  my %last;
  for my $hop (@{ $arg->{hops} }) {
    my %hop = (%$hop);

    for my $key (keys %hop) {
      if (ref $hop->{$key} eq 'CODE') {
        $hop{ $key } = $hop{$key}->(\%last);
      }
    }

    my $env_to = ref $hop{env_to} ?   $hop{env_to}
               :     $hop{env_to} ? [ $hop{env_to} ]
               :                    [              ];

    my $fmt = @$env_to == 1 ? $POSTFIX_FMT{for} : $POSTFIX_FMT{nofor};

    push @received, sprintf $fmt,
      $hop{from_helo},
      $hop{from_rdns},
      $hop{from_ip},
      $hop{by_name}, # by_ip someday?
      $hop{queue_id},
      @$env_to == 1 ? $env_to->[0] : '',
      (Email::Date::Format::email_gmdate($hop{time}) . ' (GMT)');

    %last = %hop;
  }

  return [ reverse @received ];
}


sub create_email {
  my ($self, $arg) = @_;

  my $email = Email::Simple->create(
    header => [
      (map {; Received => $_ } @{ $self->trace_headers($arg) }),

      From => '"X. Ample" ',
      To   => '"E. Xampe" ',
    ],
    body    => "This is a test message.\n",
  );

  return $email;
}


sub _build_prev {
  my ($self) = @_;

  sub {
    my ($name) = @_;

    sub {
      my ($last) = @_;
      $last->{ $name };
    }
  }
}

1;

__END__