aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authordakkar <dakkar@thenautilus.net>2017-03-24 17:56:22 +0000
committerdakkar <dakkar@thenautilus.net>2017-03-24 17:56:22 +0000
commit144ca83dff443539f84b10c4571de3354c1fd65b (patch)
tree460bd3c5ce7a1eb7b0f8552b05bee3a00025c597 /lib
parentname the authors of Siesta (diff)
downloadSietima-144ca83dff443539f84b10c4571de3354c1fd65b.tar.gz
Sietima-144ca83dff443539f84b10c4571de3354c1fd65b.tar.bz2
Sietima-144ca83dff443539f84b10c4571de3354c1fd65b.zip
documentation and tests for HeaderURI
Diffstat (limited to 'lib')
-rw-r--r--lib/Sietima.pm6
-rw-r--r--lib/Sietima/HeaderURI.pm169
-rw-r--r--lib/Sietima/Role/Headers.pm25
3 files changed, 173 insertions, 27 deletions
diff --git a/lib/Sietima.pm b/lib/Sietima.pm
index 98859ab..9115c05 100644
--- a/lib/Sietima.pm
+++ b/lib/Sietima.pm
@@ -249,8 +249,10 @@ sub _trait_namespace { 'Sietima::Role' } ## no critic(ProhibitUnusedPrivateSubro
my $addresses_href = $sietima->list_addresses;
-Returns a hashref of L<< C<Email::Address> >> instances or strings,
-that declare various addresses related to this list.
+Returns a hashref of L<< C<Sietima::HeaderURI> >> instances (or things
+that can be passed to its constructor, like L<< C<Email::Address> >>,
+L<< C<URI> >>, or strings), that declare various addresses related to
+this list.
This base class declares only the L<< /C<return_path> >>, and does not
use this method at all.
diff --git a/lib/Sietima/HeaderURI.pm b/lib/Sietima/HeaderURI.pm
index d9c1bb0..347ca77 100644
--- a/lib/Sietima/HeaderURI.pm
+++ b/lib/Sietima/HeaderURI.pm
@@ -2,11 +2,52 @@ 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 Types::Standard qw(Str is_Str ClassName HashRef Optional);
use Type::Params qw(compile);
use Types::URI qw(Uri is_Uri);
+use Email::Address;
use namespace::clean;
+# VERSION
+# ABSTRACT: annotated URI for list headers
+
+=head1 SYNOPSIS
+
+ around list_addresses => sub($orig,$self) {
+ return +{
+ $self->$orig->%*,
+ one => Sietima::HeaderURI->new({
+ uri => 'http://foo/',
+ comment => 'a thing',
+ }),
+ two => Sietima::HeaderURI->new_from_address(
+ $self->owner,
+ { subject => 'Hello' },
+ ),
+ three => Sietima::HeaderURI->new('http://some/url'),
+ four => Sietima::HeaderURI->new('(comment) address@example.com'),
+ };
+ }
+
+=head1 DESCRIPTION
+
+This class pairs a L<< C<URI> >> with a comment, and knows how to
+render itself as a string that can be used in a list management header
+(see L<< C<Sietima::Role::Headers> >>).
+
+=head1 ATTRIBUTES
+
+All attributes are read-only.
+
+=attr C<uri>
+
+Required L<< C<URI> >> object, coercible from a string or a hashref
+(see L<< C<Types::Uri> >> for the details). This is the URI that users
+should follow to perform the action implied by the list management
+header.
+
+=cut
+
has uri => (
is => 'ro',
isa => Uri,
@@ -14,49 +55,108 @@ has uri => (
coerce => 1,
);
+=attr C<comment>
+
+Optional string, will be added to the list management header as a
+comment (in parentheses).
+
+=cut
+
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"
+=method C<new>
+
+ Sietima::HeaderURI->new({
+ uri => 'http://foo/', comment => 'a thing',
+ });
+
+ Sietima::HeaderURI->new(
+ Email::Address->parse('(comment) address@example.com'),
+ );
+
+ Sietima::HeaderURI->new( '(comment) address@example.com' );
+
+ Sietima::HeaderURI->new(
+ URI->new('http://some/url'),
+ );
+
+ Sietima::HeaderURI->new( 'http://some/url' );
+
+Objects of this class can be constructed in several ways.
+
+You can pass a hashref with URI (or something that L<< C<Types::Uri>
+>> can coerce into a URI) and a comment string, as in the first
+example.
+
+Or you can pass a single value that can be (or can be coerced into)
+either a L<< C<Email::Address> >> or a L<< C<URI> >>.
+
+Email addresse became C<mailto:> URIs, and the optional comment is
+preserved.
+
+=for Pod::Coverage BUILDARGS
+
+=cut
+
+sub _args_from_address {
+ my ($address, $query) = @_;
+ $query ||= {};
+
+ my $uri = URI->new($address->address,'mailto');
+ $uri->query_form($query->%*);
+
+ my $comment = $address->comment;
+ # Email::Address::comment always returns a string in paretheses,
+ # but we don't want that, since we add them back in as_header_raw
+ $comment =~ s{\A\((.*)\)\z}{$1} if $comment;
+
+ return {
+ uri => $uri,
+ comment => $comment,
+ };
+}
around BUILDARGS => sub {
my ($orig, $class, @args) = @_;
- if (@args != 1 or ref($args[0]) eq 'HASH') {
+ if (@args != 1 or ref($args[0]) eq 'HASH' and $args[0]->{uri}) {
return $class->$orig(@args);
}
my $item = $args[0];
if (is_Address($item)) {
- return Sietima::HeaderURI->_args_from_address($item);
+ return _args_from_address($item);
}
elsif (is_Uri($item)) {
return { uri => $item };
}
- elsif (my $address = AddressFromStr->coerce($item)) {
- return Sietima::HeaderURI->_args_from_address($address);
+ elsif (is_Str($item) and my $address = AddressFromStr->coerce($item)) {
+ return _args_from_address($address);
}
else {
return { uri => $item };
};
};
-sub _args_from_address {
- my ($class, $address, $query) = @_;
- $query ||= {};
+=method C<new_from_address>
- my $uri = URI->new($address->address,'mailto');
- $uri->query_form($query->%*);
+ Sietima::HeaderURI->new_from_address(
+ $email_address,
+ \%query,
+ );
- return {
- uri => $uri,
- comment => $address->comment,
- };
-}
+This constructor builds a complex C<mailto:> URI with the query hash
+you provide. It's a shortcut for:
+
+ my $uri = URI->new("mailto:$email_address");
+ $uri->query_form(\%query);
+
+Common query keys are C<subject> and C<body>. See RFC 6068 ("The
+'mailto' URI Scheme") for details.
+
+=cut
sub new_from_address {
state $check = compile(
@@ -66,15 +166,42 @@ sub new_from_address {
);
my ($class, $address, $query) = $check->(@_);
- return $class->new($class->_args_from_address($address,$query));
+ return $class->new(_args_from_address($address,$query));
}
+=method C<as_header_raw>
+
+ $mail->header_raw_set('List-Thing' => $headeruri->as_header_raw);
+
+This method returns a string representation of the L</URI> and
+L</comment> in the format specified by RFC 2369 ("The Use of URLs as
+Meta-Syntax for Core Mail List Commands and their Transport through
+Message Header Fields").
+
+For example:
+
+ Sietima::HeaderURI->new({
+ uri => 'http://foo/', comment => 'a thing',
+ })->as_header_raw eq '<http://foo/> (a thing)';
+
+ Sietima::HeaderURI->new( '(comment) address@example.com' )
+ ->as_header_raw eq '<mailto:address@example.com> (comment)';
+
+ Sietima::HeaderURI->new( 'http://some/url' )
+ ->as_header_raw eq '<http://some/url>';
+
+Notice that, since the list management headers are I<structured>, they
+should always be set with L<<
+C<header_raw_set>|Email::Simple::Header/header_raw_set >>.
+
+=cut
+
sub as_header_raw {
my ($self) = @_;
my $str = sprintf '<%s>',$self->uri;
if (my $c = $self->comment) {
- $str .= ' '.$c;
+ $str .= sprintf ' (%s)',$c;
}
return $str;
diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm
index 5ab0d58..794a5e9 100644
--- a/lib/Sietima/Role/Headers.pm
+++ b/lib/Sietima/Role/Headers.pm
@@ -32,10 +32,27 @@ $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).
+C<list_addresses> hashref. Each of those values can be:
+
+=begin :list
+
+* an L<< C<Sietima::HeaderURI> >> object
+
+* a thing that can be passed to that class's constructor:
+
+=for :list
+* an L<< C<Email::Address> >> object
+* a L<< C<URI> >> object
+* a string parseable as either
+
+* an arrayref containing any mix of the above
+
+=end :list
+
+As a special case, if C<< $self->list_addresses->{post} >> exists and
+is false, the C<List-Post> header will have the value C<NO> to
+indicate that the list does not accept incoming messages (e.g. it's an
+announcement list).
=attr C<name>