From 790cd95fafc32c16a7c984cd5492ba4b752a6ff2 Mon Sep 17 00:00:00 2001 From: dakkar Date: Mon, 29 Apr 2019 15:32:06 +0100 Subject: Dzil-build release 1.0.4 (from 402b4b8 on master) --- lib/Sietima.pm | 311 ++++++++++++++++++++++++++++++++------------------------- 1 file changed, 176 insertions(+), 135 deletions(-) (limited to 'lib/Sietima.pm') diff --git a/lib/Sietima.pm b/lib/Sietima.pm index 9115c05..bd02ccf 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.4'; # 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.4 + =head1 SYNOPSIS use Sietima; @@ -44,51 +166,64 @@ consumes L<< C >> to simplify composing roles: These are the traits provided with the default distribution: -=for :list -= L<< C|Sietima::Role::AvoidDups >> +=over 4 + +=item L<< C|Sietima::Role::AvoidDups >> + prevents the sender from receiving copies of their own messages -= L<< C|Sietima::Role::Debounce >> + +=item L<< C|Sietima::Role::Debounce >> + avoids mail-loops using a C header -= L<< C|Sietima::Role::Headers >> + +=item L<< C|Sietima::Role::Headers >> + adds C headers to all outgoing messages -= L<< C|Sietima::Role::ManualSubscription >> + +=item L<< C|Sietima::Role::ManualSubscription >> + specifies that to (un)subscribe, people should write to the list owner -= L<< C|Sietima::Role::NoMail >> + +=item L<< C|Sietima::Role::NoMail >> + avoids sending messages to subscribers who don't want them -= L<< C|Sietima::Role::ReplyTo >> + +=item L<< C|Sietima::Role::ReplyTo >> + optionally sets the C header to the mailing list address -= L<< C|Sietima::Role::SubjectTag >> + +=item L<< C|Sietima::Role::SubjectTag >> + prepends a C<[tag]> to the subject header of outgoing messages that aren't already tagged -= L<< C|Sietima::Role::SubscriberOnly::Drop >> + +=item L<< C|Sietima::Role::SubscriberOnly::Drop >> + silently drops all messages coming from addresses not subscribed to the list -= L<< C|Sietima::Role::SubscriberOnly::Moderate >> + +=item L<< C|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 object in your driver script, passing all the needed values to the constructor. L<< C >> is the recommended way of doing that: it adds command-line parsing capability to Sietima. -=attr C +=head1 ATTRIBUTES + +=head2 C A L<< C >> instance, coerced from string if necessary. This is the address that Sietima will send messages I. -=cut - -has return_path => ( - isa => Address, - is => 'ro', - required => 1, - coerce => AddressFromStr, -); - -=attr C +=head2 C An array-ref of L<< C >> objects, defaults to the empty array. @@ -104,38 +239,16 @@ roles use the other attributes (L<< C|Sietima::Role::NoMail C >> uses C via L<< C|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 +=head2 C A L<< C >> instance, which will be used to send messages. If not passed in, Sietima uses L<< C >>'s L<< C|Email::Sender::Simple/default_transport >>. -=cut - -has transport => ( - isa => Transport, - is => 'lazy', -); -sub _build_transport { Email::Sender::Simple->default_transport } +=head1 METHODS -=method C +=head2 C $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 >> object out of the standard input, then pass it to L<< /C >> 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 +=head2 C $sietima->handle_mail($email_mime); @@ -161,19 +264,7 @@ Main driver method: converts the given email message into a list of L<< C >> objects by calling L<< /C >>, then sends each of them by calling L<< /C >>. -=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 +=head2 C 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|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 +=head2 C my @messages = $sietima->munge_mail($email_mime); @@ -207,19 +290,7 @@ email message. Roles such as L<< C|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 +=head2 C $sietima->send_message($sietima_message); @@ -227,25 +298,7 @@ Sends the given L<< C >> object via the L<< /C >>, but only if the message's L 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 +=head2 C my $addresses_href = $sietima->list_addresses; @@ -260,15 +313,7 @@ use this method at all. The L<< C|Sietima::Role::Headers >> role uses this to populate the various C headers. -=cut - -sub list_addresses($self) { - return +{ - return_path => $self->return_path, - }; -} - -=method C +=head2 C 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 -1; +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2017 by Gianni Ceccarelli . + +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 -- cgit v1.2.3