diff options
Diffstat (limited to 'lib/Sietima.pm')
| -rw-r--r-- | lib/Sietima.pm | 331 |
1 files changed, 187 insertions, 144 deletions
diff --git a/lib/Sietima.pm b/lib/Sietima.pm index 52473f9..2bace38 100644 --- a/lib/Sietima.pm +++ b/lib/Sietima.pm @@ -14,9 +14,139 @@ use Email::Address; use namespace::clean; with 'MooX::Traits'; -# VERSION +our $VERSION = '1.1.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); +} + + +signature_for handle_mail => ( + method => Object, + positional => [ EmailMIME ], +); +sub handle_mail($self,$incoming_mail) { + my (@outgoing_messages) = $self->munge_mail($incoming_mail); + for my $outgoing_message (@outgoing_messages) { + $self->send_message($outgoing_message); + } + return; +} + + +signature_for subscribers_to_send_to => ( + method => Object, + positional => [ EmailMIME ], +); +sub subscribers_to_send_to($self,$incoming_mail) { + return $self->subscribers; +} + + +signature_for munge_mail => ( + method => Object, + positional => [ EmailMIME ], +); +sub munge_mail($self,$incoming_mail) { + return Sietima::Message->new({ + mail => $incoming_mail, + from => $self->return_path, + to => $self->subscribers_to_send_to($incoming_mail), + }); +} + + +signature_for send_message => ( + method => Object, + positional => [ Message ], +); +sub send_message($self,$outgoing_message) { + 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.1.2 + =head1 SYNOPSIS use Sietima; @@ -43,53 +173,68 @@ 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<NoSpoof>|Sietima::Role::NoSpoof >> + +=item L<< C<NoSpoof>|Sietima::Role::NoSpoof >> + replaces the C<From> address with the list's own address -= 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. @@ -105,38 +250,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 +=head1 METHODS -has transport => ( - isa => Transport, - is => 'lazy', -); -sub _build_transport { Email::Sender::Simple->default_transport } - -=method C<handle_mail_from_stdin> +=head2 C<handle_mail_from_stdin> $sietima->handle_mail_from_stdin(); @@ -144,17 +267,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); @@ -162,21 +275,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 - -signature_for handle_mail => ( - method => Object, - positional => [ EmailMIME ], -); -sub handle_mail($self,$incoming_mail) { - 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); @@ -188,17 +287,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 - -signature_for subscribers_to_send_to => ( - method => Object, - positional => [ EmailMIME ], -); -sub subscribers_to_send_to($self,$incoming_mail) { - return $self->subscribers; -} - -=method C<munge_mail> +=head2 C<munge_mail> my @messages = $sietima->munge_mail($email_mime); @@ -212,21 +301,7 @@ email message. Roles such as L<< C<SubjectTag>|Sietima::Role::SubjectTag >> modify this method to alter the message. -=cut - -signature_for munge_mail => ( - method => Object, - positional => [ EmailMIME ], -); -sub munge_mail($self,$incoming_mail) { - 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); @@ -234,27 +309,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 - -signature_for send_message => ( - method => Object, - positional => [ Message ], -); -sub send_message($self,$outgoing_message) { - 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; @@ -269,15 +324,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; @@ -301,19 +348,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) 2023 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 |