diff options
32 files changed, 521 insertions, 91 deletions
@@ -1,2 +1,9 @@ +1.0.1 2017-03-24 17:56:55+00:00 Europe/London + - fix list headers: + * list headers are structured, should never be encoded + * they can have comments + * each header can have multiple values + * 'post' can be set to a false value to indicate a no-post list + 1.0.0 2017-03-16 17:45:48+00:00 Europe/London - first release @@ -9,6 +9,7 @@ TODO.md example/sietima lib/Sietima.pm lib/Sietima/CmdLine.pm +lib/Sietima/HeaderURI.pm lib/Sietima/MailStore.pm lib/Sietima/MailStore/FS.pm lib/Sietima/Message.pm @@ -38,6 +39,7 @@ t/lib/Test/Sietima.pm t/lib/Test/Sietima/MailStore.pm t/tests/sietima.t t/tests/sietima/cmdline.t +t/tests/sietima/headeruri.t t/tests/sietima/mailstore.t t/tests/sietima/message.t t/tests/sietima/multi-role/debounce-moderate.t @@ -53,7 +53,7 @@ "Type::Utils" : "0", "Types::Path::Tiny" : "0", "Types::Standard" : "0", - "URI" : "0", + "Types::URI" : "0", "experimental" : "0", "feature" : "0", "namespace::clean" : "0", @@ -70,6 +70,7 @@ "Path::Tiny" : "0", "Test2::API" : "0", "Test2::Bundle::Extended" : "0", + "URI" : "0", "lib" : "0" } } @@ -83,7 +84,7 @@ "web" : "https://www.thenautilus.net/cgit/Sietima" } }, - "version" : "1.0.0", + "version" : "1.0.1", "x_serialization_backend" : "Cpanel::JSON::XS version 3.0225" } @@ -9,6 +9,7 @@ build_requires: Path::Tiny: '0' Test2::API: '0' Test2::Bundle::Extended: '0' + URI: '0' lib: '0' configure_requires: ExtUtils::MakeMaker: '0' @@ -41,7 +42,7 @@ requires: Type::Utils: '0' Types::Path::Tiny: '0' Types::Standard: '0' - URI: '0' + Types::URI: '0' experimental: '0' feature: '0' namespace::clean: '0' @@ -51,5 +52,5 @@ requires: resources: homepage: https://www.thenautilus.net/SW/Sietima/ repository: https://www.thenautilus.net/cgit/Sietima -version: 1.0.0 +version: 1.0.1 x_serialization_backend: 'YAML::Tiny version 1.70' diff --git a/Makefile.PL b/Makefile.PL index 3ba7a32..e50af36 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -35,7 +35,7 @@ my %WriteMakefileArgs = ( "Type::Utils" => 0, "Types::Path::Tiny" => 0, "Types::Standard" => 0, - "URI" => 0, + "Types::URI" => 0, "experimental" => 0, "feature" => 0, "namespace::clean" => 0, @@ -49,9 +49,10 @@ my %WriteMakefileArgs = ( "Path::Tiny" => 0, "Test2::API" => 0, "Test2::Bundle::Extended" => 0, + "URI" => 0, "lib" => 0 }, - "VERSION" => "1.0.0", + "VERSION" => "1.0.1", "test" => { "TESTS" => "t/*.t t/tests/*.t t/tests/sietima/*.t t/tests/sietima/multi-role/*.t t/tests/sietima/role/*.t t/tests/sietima/role/subscriberonly/*.t" } @@ -83,6 +84,7 @@ my %FallbackPrereqs = ( "Type::Utils" => 0, "Types::Path::Tiny" => 0, "Types::Standard" => 0, + "Types::URI" => 0, "URI" => 0, "experimental" => 0, "feature" => 0, diff --git a/lib/Sietima.pm b/lib/Sietima.pm index 80cdf39..cec445d 100644 --- a/lib/Sietima.pm +++ b/lib/Sietima.pm @@ -15,7 +15,7 @@ use Email::Address; use namespace::clean; with 'MooX::Traits'; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: minimal mailing list manager @@ -138,7 +138,7 @@ Sietima - minimal mailing list manager =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS @@ -302,8 +302,10 @@ L<envelope|Sietima::Message/envelope> specifies some recipients. 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/CmdLine.pm b/lib/Sietima/CmdLine.pm index e014d48..2c4c7b7 100644 --- a/lib/Sietima/CmdLine.pm +++ b/lib/Sietima/CmdLine.pm @@ -8,7 +8,7 @@ use App::Spec; use Sietima::Runner; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: run Sietima as a command-line application @@ -79,7 +79,7 @@ Sietima::CmdLine - run Sietima as a command-line application =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/HeaderURI.pm b/lib/Sietima/HeaderURI.pm new file mode 100644 index 0000000..2a94696 --- /dev/null +++ b/lib/Sietima/HeaderURI.pm @@ -0,0 +1,234 @@ +package Sietima::HeaderURI; +use Moo; +use Sietima::Policy; +use Sietima::Types qw(Address AddressFromStr is_Address); +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; + +our $VERSION = '1.0.1'; # VERSION +# ABSTRACT: annotated URI for list headers + + +has uri => ( + is => 'ro', + isa => Uri, + required => 1, + coerce => 1, +); + + +has comment => ( + is => 'ro', + isa => Str, +); + + +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' and $args[0]->{uri}) { + return $class->$orig(@args); + } + + my $item = $args[0]; + if (is_Address($item)) { + return _args_from_address($item); + } + elsif (is_Uri($item)) { + return { uri => $item }; + } + elsif (is_Str($item) and my $address = AddressFromStr->coerce($item)) { + return _args_from_address($address); + } + else { + return { uri => $item }; + }; +}; + + +sub new_from_address { + state $check = compile( + ClassName, + Address->plus_coercions(AddressFromStr), + Optional[HashRef], + ); + my ($class, $address, $query) = $check->(@_); + + return $class->new(_args_from_address($address,$query)); +} + + +sub as_header_raw { + my ($self) = @_; + + my $str = sprintf '<%s>',$self->uri; + if (my $c = $self->comment) { + $str .= sprintf ' (%s)',$c; + } + + return $str; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::HeaderURI - annotated URI for list headers + +=head1 VERSION + +version 1.0.1 + +=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. + +=head2 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. + +=head2 C<comment> + +Optional string, will be added to the list management header as a +comment (in parentheses). + +=head1 METHODS + +=head2 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. + +=head2 C<new_from_address> + + Sietima::HeaderURI->new_from_address( + $email_address, + \%query, + ); + +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. + +=head2 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 >>. + +=for Pod::Coverage BUILDARGS + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Sietima/MailStore.pm b/lib/Sietima/MailStore.pm index 9ddec2c..ac035e3 100644 --- a/lib/Sietima/MailStore.pm +++ b/lib/Sietima/MailStore.pm @@ -3,7 +3,7 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: interface for mail stores @@ -25,7 +25,7 @@ Sietima::MailStore - interface for mail stores =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 DESCRIPTION diff --git a/lib/Sietima/MailStore/FS.pm b/lib/Sietima/MailStore/FS.pm index 1c204b5..d552351 100644 --- a/lib/Sietima/MailStore/FS.pm +++ b/lib/Sietima/MailStore/FS.pm @@ -8,7 +8,7 @@ use Sietima::Types qw(EmailMIME TagName); use Digest::SHA qw(sha1_hex); use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: filesystem-backed email store @@ -132,7 +132,7 @@ Sietima::MailStore::FS - filesystem-backed email store =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Message.pm b/lib/Sietima/Message.pm index d5d6268..661c792 100644 --- a/lib/Sietima/Message.pm +++ b/lib/Sietima/Message.pm @@ -10,7 +10,7 @@ use Sietima::Subscriber; use Email::MIME; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: an email message with an envelope @@ -64,7 +64,7 @@ Sietima::Message - an email message with an envelope =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Policy.pm b/lib/Sietima/Policy.pm index 853e0a4..720571c 100644 --- a/lib/Sietima/Policy.pm +++ b/lib/Sietima/Policy.pm @@ -5,7 +5,7 @@ use warnings; use feature ':5.24'; use experimental 'signatures'; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: pragma for Sietima modules @@ -33,7 +33,7 @@ Sietima::Policy - pragma for Sietima modules =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/AvoidDups.pm b/lib/Sietima/Role/AvoidDups.pm index 2cef67a..a167d88 100644 --- a/lib/Sietima/Role/AvoidDups.pm +++ b/lib/Sietima/Role/AvoidDups.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Email::Address; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: prevent people from receiving the same message multiple times @@ -39,7 +39,7 @@ Sietima::Role::AvoidDups - prevent people from receiving the same message multip =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/Debounce.pm b/lib/Sietima/Role/Debounce.pm index 3f362f5..b75ed57 100644 --- a/lib/Sietima/Role/Debounce.pm +++ b/lib/Sietima/Role/Debounce.pm @@ -3,7 +3,7 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: avoid mail loops @@ -36,7 +36,7 @@ Sietima::Role::Debounce - avoid mail loops =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm index 1f11ecc..db58706 100644 --- a/lib/Sietima/Role/Headers.pm +++ b/lib/Sietima/Role/Headers.pm @@ -2,10 +2,13 @@ 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; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: adds standard list-related headers to messages @@ -15,6 +18,23 @@ has name => ( required => 0, ); +sub _normalise_address($self,$address) { + my @items = ref($address) eq 'ARRAY' ? $address->@* : $address; + + return map { + HeaderUriFromThings->coerce($_) + } @items; +} + +sub _set_header($self,$mail,$name,$value) { + my $header_name = 'List-' . ucfirst($name =~ s{[^[:alnum:]]+}{-}gr); + my @items = $self->_normalise_address($value); + + $mail->header_raw_set( + $header_name => join ', ', map { $_->as_header_raw } @items, + ); +} + sub _add_headers_to($self,$message) { my $addresses = $self->list_addresses; my $mail = $message->mail; @@ -23,7 +43,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, ); @@ -31,22 +51,19 @@ sub _add_headers_to($self,$message) { # if nobody declared a "post" address, let's guess it's the same # as the address we send from - $addresses->{post} //= $return_path; + if (not exists $addresses->{post}) { + $self->_set_header( $mail, post => $return_path ); + } + # but if they explicitly set a false value, this list does not + # allow posting, so we need to set the special value 'NO' + elsif (not $addresses->{post}) { + delete $addresses->{post}; + $mail->header_raw_set('List-Post','NO'); + } + # otherwise we can treat 'post' as normal 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>" }, - ); + $self->_set_header( $mail, $name => $addresses->{$name} ); } return; } @@ -72,7 +89,7 @@ Sietima::Role::Headers - adds standard list-related headers to messages =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS @@ -95,10 +112,44 @@ $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: + +=over 4 + +=item * + +an L<< C<Sietima::HeaderURI> >> object + +=item * + +a thing that can be passed to that class's constructor: + +=over 4 + +=item * + +an L<< C<Email::Address> >> object + +=item * + +a L<< C<URI> >> object + +=item * + +a string parseable as either + +=back + +=item * + +an arrayref containing any mix of the above + +=back + +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). =head1 ATTRIBUTES diff --git a/lib/Sietima/Role/ManualSubscription.pm b/lib/Sietima/Role/ManualSubscription.pm index 1023fa3..98bb607 100644 --- a/lib/Sietima/Role/ManualSubscription.pm +++ b/lib/Sietima/Role/ManualSubscription.pm @@ -1,10 +1,10 @@ package Sietima::Role::ManualSubscription; use Moo::Role; use Sietima::Policy; -use URI; +use Sietima::HeaderURI; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: adds standard list-related headers to messages with 'Sietima::Role::WithOwner'; @@ -12,16 +12,17 @@ with 'Sietima::Role::WithOwner'; 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" }, + ), }; }; @@ -40,7 +41,7 @@ Sietima::Role::ManualSubscription - adds standard list-related headers to messag =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/NoMail.pm b/lib/Sietima/Role/NoMail.pm index adb7f3e..cd1fc30 100644 --- a/lib/Sietima/Role/NoMail.pm +++ b/lib/Sietima/Role/NoMail.pm @@ -3,7 +3,7 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: don't send mail to those who don't want it @@ -28,7 +28,7 @@ Sietima::Role::NoMail - don't send mail to those who don't want it =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm index 4a1ca48..70eb30a 100644 --- a/lib/Sietima/Role/ReplyTo.pm +++ b/lib/Sietima/Role/ReplyTo.pm @@ -6,7 +6,7 @@ use Sietima::Types qw(Address AddressFromStr); use List::AllUtils qw(part); use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: munge the C<Reply-To> header @@ -77,7 +77,7 @@ Sietima::Role::ReplyTo - munge the C<Reply-To> header =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/SubjectTag.pm b/lib/Sietima/Role/SubjectTag.pm index 20aeecc..d074256 100644 --- a/lib/Sietima/Role/SubjectTag.pm +++ b/lib/Sietima/Role/SubjectTag.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Types::Standard qw(Str); use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: add a tag to messages' subjects @@ -40,7 +40,7 @@ Sietima::Role::SubjectTag - add a tag to messages' subjects =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm index f457115..11a2aa8 100644 --- a/lib/Sietima/Role/SubscriberOnly.pm +++ b/lib/Sietima/Role/SubscriberOnly.pm @@ -7,7 +7,7 @@ use Types::Standard qw(Object CodeRef); use Type::Params qw(compile); use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: base role for "closed" lists @@ -49,7 +49,7 @@ Sietima::Role::SubscriberOnly - base role for "closed" lists =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/SubscriberOnly/Drop.pm b/lib/Sietima/Role/SubscriberOnly/Drop.pm index 5804b6f..731784c 100644 --- a/lib/Sietima/Role/SubscriberOnly/Drop.pm +++ b/lib/Sietima/Role/SubscriberOnly/Drop.pm @@ -3,7 +3,7 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: drop messages from non-subscribers @@ -26,7 +26,7 @@ Sietima::Role::SubscriberOnly::Drop - drop messages from non-subscribers =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm index bf89fce..2cc8e34 100644 --- a/lib/Sietima/Role/SubscriberOnly/Moderate.pm +++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm @@ -5,7 +5,7 @@ use Email::Stuffer; use Email::MIME; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: moderate messages from non-subscribers @@ -133,7 +133,7 @@ Sietima::Role::SubscriberOnly::Moderate - moderate messages from non-subscribers =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/WithMailStore.pm b/lib/Sietima/Role/WithMailStore.pm index e9f6b51..3ad3b38 100644 --- a/lib/Sietima/Role/WithMailStore.pm +++ b/lib/Sietima/Role/WithMailStore.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Sietima::Types qw(MailStore MailStoreFromHashRef); use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: role for lists with a store for messages @@ -29,7 +29,7 @@ Sietima::Role::WithMailStore - role for lists with a store for messages =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/WithOwner.pm b/lib/Sietima/Role/WithOwner.pm index f5757be..a06fc5d 100644 --- a/lib/Sietima/Role/WithOwner.pm +++ b/lib/Sietima/Role/WithOwner.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Sietima::Types qw(Address AddressFromStr); use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: role for lists with an owner @@ -37,7 +37,7 @@ Sietima::Role::WithOwner - role for lists with an owner =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Role/WithPostAddress.pm b/lib/Sietima/Role/WithPostAddress.pm index 7cb82e5..7f9051a 100644 --- a/lib/Sietima/Role/WithPostAddress.pm +++ b/lib/Sietima/Role/WithPostAddress.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Sietima::Types qw(Address AddressFromStr); use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: role for lists with a posting address @@ -36,7 +36,7 @@ Sietima::Role::WithPostAddress - role for lists with a posting address =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 SYNOPSIS diff --git a/lib/Sietima/Runner.pm b/lib/Sietima/Runner.pm index ee6ee23..8580cbd 100644 --- a/lib/Sietima/Runner.pm +++ b/lib/Sietima/Runner.pm @@ -3,7 +3,7 @@ use Moo; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: C<App::Spec::Run> for Sietima @@ -32,7 +32,7 @@ Sietima::Runner - C<App::Spec::Run> for Sietima =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 DESCRIPTION diff --git a/lib/Sietima/Subscriber.pm b/lib/Sietima/Subscriber.pm index f7c4cbf..04c9d1e 100644 --- a/lib/Sietima/Subscriber.pm +++ b/lib/Sietima/Subscriber.pm @@ -8,7 +8,7 @@ use Email::Address; use List::AllUtils qw(any); use namespace::clean; -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: a subscriber to a mailing list @@ -66,7 +66,7 @@ Sietima::Subscriber - a subscriber to a mailing list =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 DESCRIPTION diff --git a/lib/Sietima/Types.pm b/lib/Sietima/Types.pm index 5a56bfd..ad85221 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,10 +9,11 @@ use Type::Library Address AddressFromStr TagName EmailMIME Message + HeaderUri HeaderUriFromThings Subscriber SubscriberFromAddress SubscriberFromStr SubscriberFromHashRef Transport MailStore MailStoreFromHashRef); -our $VERSION = '1.0.0'; # VERSION +our $VERSION = '1.0.1'; # VERSION # ABSTRACT: type library for Sietima @@ -49,6 +50,12 @@ declare TagName, as Str, class_type Message, { class => 'Sietima::Message' }; +class_type HeaderUri, { class => 'Sietima::HeaderURI' }; + +declare_coercion HeaderUriFromThings, + to_type HeaderUri, from Defined, +q{ Sietima::HeaderURI->new($_) }; + class_type Subscriber, { class => 'Sietima::Subscriber' }; @@ -78,7 +85,7 @@ Sietima::Types - type library for Sietima =head1 VERSION -version 1.0.0 +version 1.0.1 =head1 DESCRIPTION diff --git a/t/author-no-tabs.t b/t/author-no-tabs.t index 3bac52a..169b4c9 100644 --- a/t/author-no-tabs.t +++ b/t/author-no-tabs.t @@ -17,6 +17,7 @@ use Test::NoTabs; my @files = ( 'lib/Sietima.pm', 'lib/Sietima/CmdLine.pm', + 'lib/Sietima/HeaderURI.pm', 'lib/Sietima/MailStore.pm', 'lib/Sietima/MailStore/FS.pm', 'lib/Sietima/Message.pm', @@ -41,6 +42,7 @@ my @files = ( 't/lib/Test/Sietima/MailStore.pm', 't/tests/sietima.t', 't/tests/sietima/cmdline.t', + 't/tests/sietima/headeruri.t', 't/tests/sietima/mailstore.t', 't/tests/sietima/message.t', 't/tests/sietima/multi-role/debounce-moderate.t', diff --git a/t/tests/sietima/headeruri.t b/t/tests/sietima/headeruri.t new file mode 100644 index 0000000..c158f3d --- /dev/null +++ b/t/tests/sietima/headeruri.t @@ -0,0 +1,80 @@ +#!perl +use lib 't/lib'; +use Test::Sietima; +use Email::Address; +use URI; +use Sietima::HeaderURI; + +subtest 'new' => sub { + is( + Sietima::HeaderURI->new({ + uri => 'http://foo/', + comment => 'a thing', + })->as_header_raw, + '<http://foo/> (a thing)', + 'normal constructor call', + ); + + is( + Sietima::HeaderURI->new( + '(comment) address@example.com', + )->as_header_raw, + '<mailto:address@example.com> (comment)', + 'string, address+comment', + ); + + is( + Sietima::HeaderURI->new( + 'http://some/url' + )->as_header_raw, + '<http://some/url>', + 'string, URI', + ); + + is( + Sietima::HeaderURI->new( + { scheme => 'https', host => 'foo', path => [1,2,3] } + )->as_header_raw, + '<https://foo/1/2/3>', + 'hashref, URI::FromHash', + ); + + is( + Sietima::HeaderURI->new( + URI->new('http://bar') + )->as_header_raw, + '<http://bar>', + 'URI object', + ); + + is( + Sietima::HeaderURI->new( + Email::Address->parse('(comment) address@example.com'), + )->as_header_raw, + '<mailto:address@example.com> (comment)', + 'Email::Address object', + ); +}; + + +subtest 'new_from_address' => sub { + + is( + Sietima::HeaderURI->new_from_address( + '(comment) address@example.com', + )->as_header_raw, + '<mailto:address@example.com> (comment)', + 'string', + ); + + is( + Sietima::HeaderURI->new_from_address( + '(comment) address@example.com', + { subject => 'test me' }, + )->as_header_raw, + '<mailto:address@example.com?subject=test+me> (comment)', + 'string and hashref', + ); +}; + +done_testing; diff --git a/t/tests/sietima/role/headers.t b/t/tests/sietima/role/headers.t index 9f3e664..6dcfff3 100644 --- a/t/tests/sietima/role/headers.t +++ b/t/tests/sietima/role/headers.t @@ -12,31 +12,46 @@ package Sietima::Role::ForTesting { $self->$orig->%*, test1 => AddressFromStr->coerce('name <someone@example.com>'), 'test+2' => 'http://test.example.com', + test3 => ['name (comment) <other@example.com>','mailto:thing@example.com' ], }; }; }; -my $s = make_sietima( - with_traits => ['Headers','WithOwner','ForTesting'], - name => 'test-list', - owner => 'owner@example.com', - subscribers => [ - 'one@users.example.com', - 'two@users.example.com', - ], -); +package Sietima::Role::ForTesting2 { + use Moo::Role; + use Sietima::Policy; + use Sietima::Types qw(AddressFromStr); + + around list_addresses => sub($orig,$self) { + return { + $self->$orig->%*, + post => 0, + }; + }; +}; subtest 'list headers should be added' => sub { + my $s = make_sietima( + with_traits => ['Headers','WithOwner','ForTesting'], + name => 'test-list', + owner => 'owner@example.com', + subscribers => [ + 'one@users.example.com', + 'two@users.example.com', + ], + ); + test_sending( sietima => $s, mails => [ object { - call sub { +{ shift->header_str_pairs } } => hash { + call sub { +{ shift->header_raw_pairs } } => hash { field 'List-Id' => 'test-list <sietima-test.list.example.com>'; field 'List-Owner' => '<mailto:owner@example.com>'; field 'List-Post' => '<mailto:sietima-test@list.example.com>'; field 'List-Test1' => '<mailto:someone@example.com>'; field 'List-Test-2' => '<http://test.example.com>'; + field 'List-Test3' => '<mailto:other@example.com> (comment), <mailto:thing@example.com>'; field 'Date' => D(); field 'MIME-Version' => D(); @@ -53,4 +68,29 @@ subtest 'list headers should be added' => sub { ); }; +subtest 'no-post list' => sub { + my $s = make_sietima( + with_traits => ['Headers','WithOwner','ForTesting2'], + name => 'test-list', + owner => 'owner@example.com', + subscribers => [ + 'one@users.example.com', + 'two@users.example.com', + ], + ); + + test_sending( + sietima => $s, + mails => [ + object { + call sub { +{ shift->header_raw_pairs } } => hash { + field 'List-Post' => 'NO'; + + etc; + }; + }, + ], + ); +}; + done_testing; diff --git a/t/tests/sietima/role/manualsubscription.t b/t/tests/sietima/role/manualsubscription.t index f99805d..ade2062 100644 --- a/t/tests/sietima/role/manualsubscription.t +++ b/t/tests/sietima/role/manualsubscription.t @@ -17,7 +17,7 @@ subtest '(un)sub headers should be added' => sub { sietima => $s, mails => [ object { - call sub { +{ shift->header_str_pairs } } => hash { + call sub { +{ shift->header_raw_pairs } } => hash { field 'List-Subscribe' => '<mailto:owner@example.com?subject=Please+add+me+to+test-list>'; field 'List-Unsubscribe' => '<mailto:owner@example.com?subject=Please+remove+me+from+test-list>'; |