diff options
author | dakkar <dakkar@thenautilus.net> | 2017-03-24 16:25:53 +0000 |
---|---|---|
committer | dakkar <dakkar@thenautilus.net> | 2017-03-24 16:25:53 +0000 |
commit | 7f40cd0feda1e73cb79ac800762d19f4d5699a7b (patch) | |
tree | 3e6e9282e8c2d20120b2aab198887ef54d5331a6 /lib | |
parent | updated presentation (diff) | |
download | Sietima-7f40cd0feda1e73cb79ac800762d19f4d5699a7b.tar.gz Sietima-7f40cd0feda1e73cb79ac800762d19f4d5699a7b.tar.bz2 Sietima-7f40cd0feda1e73cb79ac800762d19f4d5699a7b.zip |
fix list headers
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Sietima/HeaderURI.pm | 83 | ||||
-rw-r--r-- | lib/Sietima/Role/Headers.pm | 26 | ||||
-rw-r--r-- | lib/Sietima/Role/ManualSubscription.pm | 17 | ||||
-rw-r--r-- | lib/Sietima/Types.pm | 9 |
4 files changed, 115 insertions, 20 deletions
diff --git a/lib/Sietima/HeaderURI.pm b/lib/Sietima/HeaderURI.pm new file mode 100644 index 0000000..d9c1bb0 --- /dev/null +++ b/lib/Sietima/HeaderURI.pm @@ -0,0 +1,83 @@ +package Sietima::HeaderURI; +use Moo; +use Sietima::Policy; +use Sietima::Types qw(Address AddressFromStr is_Address); +use Types::Standard qw(Str ClassName HashRef Optional); +use Type::Params qw(compile); +use Types::URI qw(Uri is_Uri); +use namespace::clean; + +has uri => ( + is => 'ro', + isa => Uri, + required => 1, + coerce => 1, +); + +has comment => ( + is => 'ro', + isa => Str, +); + +# 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" + +around BUILDARGS => sub { + my ($orig, $class, @args) = @_; + if (@args != 1 or ref($args[0]) eq 'HASH') { + return $class->$orig(@args); + } + + my $item = $args[0]; + if (is_Address($item)) { + return Sietima::HeaderURI->_args_from_address($item); + } + elsif (is_Uri($item)) { + return { uri => $item }; + } + elsif (my $address = AddressFromStr->coerce($item)) { + return Sietima::HeaderURI->_args_from_address($address); + } + else { + return { uri => $item }; + }; +}; + +sub _args_from_address { + my ($class, $address, $query) = @_; + $query ||= {}; + + my $uri = URI->new($address->address,'mailto'); + $uri->query_form($query->%*); + + return { + uri => $uri, + comment => $address->comment, + }; +} + +sub new_from_address { + state $check = compile( + ClassName, + Address->plus_coercions(AddressFromStr), + Optional[HashRef], + ); + my ($class, $address, $query) = $check->(@_); + + return $class->new($class->_args_from_address($address,$query)); +} + +sub as_header_raw { + my ($self) = @_; + + my $str = sprintf '<%s>',$self->uri; + if (my $c = $self->comment) { + $str .= ' '.$c; + } + + return $str; +} + +1; diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm index a1aa566..fe3f8a5 100644 --- a/lib/Sietima/Role/Headers.pm +++ b/lib/Sietima/Role/Headers.pm @@ -2,7 +2,10 @@ 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; # VERSION @@ -50,6 +53,14 @@ has name => ( required => 0, ); +sub _normalise_address($self,$address) { + my @items = ref($address) eq 'ARRAY' ? $address->@* : $address; + + return map { + HeaderUriFromThings->coerce($_) + } @items; +} + sub _add_headers_to($self,$message) { my $addresses = $self->list_addresses; my $mail = $message->mail; @@ -58,7 +69,7 @@ sub _add_headers_to($self,$message) { # Identification of Mailing Lists" my $return_path = delete $addresses->{return_path}; if (my $name = $self->name) { - $mail->header_str_set( + $mail->header_raw_set( 'List-Id', sprintf '%s <%s>', $name,$return_path->address =~ s{\@}{.}r, ); @@ -70,17 +81,10 @@ sub _add_headers_to($self,$message) { 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" + my @items = $self->_normalise_address($addresses->{$name}); - $mail->header_str_set( - $header_name => try { - sprintf '<mailto:%s>',$address->address - } catch { "<$address>" }, + $mail->header_raw_set( + $header_name => join ', ', map { $_->as_header_raw } @items, ); } return; diff --git a/lib/Sietima/Role/ManualSubscription.pm b/lib/Sietima/Role/ManualSubscription.pm index fd75f80..c2711f0 100644 --- a/lib/Sietima/Role/ManualSubscription.pm +++ b/lib/Sietima/Role/ManualSubscription.pm @@ -1,7 +1,7 @@ package Sietima::Role::ManualSubscription; use Moo::Role; use Sietima::Policy; -use URI; +use Sietima::HeaderURI; use namespace::clean; # VERSION @@ -36,16 +36,17 @@ L<owner|Sietima::Role::WithOwner/owner>, with different subjects. around list_addresses => sub($orig,$self) { my $list_name = $self->name // 'the list'; - my $mail_owner_uri = URI->new($self->owner,'mailto'); - my $sub_uri = $mail_owner_uri->clone; - $sub_uri->query_form(subject => "Please add me to $list_name"); - my $unsub_uri = $mail_owner_uri->clone; - $unsub_uri->query_form(subject => "Please remove me from $list_name"); return +{ $self->$orig->%*, - subscribe => $sub_uri, - unsubscribe => $unsub_uri, + subscribe => Sietima::HeaderURI->new_from_address( + $self->owner, + { subject => "Please add me to $list_name" }, + ), + unsubscribe => Sietima::HeaderURI->new_from_address( + $self->owner, + { subject => "Please remove me from $list_name" }, + ), }; }; diff --git a/lib/Sietima/Types.pm b/lib/Sietima/Types.pm index 9f052e3..c6c7381 100644 --- a/lib/Sietima/Types.pm +++ b/lib/Sietima/Types.pm @@ -1,7 +1,7 @@ package Sietima::Types; use Sietima::Policy; use Type::Utils -all; -use Types::Standard qw(Str HashRef); +use Types::Standard qw(Str HashRef Defined Str); use namespace::clean; use Type::Library -base, @@ -9,6 +9,7 @@ use Type::Library Address AddressFromStr TagName EmailMIME Message + HeaderUri HeaderUriFromThings Subscriber SubscriberFromAddress SubscriberFromStr SubscriberFromHashRef Transport MailStore MailStoreFromHashRef); @@ -124,6 +125,12 @@ An instance of L<< C<Sietima::Message> >>. class_type Message, { class => 'Sietima::Message' }; +class_type HeaderUri, { class => 'Sietima::HeaderURI' }; + +declare_coercion HeaderUriFromThings, + to_type HeaderUri, from Defined, +q{ Sietima::HeaderURI->new($_) }; + =type C<Subscriber> An instance of L<< C<Sietima::Subscriber> >>. |