package Sietima::Role::Headers;
use Moo::Role;
use Try::Tiny;
use Sietima::Policy;
use Types::Standard qw(Str);
use namespace::clean;

# VERSION
# ABSTRACT: adds standard list-related headers to messages

=head1 SYNOPSIS

  my $sietima = Sietima->with_traits('Headers')->new({
   %args,
   name => $name_of_the_list,
  });

=head1 DESCRIPTION

A L<< C<Sietima> >> list with this role applied will add, to each
outgoing message, the set of headers defined in RFC 2919 and RFC 2369.

This role uses the L<< C<list_addresses>|Sietima/list_addresses >>
method to determine what headers to add.

If the C<name> attribute is set, a C<List-Id:> header will be added,
with a value built out of the name and the C<<
$self->list_addresses->{return_path} >> value (which is normally the
same as the L<< C<return_path>|Sietima/return_path >> attribute).

Other C<List-*:> headers are built from the other values in the
C<list_addresses> hashref. Those values can either be L<<
C<Email::Address> >> objects (in which case the header will have a
C<mailto:> URI as value) or strings (which will be used literally for
the value of the header).

=attr C<name>

Optional string, the name of the mailing list. If this attribute is
set, a C<List-Id:> header will be added, with a value built out of the
name and the C<< $self->list_addresses->{return_path} >> value (which
is normally the same as the L<< C<return_path>|Sietima/return_path >>
attribute).

=cut

has name => (
    isa => Str,
    is => 'ro',
    required => 0,
);

sub _add_headers_to($self,$message) {
    my $addresses = $self->list_addresses;
    my $mail = $message->mail;

    # see RFC 2919 "List-Id: A Structured Field and Namespace for the
    # Identification of Mailing Lists"
    my $return_path = delete $addresses->{return_path};
    if (my $name = $self->name) {
        $mail->header_str_set(
            'List-Id',
            sprintf '%s <%s>', $name,$return_path->address =~ s{\@}{.}r,
        );
    }

    # if nobody declared a "post" address, let's guess it's the same
    # as the address we send from
    $addresses->{post} //= $return_path;

    for my $name (sort keys $addresses->%*) {
        my $header_name = 'List-' . ucfirst($name =~ s{[^[:alnum:]]+}{-}gr);
        my $address = $addresses->{$name};

        # if it's not an Email::Address obect, we'll just take it as a
        # string: it could be a non-mailto URI, see RFC 2369 "The Use
        # of URLs as Meta-Syntax for Core Mail List Commands and their
        # Transport through Message Header Fields"

        $mail->header_str_set(
            $header_name => try {
                sprintf '<mailto:%s>',$address->address
            } catch { "<$address>" },
        );
    }
    return;
}

=modif C<munge_mail>

This method adds list-management headers to each message returned by
the original method.

=cut

around munge_mail => sub ($orig,$self,$mail) {
    my @messages = $self->$orig($mail);
    $self->_add_headers_to($_) for @messages;
    return @messages;
};

1;