diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Sietima.pm | 311 | ||||
| -rw-r--r-- | lib/Sietima/CmdLine.pm | 156 | ||||
| -rw-r--r-- | lib/Sietima/HeaderURI.pm | 198 | ||||
| -rw-r--r-- | lib/Sietima/MailStore.pm | 52 | ||||
| -rw-r--r-- | lib/Sietima/MailStore/FS.pm | 210 | ||||
| -rw-r--r-- | lib/Sietima/Message.pm | 113 | ||||
| -rw-r--r-- | lib/Sietima/Policy.pm | 50 | ||||
| -rw-r--r-- | lib/Sietima/Role/AvoidDups.pm | 64 | ||||
| -rw-r--r-- | lib/Sietima/Role/Debounce.pm | 58 | ||||
| -rw-r--r-- | lib/Sietima/Role/Headers.pm | 164 | ||||
| -rw-r--r-- | lib/Sietima/Role/ManualSubscription.pm | 64 | ||||
| -rw-r--r-- | lib/Sietima/Role/NoMail.pm | 48 | ||||
| -rw-r--r-- | lib/Sietima/Role/ReplyTo.pm | 136 | ||||
| -rw-r--r-- | lib/Sietima/Role/SubjectTag.pm | 73 | ||||
| -rw-r--r-- | lib/Sietima/Role/SubscriberOnly.pm | 98 | ||||
| -rw-r--r-- | lib/Sietima/Role/SubscriberOnly/Drop.pm | 43 | ||||
| -rw-r--r-- | lib/Sietima/Role/SubscriberOnly/Moderate.pm | 256 | ||||
| -rw-r--r-- | lib/Sietima/Role/WithMailStore.pm | 48 | ||||
| -rw-r--r-- | lib/Sietima/Role/WithOwner.pm | 67 | ||||
| -rw-r--r-- | lib/Sietima/Role/WithPostAddress.pm | 60 | ||||
| -rw-r--r-- | lib/Sietima/Runner.pm | 50 | ||||
| -rw-r--r-- | lib/Sietima/Subscriber.pm | 128 | ||||
| -rw-r--r-- | lib/Sietima/Types.pm | 157 |
23 files changed, 1624 insertions, 980 deletions
diff --git a/lib/Sietima.pm b/lib/Sietima.pm index 9115c05..34c4ba3 100644 --- a/lib/Sietima.pm +++ b/lib/Sietima.pm @@ -15,9 +15,131 @@ use Email::Address; use namespace::clean; with 'MooX::Traits'; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: minimal mailing list manager + +has return_path => ( + isa => Address, + is => 'ro', + required => 1, + coerce => AddressFromStr, +); + + +my $subscribers_array = ArrayRef[ + Subscriber->plus_coercions( + SubscriberFromAddress, + SubscriberFromStr, + SubscriberFromHashRef, + ) +]; +has subscribers => ( + isa => $subscribers_array, + is => 'lazy', + coerce => $subscribers_array->coercion, +); +sub _build_subscribers { +[] } + + +has transport => ( + isa => Transport, + is => 'lazy', +); +sub _build_transport { Email::Sender::Simple->default_transport } + + +sub handle_mail_from_stdin($self,@) { + my $mail_text = do { local $/; <> }; + # we're hoping that, since we probably got called from an MTA/MDA, + # STDIN contains a well-formed email message, addressed to us + my $incoming_mail = Email::MIME->new(\$mail_text); + return $self->handle_mail($incoming_mail); +} + + +sub handle_mail($self,$incoming_mail) { + state $check = compile(Object,EmailMIME); $check->(@_); + + my (@outgoing_messages) = $self->munge_mail($incoming_mail); + for my $outgoing_message (@outgoing_messages) { + $self->send_message($outgoing_message); + } + return; +} + + +sub subscribers_to_send_to($self,$incoming_mail) { + state $check = compile(Object,EmailMIME); $check->(@_); + + return $self->subscribers; +} + + +sub munge_mail($self,$incoming_mail) { + state $check = compile(Object,EmailMIME); $check->(@_); + + return Sietima::Message->new({ + mail => $incoming_mail, + from => $self->return_path, + to => $self->subscribers_to_send_to($incoming_mail), + }); +} + + +sub send_message($self,$outgoing_message) { + state $check = compile(Object,Message); $check->(@_); + + my $envelope = $outgoing_message->envelope; + if ($envelope->{to} && $envelope->{to}->@*) { + $self->transport->send( + $outgoing_message->mail, + $envelope, + ); + } + + return; +} + +sub _trait_namespace { 'Sietima::Role' } ## no critic(ProhibitUnusedPrivateSubroutines) + + +sub list_addresses($self) { + return +{ + return_path => $self->return_path, + }; +} + + +sub command_line_spec($self) { + return { + name => 'sietima', + title => 'a simple mailing list manager', + subcommands => { + send => { + op => 'handle_mail_from_stdin', + summary => 'send email from STDIN', + }, + }, + }; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima - minimal mailing list manager + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS use Sietima; @@ -44,51 +166,64 @@ consumes L<< C<MooX::Traits> >> to simplify composing roles: These are the traits provided with the default distribution: -=for :list -= L<< C<AvoidDups>|Sietima::Role::AvoidDups >> +=over 4 + +=item L<< C<AvoidDups>|Sietima::Role::AvoidDups >> + prevents the sender from receiving copies of their own messages -= L<< C<Debounce>|Sietima::Role::Debounce >> + +=item L<< C<Debounce>|Sietima::Role::Debounce >> + avoids mail-loops using a C<X-Been-There> header -= L<< C<Headers>|Sietima::Role::Headers >> + +=item L<< C<Headers>|Sietima::Role::Headers >> + adds C<List-*> headers to all outgoing messages -= L<< C<ManualSubscription>|Sietima::Role::ManualSubscription >> + +=item L<< C<ManualSubscription>|Sietima::Role::ManualSubscription >> + specifies that to (un)subscribe, people should write to the list owner -= L<< C<NoMail>|Sietima::Role::NoMail >> + +=item L<< C<NoMail>|Sietima::Role::NoMail >> + avoids sending messages to subscribers who don't want them -= L<< C<ReplyTo>|Sietima::Role::ReplyTo >> + +=item L<< C<ReplyTo>|Sietima::Role::ReplyTo >> + optionally sets the C<Reply-To> header to the mailing list address -= L<< C<SubjectTag>|Sietima::Role::SubjectTag >> + +=item L<< C<SubjectTag>|Sietima::Role::SubjectTag >> + prepends a C<[tag]> to the subject header of outgoing messages that aren't already tagged -= L<< C<SubscriberOnly::Drop>|Sietima::Role::SubscriberOnly::Drop >> + +=item L<< C<SubscriberOnly::Drop>|Sietima::Role::SubscriberOnly::Drop >> + silently drops all messages coming from addresses not subscribed to the list -= L<< C<SubscriberOnly::Moderate>|Sietima::Role::SubscriberOnly::Moderate >> + +=item L<< C<SubscriberOnly::Moderate>|Sietima::Role::SubscriberOnly::Moderate >> + holds messages coming from addresses not subscribed to the list for moderation, and provides commands to manage the moderation queue +=back + The only "configuration mechanism" currently supported is to initialise a C<Sietima> object in your driver script, passing all the needed values to the constructor. L<< C<Sietima::CmdLine> >> is the recommended way of doing that: it adds command-line parsing capability to Sietima. -=attr C<return_path> +=head1 ATTRIBUTES + +=head2 C<return_path> A L<< C<Email::Address> >> instance, coerced from string if necessary. This is the address that Sietima will send messages I<from>. -=cut - -has return_path => ( - isa => Address, - is => 'ro', - required => 1, - coerce => AddressFromStr, -); - -=attr C<subscribers> +=head2 C<subscribers> An array-ref of L<< C<Sietima::Subscriber> >> objects, defaults to the empty array. @@ -104,38 +239,16 @@ roles use the other attributes (L<< C<NoMail>|Sietima::Role::NoMail C<SubscriberOnly> >> uses C<aliases> via L<< C<match>|Sietima::Subscriber/match >>) -=cut - -my $subscribers_array = ArrayRef[ - Subscriber->plus_coercions( - SubscriberFromAddress, - SubscriberFromStr, - SubscriberFromHashRef, - ) -]; -has subscribers => ( - isa => $subscribers_array, - is => 'lazy', - coerce => $subscribers_array->coercion, -); -sub _build_subscribers { +[] } - -=attr C<transport> +=head2 C<transport> A L<< C<Email::Sender::Transport> >> instance, which will be used to send messages. If not passed in, Sietima uses L<< C<Email::Sender::Simple> >>'s L<< C<default_transport>|Email::Sender::Simple/default_transport >>. -=cut - -has transport => ( - isa => Transport, - is => 'lazy', -); -sub _build_transport { Email::Sender::Simple->default_transport } +=head1 METHODS -=method C<handle_mail_from_stdin> +=head2 C<handle_mail_from_stdin> $sietima->handle_mail_from_stdin(); @@ -143,17 +256,7 @@ This is the main entry-point when Sietima is invoked from a MTA. It will parse a L<< C<Email::MIME> >> object out of the standard input, then pass it to L<< /C<handle_mail> >> for processing. -=cut - -sub handle_mail_from_stdin($self,@) { - my $mail_text = do { local $/; <> }; - # we're hoping that, since we probably got called from an MTA/MDA, - # STDIN contains a well-formed email message, addressed to us - my $incoming_mail = Email::MIME->new(\$mail_text); - return $self->handle_mail($incoming_mail); -} - -=method C<handle_mail> +=head2 C<handle_mail> $sietima->handle_mail($email_mime); @@ -161,19 +264,7 @@ Main driver method: converts the given email message into a list of L<< C<Sietima::Message> >> objects by calling L<< /C<munge_mail> >>, then sends each of them by calling L<< /C<send_message> >>. -=cut - -sub handle_mail($self,$incoming_mail) { - state $check = compile(Object,EmailMIME); $check->(@_); - - my (@outgoing_messages) = $self->munge_mail($incoming_mail); - for my $outgoing_message (@outgoing_messages) { - $self->send_message($outgoing_message); - } - return; -} - -=method C<subscribers_to_send_to> +=head2 C<subscribers_to_send_to> my $subscribers_aref = $sietima->subscribers_to_send_to($email_mime); @@ -185,15 +276,7 @@ In this base class, it just returns the value of the L<< C<AvoidDups>|Sietima::Role::AvoidDups >> modify this method to exclude some subscribers. -=cut - -sub subscribers_to_send_to($self,$incoming_mail) { - state $check = compile(Object,EmailMIME); $check->(@_); - - return $self->subscribers; -} - -=method C<munge_mail> +=head2 C<munge_mail> my @messages = $sietima->munge_mail($email_mime); @@ -207,19 +290,7 @@ email message. Roles such as L<< C<SubjectTag>|Sietima::Role::SubjectTag >> modify this method to alter the message. -=cut - -sub munge_mail($self,$incoming_mail) { - state $check = compile(Object,EmailMIME); $check->(@_); - - return Sietima::Message->new({ - mail => $incoming_mail, - from => $self->return_path, - to => $self->subscribers_to_send_to($incoming_mail), - }); -} - -=method C<send_message> +=head2 C<send_message> $sietima->send_message($sietima_message); @@ -227,25 +298,7 @@ Sends the given L<< C<Sietima::Message> >> object via the L<< /C<transport> >>, but only if the message's L<envelope|Sietima::Message/envelope> specifies some recipients. -=cut - -sub send_message($self,$outgoing_message) { - state $check = compile(Object,Message); $check->(@_); - - my $envelope = $outgoing_message->envelope; - if ($envelope->{to} && $envelope->{to}->@*) { - $self->transport->send( - $outgoing_message->mail, - $envelope, - ); - } - - return; -} - -sub _trait_namespace { 'Sietima::Role' } ## no critic(ProhibitUnusedPrivateSubroutines) - -=method C<list_addresses> +=head2 C<list_addresses> my $addresses_href = $sietima->list_addresses; @@ -260,15 +313,7 @@ use this method at all. The L<< C<Headers>|Sietima::Role::Headers >> role uses this to populate the various C<List-*> headers. -=cut - -sub list_addresses($self) { - return +{ - return_path => $self->return_path, - }; -} - -=method C<command_line_spec> +=head2 C<command_line_spec> my $app_spec_data = $sietima->command_line_spec; @@ -292,19 +337,15 @@ For example, in a C<.qmail> file: Roles can extend this to provide additional sub-commands and options. -=cut +=head1 AUTHOR -sub command_line_spec($self) { - return { - name => 'sietima', - title => 'a simple mailing list manager', - subcommands => { - send => { - op => 'handle_mail_from_stdin', - summary => 'send email from STDIN', - }, - }, - }; -} +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/CmdLine.pm b/lib/Sietima/CmdLine.pm index 6c24834..4c48f60 100644 --- a/lib/Sietima/CmdLine.pm +++ b/lib/Sietima/CmdLine.pm @@ -8,9 +8,79 @@ use App::Spec; use Sietima::Runner; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: run Sietima as a command-line application + +has sietima => ( + is => 'ro', + required => 1, + isa => SietimaObj, +); + + +has extra_spec => ( + is => 'ro', + isa => HashRef, + default => sub { +{} }, +); + + +sub BUILDARGS($class,@args) { + my $args = $class->next::method(@args); + $args->{sietima} //= do { + my $traits = delete $args->{traits} // []; + my $constructor_args = delete $args->{args} // {}; + Sietima->with_traits($traits->@*)->new($constructor_args); + }; + return $args; +} + + +has app_spec => ( + is => 'lazy', + init_arg => undef, +); + +sub _build_app_spec($self) { + my $spec_data = $self->sietima->command_line_spec(); + + return App::Spec->read({ + $spec_data->%*, + $self->extra_spec->%*, + }); +} + + +has runner => ( + is => 'lazy', + init_arg => undef, + handles => [qw(run)], +); + +sub _build_runner($self) { + return Sietima::Runner->new({ + spec => $self->app_spec, + cmd => $self->sietima, + }); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::CmdLine - run Sietima as a command-line application + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS use Sietima::CmdLine; @@ -28,35 +98,23 @@ use namespace::clean; This class simplifies the creation of a L<< C<Sietima> >> object, and uses L<< C<App::Spec> >> to provide a command-line interface to it. -=attr C<sietima> +=head1 ATTRIBUTES + +=head2 C<sietima> Required, an instance of L<< C<Sietima> >>. You can either construct it yourself, or use the L<simplified building provided by the constructor|/new>. -=cut - -has sietima => ( - is => 'ro', - required => 1, - isa => SietimaObj, -); - -=attr C<extra_spec> +=head2 C<extra_spec> Optional hashref. Used inside L<< /C<app_spec> >>. If you're not familiar with L<< C<App::Spec> >>, you probably don't want to touch this. -=cut - -has extra_spec => ( - is => 'ro', - isa => HashRef, - default => sub { +{} }, -); +=head1 METHODS -=method C<new> +=head2 C<new> my $cmdline = Sietima::CmdLine->new({ sietima => Sietima->with_traits(qw(SubjectTag))->new({ @@ -78,21 +136,7 @@ The constructor. In alternative to passing a L<< C<Sietima> >> instance, you can pass C<traits> and C<args>, and the instance will be built for you. The two calls above are equivalent. -=for Pod::Coverage BUILDARGS - -=cut - -sub BUILDARGS($class,@args) { - my $args = $class->next::method(@args); - $args->{sietima} //= do { - my $traits = delete $args->{traits} // []; - my $constructor_args = delete $args->{args} // {}; - Sietima->with_traits($traits->@*)->new($constructor_args); - }; - return $args; -} - -=method C<app_spec> +=head2 C<app_spec> Returns an instance of L<< C<App::Spec> >>, built from the specification returned by calling L<< @@ -101,47 +145,29 @@ C<command_line_spec>|Sietima/command_line_spec >> on the L<< method, and the C<extra_spec> attribute, are probably only interesting to people who are doing weird extensions. -=cut - -has app_spec => ( - is => 'lazy', - init_arg => undef, -); - -sub _build_app_spec($self) { - my $spec_data = $self->sietima->command_line_spec(); - - return App::Spec->read({ - $spec_data->%*, - $self->extra_spec->%*, - }); -} - -=method C<runner> +=head2 C<runner> Returns an instance of L<< C<Sietima::Runner> >>, built from the L<< /C<app_spec> >>. -=method C<run> +=head2 C<run> Delegates to the L<< /C<runner> >>'s L<< C<run>|App::Spec::Run/run >> method. Parser the command line arguments from C<@ARGV> and executes the appropriate action. -=cut +=for Pod::Coverage BUILDARGS -has runner => ( - is => 'lazy', - init_arg => undef, - handles => [qw(run)], -); +=head1 AUTHOR -sub _build_runner($self) { - return Sietima::Runner->new({ - spec => $self->app_spec, - cmd => $self->sietima, - }); -} +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/HeaderURI.pm b/lib/Sietima/HeaderURI.pm index 347ca77..f6d3002 100644 --- a/lib/Sietima/HeaderURI.pm +++ b/lib/Sietima/HeaderURI.pm @@ -8,9 +8,103 @@ use Types::URI qw(Uri is_Uri); use Email::Address; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # 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.2 + =head1 SYNOPSIS around list_addresses => sub($orig,$self) { @@ -39,35 +133,21 @@ render itself as a string that can be used in a list management header All attributes are read-only. -=attr C<uri> +=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. -=cut - -has uri => ( - is => 'ro', - isa => Uri, - required => 1, - coerce => 1, -); - -=attr C<comment> +=head2 C<comment> Optional string, will be added to the list management header as a comment (in parentheses). -=cut - -has comment => ( - is => 'ro', - isa => Str, -); +=head1 METHODS -=method C<new> +=head2 C<new> Sietima::HeaderURI->new({ uri => 'http://foo/', comment => 'a thing', @@ -97,50 +177,7 @@ 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' 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 }; - }; -}; - -=method C<new_from_address> +=head2 C<new_from_address> Sietima::HeaderURI->new_from_address( $email_address, @@ -156,20 +193,7 @@ you provide. It's a shortcut for: 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( - ClassName, - Address->plus_coercions(AddressFromStr), - Optional[HashRef], - ); - my ($class, $address, $query) = $check->(@_); - - return $class->new(_args_from_address($address,$query)); -} - -=method C<as_header_raw> +=head2 C<as_header_raw> $mail->header_raw_set('List-Thing' => $headeruri->as_header_raw); @@ -194,17 +218,17 @@ 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 +=for Pod::Coverage BUILDARGS -sub as_header_raw { - my ($self) = @_; +=head1 AUTHOR - my $str = sprintf '<%s>',$self->uri; - if (my $c = $self->comment) { - $str .= sprintf ' (%s)',$c; - } +Gianni Ceccarelli <dakkar@thenautilus.net> - return $str; -} +=head1 COPYRIGHT AND LICENSE -1; +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 5e6fc7f..d009dc0 100644 --- a/lib/Sietima/MailStore.pm +++ b/lib/Sietima/MailStore.pm @@ -3,15 +3,38 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: interface for mail stores + +requires 'store', + 'retrieve_ids_by_tags','retrieve_by_tags','retrieve_by_id', + 'remove','clear'; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::MailStore - interface for mail stores + +=head1 VERSION + +version 1.0.2 + =head1 DESCRIPTION This role defines the interface that all mail stores must adhere to. It does not provide any implementation. -=require C<store> +=head1 REQUIRED METHODS + +=head2 C<store> my $id = $ms->store($email_mime_object,@tags); @@ -21,7 +44,7 @@ tags (which must be strings). Must return a unique identifier for the stored message. It is acceptable if identical messages are indistinguishable by the storage. -=require C<retrieve_by_id> +=head2 C<retrieve_by_id> my $email_mime_object = $ms->retrieve_by_id($id); @@ -32,7 +55,7 @@ C<Email::MIME> >> object). If the message has been deleted, or the identifier is not recognised, this method must return C<undef> in scalar context. -=require C<retrieve_ids_by_tags> +=head2 C<retrieve_ids_by_tags> my @ids = $ms->retrieve_ids_by_tags(@tags)->@*; @@ -55,7 +78,7 @@ For example: $ms->retrieve_ids_by_tags('t1','t2') ==> [ $id3 ] $ms->retrieve_ids_by_tags('t3') ==> [ ] -=require C<retrieve_by_tags> +=head2 C<retrieve_by_tags> my @email_mime_objects = $ms->retrieve_by_tags(@tags)->@*; @@ -71,7 +94,7 @@ return an arrayref of hashrefs. For example: { id => $id1, mail => $msg1 }, ] -=require C<remove> +=head2 C<remove> $ms->remove($id); @@ -79,17 +102,22 @@ This method must remove the message corresponding to the given identifier from the persistent storage. Removing a non-existent message must succeed, and do nothing. -=require C<clear> +=head2 C<clear> $ms->clear(); This method must remove all messages from the persistent storage. Clearing an empty store must succeed, and do nothing. -=cut +=head1 AUTHOR -requires 'store', - 'retrieve_ids_by_tags','retrieve_by_tags','retrieve_by_id', - 'remove','clear'; +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/FS.pm b/lib/Sietima/MailStore/FS.pm index c429dfd..7518d47 100644 --- a/lib/Sietima/MailStore/FS.pm +++ b/lib/Sietima/MailStore/FS.pm @@ -8,40 +8,12 @@ use Sietima::Types qw(EmailMIME TagName); use Digest::SHA qw(sha1_hex); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: filesystem-backed email store -=head1 SYNOPSIS - - my $store = Sietima::MailStore::FS->new({ root => '/tmp/my-store' }); - -=head1 DESCRIPTION - -This class implements the L<< C<Sietima::MailStore> >> interface, -storing emails as files on disk. - -=cut with 'Sietima::MailStore'; -=attr C<root> - -Required, a L<< C<Path::Tiny> >> object that points to an existing -directory. Coercible from a string. - -It's a good idea for the directory to be readable and writable by the -user who will run the mailing list, and also by all users who will run -administrative commands (like those provided by L<< -C<Sietima::Role::SubscriberOnly::Moderate> >>). A way to achieve that -is to have a group dedicated to list owners, and set the directory -group-writable and group-sticky, and owned by that group: - - # chgrp -R mailinglists /tmp/my-store - # chmod -R g+rwXs /tmp/my-store - -=for Pod::Coverage BUILD - -=cut has root => ( is => 'ro', @@ -59,18 +31,6 @@ sub BUILD($self,@) { return; } -=method C<store> - - my $id = $store->store($email_mime_object,@tags); - -Stores the given email message inside the L<store root|/root>, and -associates with the given tags. - -Returns a unique identifier for the stored message. If you store twice -the same message (or two messages that stringify identically), you'll -get the same identifier. - -=cut sub store($self,$mail,@tags) { state $check = compile(Object,EmailMIME,slurpy ArrayRef[TagName]);$check->(@_); @@ -85,18 +45,6 @@ sub store($self,$mail,@tags) { return $id; } -=method C<retrieve_by_id> - - my $email_mime_object = $store->retrieve_by_id($id); - -Given an identifier returned by L<< /C<store> >>, this method returns -the email message. - -If the message has been deleted, or the identifier is not recognised, -this method returns C<undef> in scalar context, or an empty list in -list context. - -=cut sub retrieve_by_id($self,$id) { state $check = compile(Object,Str);$check->(@_); @@ -106,19 +54,6 @@ sub retrieve_by_id($self,$id) { return Email::MIME->new($msg_path->slurp_raw); } -=method C<retrieve_ids_by_tags> - - my @ids = $store->retrieve_ids_by_tags(@tags)->@*; - -Given a list of tags, this method returns an arrayref containing the -identifiers of all (and only) the messages that were stored associated -with (at least) all those tags. The order of the returned identifiers -is essentially random. - -If there are no messages associated with the given tags, this method -returns an empty arrayref. - -=cut sub _tagged_by($self,$tag) { my $tag_file = $self->_tagdir->child($tag); @@ -150,19 +85,6 @@ sub retrieve_ids_by_tags($self,@tags) { return \@ret; } -=method C<retrieve_by_tags> - - my @email_mime_objects = $store->retrieve_by_tags(@tags)->@*; - -This method is similar to L<< /C<retrieve_ids_by_tags> >>, but it -returns an arrayref of hashrefs like: - - $store->retrieve_ids_by_tags('t1') ==> [ - { id => $id1, mail => $msg1 }, - { id => $id2, mail => $msg2 }, - ] - -=cut sub retrieve_by_tags($self,@tags) { state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_); @@ -178,14 +100,6 @@ sub retrieve_by_tags($self,@tags) { return \@ret; } -=method C<remove> - - $store->remove($id); - -This method removes the message corresponding to the given identifier -from disk. Removing a non-existent message does nothing. - -=cut sub remove($self,$id) { state $check = compile(Object,Str);$check->(@_); @@ -198,19 +112,127 @@ sub remove($self,$id) { return; } -=method C<clear> + +sub clear($self) { + do { $self->$_->remove_tree;$self->$_->mkpath } for qw(_tagdir _msgdir); + return; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::MailStore::FS - filesystem-backed email store + +=head1 VERSION + +version 1.0.2 + +=head1 SYNOPSIS + + my $store = Sietima::MailStore::FS->new({ root => '/tmp/my-store' }); + +=head1 DESCRIPTION + +This class implements the L<< C<Sietima::MailStore> >> interface, +storing emails as files on disk. + +=head1 ATTRIBUTES + +=head2 C<root> + +Required, a L<< C<Path::Tiny> >> object that points to an existing +directory. Coercible from a string. + +It's a good idea for the directory to be readable and writable by the +user who will run the mailing list, and also by all users who will run +administrative commands (like those provided by L<< +C<Sietima::Role::SubscriberOnly::Moderate> >>). A way to achieve that +is to have a group dedicated to list owners, and set the directory +group-writable and group-sticky, and owned by that group: + + # chgrp -R mailinglists /tmp/my-store + # chmod -R g+rwXs /tmp/my-store + +=head1 METHODS + +=head2 C<store> + + my $id = $store->store($email_mime_object,@tags); + +Stores the given email message inside the L<store root|/root>, and +associates with the given tags. + +Returns a unique identifier for the stored message. If you store twice +the same message (or two messages that stringify identically), you'll +get the same identifier. + +=head2 C<retrieve_by_id> + + my $email_mime_object = $store->retrieve_by_id($id); + +Given an identifier returned by L<< /C<store> >>, this method returns +the email message. + +If the message has been deleted, or the identifier is not recognised, +this method returns C<undef> in scalar context, or an empty list in +list context. + +=head2 C<retrieve_ids_by_tags> + + my @ids = $store->retrieve_ids_by_tags(@tags)->@*; + +Given a list of tags, this method returns an arrayref containing the +identifiers of all (and only) the messages that were stored associated +with (at least) all those tags. The order of the returned identifiers +is essentially random. + +If there are no messages associated with the given tags, this method +returns an empty arrayref. + +=head2 C<retrieve_by_tags> + + my @email_mime_objects = $store->retrieve_by_tags(@tags)->@*; + +This method is similar to L<< /C<retrieve_ids_by_tags> >>, but it +returns an arrayref of hashrefs like: + + $store->retrieve_ids_by_tags('t1') ==> [ + { id => $id1, mail => $msg1 }, + { id => $id2, mail => $msg2 }, + ] + +=head2 C<remove> + + $store->remove($id); + +This method removes the message corresponding to the given identifier +from disk. Removing a non-existent message does nothing. + +=head2 C<clear> $store->clear(); This method removes all messages from disk. Clearing as empty store does nothing. +=for Pod::Coverage BUILD -=cut +=head1 AUTHOR -sub clear($self) { - do { $self->$_->remove_tree;$self->$_->mkpath } for qw(_tagdir _msgdir); - return; -} +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/Message.pm b/lib/Sietima/Message.pm index b0d82e6..3b6eb92 100644 --- a/lib/Sietima/Message.pm +++ b/lib/Sietima/Message.pm @@ -10,9 +10,62 @@ use Sietima::Subscriber; use Email::MIME; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: an email message with an envelope + +has mail => ( + is => 'ro', + isa => EmailMIME, + required => 1, +); + + +has from => ( + is => 'ro', + isa => Address, + coerce => AddressFromStr, + required => 1, +); + + +my $subscriber_array = ArrayRef[ + Subscriber->plus_coercions( + SubscriberFromStr, + SubscriberFromAddress, + ) +]; +has to => ( + isa => $subscriber_array, + is => 'ro', + coerce => $subscriber_array->coercion, + required => 1, +); + + +sub envelope ($self) { + return { + from => $self->from, + to => [ map { $_->address } $self->to->@* ], + } +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Message - an email message with an envelope + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS use Sietima::Message; @@ -34,67 +87,39 @@ C<Sietima::send_message>|Sietima/send_message >>. All attributes are read-only and required. -=attr C<mail> +=head2 C<mail> An L<< C<Email::MIME> >> object, representing the message. -=cut - -has mail => ( - is => 'ro', - isa => EmailMIME, - required => 1, -); - -=attr C<from> +=head2 C<from> An L<< C<Email::Address> >> object, coercible from a string, representing the sender. -=cut - -has from => ( - is => 'ro', - isa => Address, - coerce => AddressFromStr, - required => 1, -); - -=attr C<to> +=head2 C<to> An arrayref of L<< C<Sietima::Subscriber> >> objects, each coercible from a string or an L<< C<Email::Address> >> object, representing the recipients. -=cut - -my $subscriber_array = ArrayRef[ - Subscriber->plus_coercions( - SubscriberFromStr, - SubscriberFromAddress, - ) -]; -has to => ( - isa => $subscriber_array, - is => 'ro', - coerce => $subscriber_array->coercion, - required => 1, -); +=head1 METHODS -=method C<envelope> +=head2 C<envelope> my %envelope = $message->envelope->%*; Returns a hashref with envelope data, suitable for use with L<< C<Email::Sender::Transport::send>|Email::Sender::Transport/send >>. -=cut +=head1 AUTHOR -sub envelope ($self) { - return { - from => $self->from, - to => [ map { $_->address } $self->to->@* ], - } -} +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/Policy.pm b/lib/Sietima/Policy.pm index 73af98e..03af93b 100644 --- a/lib/Sietima/Policy.pm +++ b/lib/Sietima/Policy.pm @@ -5,9 +5,36 @@ use warnings; use feature ':5.24'; use experimental 'signatures'; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: pragma for Sietima modules + +sub import { + # These affect the currently compiling scope, + # so no need for import::into + strict->import; + warnings->import; + experimental->import('signatures'); + feature->import(':5.24'); + return; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Policy - pragma for Sietima modules + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS use 5.024; @@ -25,16 +52,15 @@ or just: This module imports the pragmas shown in the L</synopsis>. All Sietima modules use it. -=cut +=head1 AUTHOR -sub import { - # These affect the currently compiling scope, - # so no need for import::into - strict->import; - warnings->import; - experimental->import('signatures'); - feature->import(':5.24'); - return; -} +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/Role/AvoidDups.pm b/lib/Sietima/Role/AvoidDups.pm index e0a5bae..c881ceb 100644 --- a/lib/Sietima/Role/AvoidDups.pm +++ b/lib/Sietima/Role/AvoidDups.pm @@ -4,26 +4,9 @@ use Sietima::Policy; use Email::Address; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: prevent people from receiving the same message multiple times -=head1 SYNOPSIS - - my $sietima = Sietima->with_traits('AvoidDups')->new(\%args); - -=head1 DESCRIPTION - -A L<< C<Sietima> >> list with this role applied will not send a -message to a subscriber, if that subscriber is already mentioned in -the C<To:> or C<Cc:> header fields, because they can be assumed to be -already receiving the message directly from the sender. - -=modif C<subscribers_to_send_to> - -Filters out subscribers that L<match|Sietima::Subscriber/match> the -addresses in the C<To:> or C<Cc:> headers of the incoming email. - -=cut around subscribers_to_send_to => sub ($orig,$self,$mail) { my @already_receiving = map { @@ -43,3 +26,48 @@ around subscribers_to_send_to => sub ($orig,$self,$mail) { }; 1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::AvoidDups - prevent people from receiving the same message multiple times + +=head1 VERSION + +version 1.0.2 + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('AvoidDups')->new(\%args); + +=head1 DESCRIPTION + +A L<< C<Sietima> >> list with this role applied will not send a +message to a subscriber, if that subscriber is already mentioned in +the C<To:> or C<Cc:> header fields, because they can be assumed to be +already receiving the message directly from the sender. + +=head1 MODIFIED METHODS + +=head2 C<subscribers_to_send_to> + +Filters out subscribers that L<match|Sietima::Subscriber/match> the +addresses in the C<To:> or C<Cc:> headers of the incoming email. + +=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/Role/Debounce.pm b/lib/Sietima/Role/Debounce.pm index e6bd087..6f5cc5c 100644 --- a/lib/Sietima/Role/Debounce.pm +++ b/lib/Sietima/Role/Debounce.pm @@ -3,9 +3,41 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: avoid mail loops + +my $been_there = 'X-Been-There'; + +around munge_mail => sub ($orig,$self,$incoming_mail) { + my $return_path = $self->return_path->address; + if (my $there = $incoming_mail->header_str($been_there)) { + return if $there =~ m{\b\Q$return_path\E\b}; + } + + $incoming_mail->header_str_set( + $been_there => $return_path, + ); + + return $self->$orig($incoming_mail); +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::Debounce - avoid mail loops + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('Debounce')->new(\%args); @@ -18,28 +50,24 @@ have that same header. This prevents messages bounced by other services from being looped between the mailing list and those other services. -=modif C<munge_mail> +=head1 MODIFIED METHODS + +=head2 C<munge_mail> If the incoming email contains our C<X-Been-There:> header, this method will return an empty list (essentially dropping the message). Otherwise, the header is added, and the email is processed normally. -=cut +=head1 AUTHOR -my $been_there = 'X-Been-There'; +Gianni Ceccarelli <dakkar@thenautilus.net> -around munge_mail => sub ($orig,$self,$incoming_mail) { - my $return_path = $self->return_path->address; - if (my $there = $incoming_mail->header_str($been_there)) { - return if $there =~ m{\b\Q$return_path\E\b}; - } +=head1 COPYRIGHT AND LICENSE - $incoming_mail->header_str_set( - $been_there => $return_path, - ); +This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. - return $self->$orig($incoming_mail); -}; +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. -1; +=cut diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm index 794a5e9..359f45f 100644 --- a/lib/Sietima/Role/Headers.pm +++ b/lib/Sietima/Role/Headers.pm @@ -8,61 +8,9 @@ use Types::Standard qw(Str); use Sietima::Types qw(HeaderUriFromThings); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: adds standard list-related headers to messages -=head1 SYNOPSIS - - my $sietima = Sietima->with_traits('Headers')->new({ - %args, - name => $name_of_the_list, - }); - -=head1 DESCRIPTION - -A L<< C<Sietima> >> list with this role applied will add, to each -outgoing message, the set of headers defined in RFC 2919 and RFC 2369. - -This role uses the L<< C<list_addresses>|Sietima/list_addresses >> -method to determine what headers to add. - -If the C<name> attribute is set, a C<List-Id:> header will be added, -with a value built out of the name and the C<< -$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. 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> - -Optional string, the name of the mailing list. If this attribute is -set, a C<List-Id:> header will be added, with a value built out of the -name and the C<< $self->list_addresses->{return_path} >> value (which -is normally the same as the L<< C<return_path>|Sietima/return_path >> -attribute). - -=cut has name => ( isa => Str, @@ -120,12 +68,6 @@ sub _add_headers_to($self,$message) { return; } -=modif C<munge_mail> - -This method adds list-management headers to each message returned by -the original method. - -=cut around munge_mail => sub ($orig,$self,$mail) { my @messages = $self->$orig($mail); @@ -134,3 +76,107 @@ around munge_mail => sub ($orig,$self,$mail) { }; 1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::Headers - adds standard list-related headers to messages + +=head1 VERSION + +version 1.0.2 + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('Headers')->new({ + %args, + name => $name_of_the_list, + }); + +=head1 DESCRIPTION + +A L<< C<Sietima> >> list with this role applied will add, to each +outgoing message, the set of headers defined in RFC 2919 and RFC 2369. + +This role uses the L<< C<list_addresses>|Sietima/list_addresses >> +method to determine what headers to add. + +If the C<name> attribute is set, a C<List-Id:> header will be added, +with a value built out of the name and the C<< +$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. 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 + +=head2 C<name> + +Optional string, the name of the mailing list. If this attribute is +set, a C<List-Id:> header will be added, with a value built out of the +name and the C<< $self->list_addresses->{return_path} >> value (which +is normally the same as the L<< C<return_path>|Sietima/return_path >> +attribute). + +=head1 MODIFIED METHODS + +=head2 C<munge_mail> + +This method adds list-management headers to each message returned by +the original method. + +=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/Role/ManualSubscription.pm b/lib/Sietima/Role/ManualSubscription.pm index c2711f0..54d4b63 100644 --- a/lib/Sietima/Role/ManualSubscription.pm +++ b/lib/Sietima/Role/ManualSubscription.pm @@ -4,11 +4,45 @@ use Sietima::Policy; use Sietima::HeaderURI; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: adds standard list-related headers to messages with 'Sietima::Role::WithOwner'; + +around list_addresses => sub($orig,$self) { + my $list_name = $self->name // 'the list'; + + return +{ + $self->$orig->%*, + 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" }, + ), + }; +}; + + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::ManualSubscription - adds standard list-related headers to messages + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits( @@ -26,29 +60,23 @@ C<Headers>|Sietima::Role::Headers >>) applied will add, to each outgoing message, headers specifying that to subscribe and unsubscribe, people sould email the list owner. -=modif C<list_addresses> +=head1 MODIFIED METHODS + +=head2 C<list_addresses> This method declares two "addresses", C<subscribe> and C<unsubscribe>. Both are C<mailto:> URLs for the list L<owner|Sietima::Role::WithOwner/owner>, with different subjects. -=cut +=head1 AUTHOR -around list_addresses => sub($orig,$self) { - my $list_name = $self->name // 'the list'; +Gianni Ceccarelli <dakkar@thenautilus.net> - return +{ - $self->$orig->%*, - 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" }, - ), - }; -}; +=head1 COPYRIGHT AND LICENSE +This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. -1; +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/Role/NoMail.pm b/lib/Sietima/Role/NoMail.pm index 10071d6..20e7e5c 100644 --- a/lib/Sietima/Role/NoMail.pm +++ b/lib/Sietima/Role/NoMail.pm @@ -3,9 +3,33 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: don't send mail to those who don't want it + +around subscribers_to_send_to => sub ($orig,$self,$mail) { + return [ + grep { $_->prefs->{wants_mail} // 1 } + $self->$orig($mail)->@*, + ]; +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::NoMail - don't send mail to those who don't want it + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('NoMail')->new({ @@ -22,18 +46,22 @@ A L<< C<Sietima> >> list with this role applied will not send messages to subscribers that have the C<wants_mail> preference set to a false value. -=modif C<subscribers_to_send_to> +=head1 MODIFIED METHODS + +=head2 C<subscribers_to_send_to> Filters out subscribers that have the C<wants_mail> preference set to a false value. -=cut +=head1 AUTHOR -around subscribers_to_send_to => sub ($orig,$self,$mail) { - return [ - grep { $_->prefs->{wants_mail} // 1 } - $self->$orig($mail)->@*, - ]; -}; +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/Role/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm index 6b21f20..96969bf 100644 --- a/lib/Sietima/Role/ReplyTo.pm +++ b/lib/Sietima/Role/ReplyTo.pm @@ -6,9 +6,79 @@ use Sietima::Types qw(Address AddressFromStr); use List::AllUtils qw(part); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: munge the C<Reply-To> header + +with 'Sietima::Role::WithPostAddress'; + + +has munge_reply_to => ( + is => 'ro', + isa => Bool, + default => 0, +); + + +around munge_mail => sub ($orig,$self,$mail) { + my @messages = $self->$orig($mail); + my @ret; + for my $m (@messages) { + my ($leave,$munge) = part { + my $m = $_->prefs->{munge_reply_to}; + defined $m ? ( + $m ? 1 : 0 + ) : ( $self->munge_reply_to ? 1 : 0 ) + } $m->to->@*; + + if (not ($munge and $munge->@*)) { + # nothing to do + push @ret,$m; + } + elsif (not ($leave and $leave->@*)) { + # all these recipients want munging + $m->mail->header_str_set('Reply-To',$self->post_address->address); + push @ret,$m; + } + else { + # some want it, some don't: create two different messages + my $leave_message = Sietima::Message->new({ + mail => $m->mail, + from => $m->from, + to => $leave, + }); + + my $munged_mail = Email::MIME->new($m->mail->as_string); + $munged_mail->header_str_set('Reply-To',$self->post_address->address); + + my $munged_message = Sietima::Message->new({ + mail => $munged_mail, + from => $m->from, + to => $munge, + }); + + push @ret,$leave_message,$munged_message; + } + } + return @ret; +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::ReplyTo - munge the C<Reply-To> header + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('ReplyTo')->new({ @@ -36,26 +106,18 @@ not touched. This is a "sub-role" of L<< C<WithPostAddress>|Sietima::Role::WithPostAddress >>. -=cut - -with 'Sietima::Role::WithPostAddress'; +=head1 ATTRIBUTES -=attr C<munge_reply_to> +=head2 C<munge_reply_to> Optional boolean, defaults to false. If set to a true value, all messages will have their C<Reply-To:> header set to the value of the L<< /C<post_address> >> attribute. This setting can be overridden by individual subscribers with the C<munge_reply_to> preference. -=cut - -has munge_reply_to => ( - is => 'ro', - isa => Bool, - default => 0, -); +=head1 MODIFIED METHODS -=modif C<munge_mail> +=head2 C<munge_mail> For each message returned by the original method, this method partitions the subscribers, who are recipients of the message, @@ -74,49 +136,15 @@ don't, this method will clone the message, modify the header in one copy, set the appropriate part of the recipients to each copy, and pass both through. -=cut +=head1 AUTHOR -around munge_mail => sub ($orig,$self,$mail) { - my @messages = $self->$orig($mail); - my @ret; - for my $m (@messages) { - my ($leave,$munge) = part { - my $m = $_->prefs->{munge_reply_to}; - defined $m ? ( - $m ? 1 : 0 - ) : ( $self->munge_reply_to ? 1 : 0 ) - } $m->to->@*; +Gianni Ceccarelli <dakkar@thenautilus.net> - if (not ($munge and $munge->@*)) { - # nothing to do - push @ret,$m; - } - elsif (not ($leave and $leave->@*)) { - # all these recipients want munging - $m->mail->header_str_set('Reply-To',$self->post_address->address); - push @ret,$m; - } - else { - # some want it, some don't: create two different messages - my $leave_message = Sietima::Message->new({ - mail => $m->mail, - from => $m->from, - to => $leave, - }); - - my $munged_mail = Email::MIME->new($m->mail->as_string); - $munged_mail->header_str_set('Reply-To',$self->post_address->address); +=head1 COPYRIGHT AND LICENSE - my $munged_message = Sietima::Message->new({ - mail => $munged_mail, - from => $m->from, - to => $munge, - }); +This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. - push @ret,$leave_message,$munged_message; - } - } - return @ret; -}; +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. -1; +=cut diff --git a/lib/Sietima/Role/SubjectTag.pm b/lib/Sietima/Role/SubjectTag.pm index 7602405..5a4e95c 100644 --- a/lib/Sietima/Role/SubjectTag.pm +++ b/lib/Sietima/Role/SubjectTag.pm @@ -4,9 +4,44 @@ use Sietima::Policy; use Types::Standard qw(Str); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: add a tag to messages' subjects + +has subject_tag => ( + is => 'ro', + isa => Str, + required => 1, +); + + +around munge_mail => sub ($orig,$self,$mail) { + my $tag = '['.$self->subject_tag.']'; + my $subject = $mail->header_str('Subject'); + unless ($subject =~ m{\Q$tag\E}) { + $mail->header_str_set( + Subject => "$tag $subject", + ); + } + return $self->$orig($mail); +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::SubjectTag - add a tag to messages' subjects + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('SubjectTag')->new({ @@ -19,7 +54,9 @@ use namespace::clean; A L<< C<Sietima> >> list with this role applied will prepend the given tag to every outgoing message's C<Subject:> header. -=attr C<subject_tag> +=head1 ATTRIBUTES + +=head2 C<subject_tag> Required string. This string, enclosed by square brackets, will be prepended to the C<Subject:> header of outgoing messages. For example, @@ -30,30 +67,22 @@ If the incoming message's C<Subject:> header already contains the tag, the header will not be modified. This prevents getting subjects like "[foo] Re: [foo] Re: [foo] new stuff". -=cut +=head1 MODIFIED METHODS -has subject_tag => ( - is => 'ro', - isa => Str, - required => 1, -); - -=modif C<munge_mail> +=head2 C<munge_mail> The subject of the incoming email is modified to add the tag (unless it's already there). The email is then processed normally. -=cut +=head1 AUTHOR -around munge_mail => sub ($orig,$self,$mail) { - my $tag = '['.$self->subject_tag.']'; - my $subject = $mail->header_str('Subject'); - unless ($subject =~ m{\Q$tag\E}) { - $mail->header_str_set( - Subject => "$tag $subject", - ); - } - return $self->$orig($mail); -}; +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm index 6524d39..c094881 100644 --- a/lib/Sietima/Role/SubscriberOnly.pm +++ b/lib/Sietima/Role/SubscriberOnly.pm @@ -7,9 +7,50 @@ use Types::Standard qw(Object CodeRef); use Type::Params qw(compile); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: base role for "closed" lists + +requires 'munge_mail_from_non_subscriber'; + +our $let_it_pass=0; ## no critic(ProhibitPackageVars) + + +around munge_mail => sub ($orig,$self,$mail) { + my ($from) = Email::Address->parse( $mail->header_str('from') ); + if ( $let_it_pass or + any { $_->match($from) } $self->subscribers->@* ) { + $self->$orig($mail); + } + else { + $self->munge_mail_from_non_subscriber($mail); + } +}; + + +sub ignoring_subscriberonly($self,$code) { + state $check = compile(Object,CodeRef); $check->(@_); + + local $let_it_pass = 1; + return $code->($self); +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::SubscriberOnly - base role for "closed" lists + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS package Sietima::Role::SubscriberOnly::MyPolicy; @@ -29,7 +70,9 @@ with messages from non-subscribers. See L<< C<Sietima::Role::SubscriberOnly::Drop> >> and L<< C<Sietima::Role::SubscriberOnly::Moderate> >> for useable roles. -=require C<munge_mail_from_non_subscriber> +=head1 REQUIRED METHODS + +=head2 C<munge_mail_from_non_subscriber> sub munge_mail_from_non_subscriber($self,$mail) { ... } @@ -40,50 +83,37 @@ of L<< C<Sietima::Message> >> objects, just like C<munge_mail>. It can also have side-effects, like forwarding the email to the owner of the list. -=cut +=head1 METHODS -requires 'munge_mail_from_non_subscriber'; +=head2 C<ignoring_subscriberonly> -our $let_it_pass=0; ## no critic(ProhibitPackageVars) + $sietima->ignoring_subscriberonly(sub($s) { + $s->handle_mail($mail); + }); + +This method provides a way to run Sietima ignoring the "subscriber +only" beaviour. Your coderef will be passed a Sietima object that will +behave exactly as the invocant of this method, minus this role's +modifications. + +=head1 MODIFIED METHODS -=modif C<munge_mail> +=head2 C<munge_mail> If the incoming email's C<From:> header contains an address that L<matches|Sietima::Subscriber/match> any of the subscribers, the email is processed normally. Otherwise, L<< /C<munge_mail_from_non_subscriber> >> is invoked. -=cut +=head1 AUTHOR -around munge_mail => sub ($orig,$self,$mail) { - my ($from) = Email::Address->parse( $mail->header_str('from') ); - if ( $let_it_pass or - any { $_->match($from) } $self->subscribers->@* ) { - $self->$orig($mail); - } - else { - $self->munge_mail_from_non_subscriber($mail); - } -}; +Gianni Ceccarelli <dakkar@thenautilus.net> -=method C<ignoring_subscriberonly> +=head1 COPYRIGHT AND LICENSE - $sietima->ignoring_subscriberonly(sub($s) { - $s->handle_mail($mail); - }); +This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. -This method provides a way to run Sietima ignoring the "subscriber -only" beaviour. Your coderef will be passed a Sietima object that will -behave exactly as the invocant of this method, minus this role's -modifications. +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 - -sub ignoring_subscriberonly($self,$code) { - state $check = compile(Object,CodeRef); $check->(@_); - - local $let_it_pass = 1; - return $code->($self); -} - -1; diff --git a/lib/Sietima/Role/SubscriberOnly/Drop.pm b/lib/Sietima/Role/SubscriberOnly/Drop.pm index d9de94e..04bef90 100644 --- a/lib/Sietima/Role/SubscriberOnly/Drop.pm +++ b/lib/Sietima/Role/SubscriberOnly/Drop.pm @@ -3,9 +3,31 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: drop messages from non-subscribers + +with 'Sietima::Role::SubscriberOnly'; + + +sub munge_mail_from_non_subscriber { } + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::SubscriberOnly::Drop - drop messages from non-subscribers + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('SubscribersOnly::Drop')->new({ @@ -21,16 +43,21 @@ subscribers. This is a "sub-role" of L<< C<SubscribersOnly>|Sietima::Role::SubscriberOnly >>. -=cut - -with 'Sietima::Role::SubscriberOnly'; +=head1 METHODS -=method C<munge_mail_from_non_subscriber> +=head2 C<munge_mail_from_non_subscriber> Does nothing, returns an empty list. -=cut +=head1 AUTHOR -sub munge_mail_from_non_subscriber { } +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm index c4d62c9..2e25ed2 100644 --- a/lib/Sietima/Role/SubscriberOnly/Moderate.pm +++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm @@ -5,46 +5,14 @@ use Email::Stuffer; use Email::MIME; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: moderate messages from non-subscribers -=head1 SYNOPSIS - - my $sietima = Sietima->with_traits('SubscribersOnly::Moderate')->new({ - %args, - owner => 'listmaster@example.com', - mail_store => { - class => 'Sietima::MailStore::FS', - root => '/tmp', - }, - }); - -=head1 DESCRIPTION - -A L<< C<Sietima> >> list with this role applied will accept incoming -emails coming from non-subscribers, and store it for moderation. Each -such email will be forwarded (as an attachment) to the list's owner. - -The owner will the be able to delete the message, or allow it. - -This is a "sub-role" of L<< -C<SubscribersOnly>|Sietima::Role::SubscriberOnly >>, L<< -C<WithMailStore>|Sietima::Role::WithMailStore >>, and L<< -C<WithOwner>|Sietima::Role::WithOwner >>. - -=cut with 'Sietima::Role::SubscriberOnly', 'Sietima::Role::WithMailStore', 'Sietima::Role::WithOwner'; -=method C<munge_mail_from_non_subscriber> - -L<Stores|Sietima::MailStore/store> the email with the C<moderation> -tag, and forwards it to the L<list -owner|Sietima::Role::WithOwner/owner>. - -=cut sub munge_mail_from_non_subscriber ($self,$mail) { my $id = $self->mail_store->store($mail,'moderation'); @@ -67,17 +35,6 @@ sub munge_mail_from_non_subscriber ($self,$mail) { return; } -=method C<resume> - - $sietima->resume($mail_id); - -Given an identifier returned when L<storing|Sietima::MailStore/store> -an email, this method retrieves the email and re-processes it via L<< -C<ignoring_subscriberonly>|Sietima::Role::SubscriberOnly/ignoring_subscriberonly ->>. This will make sure that the email is not caught again by the -subscriber-only filter. - -=cut sub resume ($self,$mail_id) { my $mail = $self->mail_store->retrieve_by_id($mail_id); @@ -87,32 +44,11 @@ sub resume ($self,$mail_id) { $self->mail_store->remove($mail_id); } -=method C<drop> - - $sietima->drop($mail_id); - -Given an identifier returned when L<storing|Sietima::MailStore/store> -an email, this method deletes the email from the store. - -=cut sub drop ($self,$mail_id) { $self->mail_store->remove($mail_id); } -=method C<list_mails_in_moderation_queue> - - $sietima->list_mails_in_moderation_queue($sietima_runner); - -This method L<retrieves all the -identifiers|Sietima::MailStore/retrieve_by_tags> of messages tagged -C<moderation>, and L<prints them out|App::Spec::Runner/out> via the -L<< C<Sietima::Runner> >> object. - -This method is usually invoked from the command line, see L<< -/C<command_line_spec> >>. - -=cut sub list_mails_in_moderation_queue ($self,$runner,@) { my $mails = $self->mail_store->retrieve_by_tags('moderation'); @@ -127,18 +63,6 @@ sub list_mails_in_moderation_queue ($self,$runner,@) { } } -=method C<show_mail_from_moderation_queue> - - $sietima->show_mail_from_moderation_queue($sietima_runner); - -This method L<retrieves the email|Sietima::MailStore/retrieve_by_id> -of the message requested from the command line, and L<prints it -out|App::Spec::Runner/out> via the L<< C<Sietima::Runner> >> object. - -This method is usually invoked from the command line, see L<< -/C<command_line_spec> >>. - -=cut sub show_mail_from_moderation_queue ($self,$runner,@) { my $id = $runner->parameters->{'mail-id'}; @@ -147,45 +71,6 @@ sub show_mail_from_moderation_queue ($self,$runner,@) { $runner->out($mail->as_string =~ s{\r\n}{\n}gr); } -=modif C<command_line_spec> - -This method adds the following sub-commands for the command line: - -=over - -=item C<list-held> - - $ sietima list-held - -Invokes the L<< /C<list_mails_in_moderation_queue> >> method, printing -the identifiers of all messages held for moderation. - -=item C<show-held> - - $ sietima show-held 32946p6eu7867 - -Invokes the L<< /C<show_mail_from_moderation_queue> >> method, -printing one message held for moderation; the identifier is expected -as a positional parameter. - -=item C<resume-held> - - $ sietima resume-held 32946p6eu7867 - -Invokes the L<< /C<resume> >> method, causing the held message to be -processed normally; the identifier is expected as a positional -parameter. - -=item C<drop-held> - - $ sietima drop-held 32946p6eu7867 - -Invokes the L<< /C<drop> >> method, removing the held message; the -identifier is expected as a positional parameter. - -=back - -=cut around command_line_spec => sub ($orig,$self) { my $spec = $self->$orig(); @@ -235,3 +120,142 @@ around command_line_spec => sub ($orig,$self) { }; 1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::SubscriberOnly::Moderate - moderate messages from non-subscribers + +=head1 VERSION + +version 1.0.2 + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('SubscribersOnly::Moderate')->new({ + %args, + owner => 'listmaster@example.com', + mail_store => { + class => 'Sietima::MailStore::FS', + root => '/tmp', + }, + }); + +=head1 DESCRIPTION + +A L<< C<Sietima> >> list with this role applied will accept incoming +emails coming from non-subscribers, and store it for moderation. Each +such email will be forwarded (as an attachment) to the list's owner. + +The owner will the be able to delete the message, or allow it. + +This is a "sub-role" of L<< +C<SubscribersOnly>|Sietima::Role::SubscriberOnly >>, L<< +C<WithMailStore>|Sietima::Role::WithMailStore >>, and L<< +C<WithOwner>|Sietima::Role::WithOwner >>. + +=head1 METHODS + +=head2 C<munge_mail_from_non_subscriber> + +L<Stores|Sietima::MailStore/store> the email with the C<moderation> +tag, and forwards it to the L<list +owner|Sietima::Role::WithOwner/owner>. + +=head2 C<resume> + + $sietima->resume($mail_id); + +Given an identifier returned when L<storing|Sietima::MailStore/store> +an email, this method retrieves the email and re-processes it via L<< +C<ignoring_subscriberonly>|Sietima::Role::SubscriberOnly/ignoring_subscriberonly +>>. This will make sure that the email is not caught again by the +subscriber-only filter. + +=head2 C<drop> + + $sietima->drop($mail_id); + +Given an identifier returned when L<storing|Sietima::MailStore/store> +an email, this method deletes the email from the store. + +=head2 C<list_mails_in_moderation_queue> + + $sietima->list_mails_in_moderation_queue($sietima_runner); + +This method L<retrieves all the +identifiers|Sietima::MailStore/retrieve_by_tags> of messages tagged +C<moderation>, and L<prints them out|App::Spec::Runner/out> via the +L<< C<Sietima::Runner> >> object. + +This method is usually invoked from the command line, see L<< +/C<command_line_spec> >>. + +=head2 C<show_mail_from_moderation_queue> + + $sietima->show_mail_from_moderation_queue($sietima_runner); + +This method L<retrieves the email|Sietima::MailStore/retrieve_by_id> +of the message requested from the command line, and L<prints it +out|App::Spec::Runner/out> via the L<< C<Sietima::Runner> >> object. + +This method is usually invoked from the command line, see L<< +/C<command_line_spec> >>. + +=head1 MODIFIED METHODS + +=head2 C<command_line_spec> + +This method adds the following sub-commands for the command line: + +=over + +=item C<list-held> + + $ sietima list-held + +Invokes the L<< /C<list_mails_in_moderation_queue> >> method, printing +the identifiers of all messages held for moderation. + +=item C<show-held> + + $ sietima show-held 32946p6eu7867 + +Invokes the L<< /C<show_mail_from_moderation_queue> >> method, +printing one message held for moderation; the identifier is expected +as a positional parameter. + +=item C<resume-held> + + $ sietima resume-held 32946p6eu7867 + +Invokes the L<< /C<resume> >> method, causing the held message to be +processed normally; the identifier is expected as a positional +parameter. + +=item C<drop-held> + + $ sietima drop-held 32946p6eu7867 + +Invokes the L<< /C<drop> >> method, removing the held message; the +identifier is expected as a positional parameter. + +=back + +=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/Role/WithMailStore.pm b/lib/Sietima/Role/WithMailStore.pm index 7ca4b4e..bae16ee 100644 --- a/lib/Sietima/Role/WithMailStore.pm +++ b/lib/Sietima/Role/WithMailStore.pm @@ -4,9 +4,33 @@ use Sietima::Policy; use Sietima::Types qw(MailStore MailStoreFromHashRef); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: role for lists with a store for messages + +has mail_store => ( + is => 'ro', + isa => MailStore, + required => 1, + coerce => MailStoreFromHashRef, +); + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::WithMailStore - role for lists with a store for messages + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('WithMailStore')->new({ @@ -25,7 +49,9 @@ On its own, this role is not very useful, but other roles (like L<< C<SubscriberOnly::Moderate>|Sietima::Role::SubscriberOnly::Moderate >>) can have uses for an object that can persistently store messages. -=attr C<mail_store> +=head1 ATTRIBUTES + +=head2 C<mail_store> Required instance of an object that consumes the L<< C<Sietima::MailStore> >> role. Instead of passing an instance, you can @@ -33,13 +59,15 @@ pass a hashref (like in the L</synopsis>): the C<class> key provides the class name, and the rest of the hash will be passed to its constructor. -=cut +=head1 AUTHOR -has mail_store => ( - is => 'ro', - isa => MailStore, - required => 1, - coerce => MailStoreFromHashRef, -); +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/Role/WithOwner.pm b/lib/Sietima/Role/WithOwner.pm index 1dfd362..aa2f0a1 100644 --- a/lib/Sietima/Role/WithOwner.pm +++ b/lib/Sietima/Role/WithOwner.pm @@ -4,9 +4,41 @@ use Sietima::Policy; use Sietima::Types qw(Address AddressFromStr); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: role for lists with an owner + +has owner => ( + is => 'ro', + isa => Address, + required => 1, + coerce => AddressFromStr, +); + + +around list_addresses => sub($orig,$self) { + return +{ + $self->$orig->%*, + owner => $self->owner, + }; +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::WithOwner - role for lists with an owner + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('WithOwner')->new({ @@ -23,31 +55,28 @@ On its own, this role is not very useful, but other roles (like L<< C<SubscriberOnly::Moderate>|Sietima::Role::SubscriberOnly::Moderate >>) can have uses for an owner address. -=attr C<owner> +=head1 ATTRIBUTES + +=head2 C<owner> Required instance of L<< C<Email::Address> >>, coercible from a string. This is the address of the owner of the list. -=cut - -has owner => ( - is => 'ro', - isa => Address, - required => 1, - coerce => AddressFromStr, -); +=head1 MODIFIED METHODS -=modif C<list_addresses> +=head2 C<list_addresses> This method declares the C<owner> address. -=cut +=head1 AUTHOR -around list_addresses => sub($orig,$self) { - return +{ - $self->$orig->%*, - owner => $self->owner, - }; -}; +Gianni Ceccarelli <dakkar@thenautilus.net> -1; +=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/Role/WithPostAddress.pm b/lib/Sietima/Role/WithPostAddress.pm index 333c5e3..0ff6174 100644 --- a/lib/Sietima/Role/WithPostAddress.pm +++ b/lib/Sietima/Role/WithPostAddress.pm @@ -4,9 +4,40 @@ use Sietima::Policy; use Sietima::Types qw(Address AddressFromStr); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: role for lists with a posting address + +has post_address => ( + is => 'lazy', + isa => Address, + coerce => AddressFromStr, +); +sub _build_post_address($self) { $self->return_path } + +around list_addresses => sub($orig,$self) { + return +{ + $self->$orig->%*, + post => $self->post_address, + }; +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::WithPostAddress - role for lists with a posting address + +=head1 VERSION + +version 1.0.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('WithPostAddress')->new({ @@ -24,26 +55,23 @@ On its own, this role is not very useful, but other roles (like L<< C<ReplyTo>|Sietima::Role::ReplyTo >>) can have uses for a post address. -=attr C<post_address> +=head1 ATTRIBUTES + +=head2 C<post_address> An L<< C<Email::Address> >> object, defaults to the value of the L<< C<return_path>|Sietima/return_path >> attribute. This is the address that the mailing list receives messages at. -=cut +=head1 AUTHOR -has post_address => ( - is => 'lazy', - isa => Address, - coerce => AddressFromStr, -); -sub _build_post_address($self) { $self->return_path } +Gianni Ceccarelli <dakkar@thenautilus.net> -around list_addresses => sub($orig,$self) { - return +{ - $self->$orig->%*, - post => $self->post_address, - }; -}; +=head1 COPYRIGHT AND LICENSE -1; +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/Runner.pm b/lib/Sietima/Runner.pm index ca64348..5050db1 100644 --- a/lib/Sietima/Runner.pm +++ b/lib/Sietima/Runner.pm @@ -3,9 +3,37 @@ use Moo; use Sietima::Policy; use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: C<App::Spec::Run> for Sietima + +extends 'App::Spec::Run'; + +sub run_op($self,$op,$args=[]) { + if ($op =~ /^cmd_/) { + $self->$op($args); + } + else { + $self->cmd->$op($self,$args); + } +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Runner - C<App::Spec::Run> for Sietima + +=head1 VERSION + +version 1.0.2 + =head1 DESCRIPTION You should never need to care about this class, it's used internally @@ -18,17 +46,15 @@ delegate back via L<< C<App::Spec::Run::Cmd> >>. =for Pod::Coverage run_op -=cut +=head1 AUTHOR -extends 'App::Spec::Run'; +Gianni Ceccarelli <dakkar@thenautilus.net> -sub run_op($self,$op,$args=[]) { - if ($op =~ /^cmd_/) { - $self->$op($args); - } - else { - $self->cmd->$op($self,$args); - } -} +=head1 COPYRIGHT AND LICENSE -1; +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/Subscriber.pm b/lib/Sietima/Subscriber.pm index b62e44f..57d20de 100644 --- a/lib/Sietima/Subscriber.pm +++ b/lib/Sietima/Subscriber.pm @@ -8,26 +8,9 @@ use Email::Address; use List::AllUtils qw(any); use namespace::clean; -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: a subscriber to a mailing list -=head1 DESCRIPTION - -This class holds the primary email address for a mailing list -subscriber, together with possible aliases and preferences. - -=head1 ATTRIBUTES - -All attributes are read-only. - -=attr C<primary> - -Required L<< C<Email::Address> >> object, coercible from a string. - -This is the primary address for the subscriber, the one where they -will receive messages from the mailing list. - -=cut has primary => ( isa => Address, @@ -37,17 +20,6 @@ has primary => ( handles => [qw(address name original)], ); -=attr C<aliases> - -Arrayref of L<< C<Email::Address> >> objects, each coercible from a -string. Defaults to an empty arrayref. - -These are secondary addresses that the subscriber may write -from. Subscriber-only mailing lists should accept messages from any of -these addresses as if they were from the primary. The L<< /C<match> >> -simplifies that task. - -=cut my $address_array = ArrayRef[ Address->plus_coercions( @@ -61,12 +33,6 @@ has aliases => ( ); sub _build_aliases { +[] } -=attr C<prefs> - -A hashref. Various preferences that may be interpreted by Sietima -roles. Defaults to an empty hashref. - -=cut has prefs => ( isa => HashRef, @@ -74,18 +40,6 @@ has prefs => ( default => sub { +{} }, ); -=method C<match> - - if ($subscriber->match($address)) { ... } - -Given a L<< C<Email::Address> >> object (or a string), this method -returns true if the address is equivalent to the -L</primary> or any of the L</aliases>. - -This method should be used to determine whether an address belongs to -a subscriber. - -=cut sub match { # we can't use the sub signature here, because we need the @@ -97,15 +51,85 @@ sub match { $self->primary, $self->aliases->@*; } -=method C<address> -=method C<name> +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Subscriber - a subscriber to a mailing list + +=head1 VERSION -=method C<original> +version 1.0.2 + +=head1 DESCRIPTION + +This class holds the primary email address for a mailing list +subscriber, together with possible aliases and preferences. + +=head1 ATTRIBUTES + +All attributes are read-only. + +=head2 C<primary> + +Required L<< C<Email::Address> >> object, coercible from a string. + +This is the primary address for the subscriber, the one where they +will receive messages from the mailing list. + +=head2 C<aliases> + +Arrayref of L<< C<Email::Address> >> objects, each coercible from a +string. Defaults to an empty arrayref. + +These are secondary addresses that the subscriber may write +from. Subscriber-only mailing lists should accept messages from any of +these addresses as if they were from the primary. The L<< /C<match> >> +simplifies that task. + +=head2 C<prefs> + +A hashref. Various preferences that may be interpreted by Sietima +roles. Defaults to an empty hashref. + +=head1 METHODS + +=head2 C<match> + + if ($subscriber->match($address)) { ... } + +Given a L<< C<Email::Address> >> object (or a string), this method +returns true if the address is equivalent to the +L</primary> or any of the L</aliases>. + +This method should be used to determine whether an address belongs to +a subscriber. + +=head2 C<address> + +=head2 C<name> + +=head2 C<original> These methods delegate to L<< C<Email::Address> >>'s methods of the same name, invoked on the L<primary address|/primary>. -=cut +=head1 AUTHOR -1; +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/Types.pm b/lib/Sietima/Types.pm index c6c7381..c6e1360 100644 --- a/lib/Sietima/Types.pm +++ b/lib/Sietima/Types.pm @@ -13,39 +13,100 @@ use Type::Library Subscriber SubscriberFromAddress SubscriberFromStr SubscriberFromHashRef Transport MailStore MailStoreFromHashRef); -# VERSION +our $VERSION = '1.0.2'; # VERSION # ABSTRACT: type library for Sietima -=head1 DESCRIPTION -This module is a L<< C<Type::Library> >>. It declares a few type -constraints nad coercions. +class_type SietimaObj, { class => 'Sietima' }; -=type C<SietimaObj> -An instance of L<< C<Sietima> >>. +class_type EmailMIME, { class => 'Email::MIME' }; -=cut -class_type SietimaObj, { class => 'Sietima' }; +role_type Transport, { role => 'Email::Sender::Transport' }; -=type C<EmailMIME> -An instance of L<< C<Email::MIME> >>. +role_type MailStore, { role => 'Sietima::MailStore' }; -=cut +declare_coercion MailStoreFromHashRef, + to_type MailStore, from HashRef, + q{ require Module::Runtime; } . + q{ Module::Runtime::use_module(delete $_->{class})->new($_); }; -class_type EmailMIME, { class => 'Email::MIME' }; -=type C<Transport> +class_type Address, { class => 'Email::Address' }; +declare_coercion AddressFromStr, + to_type Address, from Str, + q{ (Email::Address->parse($_))[0] }; -An object that consumes the role L<< C<Email::Sender::Transport> >>. -=cut +declare TagName, as Str, + where { /\A\w+\z/ }, + inline_as sub($constraint,$varname,@){ + $constraint->parent->inline_check($varname) + .qq{ && ($varname =~/\\A\\w+\\z/) }; + }; -role_type Transport, { role => 'Email::Sender::Transport' }; -=type C<MailStore> +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' }; + +declare_coercion SubscriberFromAddress, + to_type Subscriber, from Address, + q{ Sietima::Subscriber->new(primary=>$_) }; + +declare_coercion SubscriberFromStr, + to_type Subscriber, from Str, + q{ Sietima::Subscriber->new(primary=>(Email::Address->parse($_))[0]) }; + +declare_coercion SubscriberFromHashRef, + to_type Subscriber, from HashRef, + q{ Sietima::Subscriber->new($_) }; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Types - type library for Sietima + +=head1 VERSION + +version 1.0.2 + +=head1 DESCRIPTION + +This module is a L<< C<Type::Library> >>. It declares a few type +constraints nad coercions. + +=head1 TYPES + +=head2 C<SietimaObj> + +An instance of L<< C<Sietima> >>. + +=head2 C<EmailMIME> + +An instance of L<< C<Email::MIME> >>. + +=head2 C<Transport> + +An object that consumes the role L<< C<Email::Sender::Transport> >>. + +=head2 C<MailStore> An object that consumes the role L<< C<Sietima::MailStore> >>. @@ -69,16 +130,7 @@ the C<%constructor_args>. =back -=cut - -role_type MailStore, { role => 'Sietima::MailStore' }; - -declare_coercion MailStoreFromHashRef, - to_type MailStore, from HashRef, - q{ require Module::Runtime; } . - q{ Module::Runtime::use_module(delete $_->{class})->new($_); }; - -=type C<Address> +=head2 C<Address> An instance of L<< C<Email::Address> >>. @@ -96,42 +148,16 @@ only the first one will be used. =back -=cut - -class_type Address, { class => 'Email::Address' }; -declare_coercion AddressFromStr, - to_type Address, from Str, - q{ (Email::Address->parse($_))[0] }; - -=type C<TagName> +=head2 C<TagName> A string composed exclusively of "word" (C</\w/>) characters. Used by L<mail stores|Sietima::MailStore> to tag messages. -=cut - -declare TagName, as Str, - where { /\A\w+\z/ }, - inline_as sub($constraint,$varname,@){ - $constraint->parent->inline_check($varname) - .qq{ && ($varname =~/\\A\\w+\\z/) }; - }; - -=type C<Message> +=head2 C<Message> An instance of L<< C<Sietima::Message> >>. -=cut - -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> +=head2 C<Subscriber> An instance of L<< C<Sietima::Subscriber> >>. @@ -162,20 +188,15 @@ passing it to the constructor. =back -=cut +=head1 AUTHOR -class_type Subscriber, { class => 'Sietima::Subscriber' }; +Gianni Ceccarelli <dakkar@thenautilus.net> -declare_coercion SubscriberFromAddress, - to_type Subscriber, from Address, - q{ Sietima::Subscriber->new(primary=>$_) }; +=head1 COPYRIGHT AND LICENSE -declare_coercion SubscriberFromStr, - to_type Subscriber, from Str, - q{ Sietima::Subscriber->new(primary=>(Email::Address->parse($_))[0]) }; +This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. -declare_coercion SubscriberFromHashRef, - to_type Subscriber, from HashRef, - q{ Sietima::Subscriber->new($_) }; +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. -1; +=cut |