package Sietima::Role::Headers;
use Moo::Role;
use Try::Tiny;
use Sietima::Policy;
use Sietima::HeaderURI;
use Email::Address;
use Types::Standard qw(Str);
use Sietima::Types qw(HeaderUriFromThings);
use namespace::clean;
our $VERSION = '1.0.5';
has name => (
isa => Str,
is => 'ro',
required => 0,
);
sub _normalise_address($self,$address) {
my @items = ref($address) eq 'ARRAY' ? $address->@* : $address;
return map {
HeaderUriFromThings->coerce($_)
} @items;
}
sub _set_header($self,$mail,$name,$value) {
my $header_name = 'List-' . ucfirst($name =~ s{[^[:alnum:]]+}{-}gr);
my @items = $self->_normalise_address($value);
$mail->header_raw_set(
$header_name => join ', ', map { $_->as_header_raw } @items,
);
}
sub _add_headers_to($self,$message) {
my $addresses = $self->list_addresses;
my $mail = $message->mail;
my $return_path = delete $addresses->{return_path};
if (my $name = $self->name) {
$mail->header_raw_set(
'List-Id',
sprintf '%s <%s>', $name,$return_path->address =~ s{\@}{.}r,
);
}
if (not exists $addresses->{post}) {
$self->_set_header( $mail, post => $return_path );
}
elsif (not $addresses->{post}) {
delete $addresses->{post};
$mail->header_raw_set('List-Post','NO');
}
for my $name (sort keys $addresses->%*) {
$self->_set_header( $mail, $name => $addresses->{$name} );
}
return;
}
around munge_mail => sub ($orig,$self,$mail) {
my @messages = $self->$orig($mail);
$self->_add_headers_to($_) for @messages;
return @messages;
};
1;
__END__