File Coverage

blib/lib/Sietima/Role/SubjectTag.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package Sietima::Role::SubjectTag;
2 1     1   464 use Moo::Role;
  1         2  
  1         7  
3 1     1   327 use Sietima::Policy;
  1         2  
  1         6  
4 1     1   6 use Types::Standard qw(Str);
  1         3  
  1         14  
5 1     1   809 use namespace::clean;
  1         2  
  1         8  
6              
7             our $VERSION = '1.0.3'; # VERSION
8             # ABSTRACT: add a tag to messages' subjects
9              
10              
11             has subject_tag => (
12             is => 'ro',
13             isa => Str,
14             required => 1,
15             );
16              
17              
18             around munge_mail => sub ($orig,$self,$mail) {
19             my $tag = '['.$self->subject_tag.']';
20             my $subject = $mail->header_str('Subject');
21             unless ($subject =~ m{\Q$tag\E}) {
22             $mail->header_str_set(
23             Subject => "$tag $subject",
24             );
25             }
26             return $self->$orig($mail);
27             };
28              
29             1;
30              
31             __END__
32              
33             =pod
34              
35             =encoding UTF-8
36              
37             =head1 NAME
38              
39             Sietima::Role::SubjectTag - add a tag to messages' subjects
40              
41             =head1 VERSION
42              
43             version 1.0.3
44              
45             =head1 SYNOPSIS
46              
47             my $sietima = Sietima->with_traits('SubjectTag')->new({
48             %args,
49             subject_tag => 'foo',
50             });
51              
52             =head1 DESCRIPTION
53              
54             A L<< C<Sietima> >> list with this role applied will prepend the given
55             tag to every outgoing message's C<Subject:> header.
56              
57             =head1 ATTRIBUTES
58              
59             =head2 C<subject_tag>
60              
61             Required string. This string, enclosed by square brackets, will be
62             prepended to the C<Subject:> header of outgoing messages. For example,
63             the code in the L</synopsis> would cause an incoming message with
64             subject "new stuff" to be sent out with subject "[foo] new stuff".
65              
66             If the incoming message's C<Subject:> header already contains the tag,
67             the header will not be modified. This prevents getting subjects like
68             "[foo] Re: [foo] Re: [foo] new stuff".
69              
70             =head1 MODIFIED METHODS
71              
72             =head2 C<munge_mail>
73              
74             The subject of the incoming email is modified to add the tag (unless
75             it's already there). The email is then processed normally.
76              
77             =head1 AUTHOR
78              
79             Gianni Ceccarelli <dakkar@thenautilus.net>
80              
81             =head1 COPYRIGHT AND LICENSE
82              
83             This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>.
84              
85             This is free software; you can redistribute it and/or modify it under
86             the same terms as the Perl 5 programming language system itself.
87              
88             =cut