lib/Sietima/Role/Headers.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

package Sietima::Role::Headers; 
use Moo::Role;
use Try::Tiny;
use Sietima::Policy;
use Types::Standard qw(Str);
use namespace::clean;
 
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,
        );
    }
 
    # little renaming 
    $addresses->{owner} = delete $addresses->{admin};
 
    # 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;
}
 
around munge_mail => sub ($orig,$self,$mail) {
    my @messages = $self->$orig($mail);
    $self->_add_headers_to($_) for @messages;
    return @messages;
};
 
1;