diff options
Diffstat (limited to 'lib/Sietima')
24 files changed, 1564 insertions, 910 deletions
diff --git a/lib/Sietima/CmdLine.pm b/lib/Sietima/CmdLine.pm index 180d3dd..57fbf18 100644 --- a/lib/Sietima/CmdLine.pm +++ b/lib/Sietima/CmdLine.pm @@ -8,9 +8,83 @@ use App::Spec; use Sietima::Runner; use namespace::clean; -# VERSION +our $VERSION = '1.1.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->%*, + + # App::Spec 0.005 really wants a class name, even when we pass + # a pre-build cmd object to the Runner + class => ref($self->sietima), + }); +} + + +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.1.2 + =head1 SYNOPSIS use Sietima::CmdLine; @@ -28,35 +102,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 +=head1 METHODS -has extra_spec => ( - is => 'ro', - isa => HashRef, - default => sub { +{} }, -); - -=method C<new> +=head2 C<new> my $cmdline = Sietima::CmdLine->new({ sietima => Sietima->with_traits(qw(SubjectTag))->new({ @@ -78,21 +140,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,51 +149,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->%*, - - # App::Spec 0.005 really wants a class name, even when we pass - # a pre-build cmd object to the Runner - class => ref($self->sietima), - }); -} - -=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) 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 diff --git a/lib/Sietima/HeaderURI.pm b/lib/Sietima/HeaderURI.pm index 2196724..b56f8f0 100644 --- a/lib/Sietima/HeaderURI.pm +++ b/lib/Sietima/HeaderURI.pm @@ -8,9 +8,97 @@ use Types::URI qw(Uri is_Uri); use Email::Address; use namespace::clean; -# VERSION +our $VERSION = '1.1.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($address, $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($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 }; + }; +}; + + +signature_for new_from_address => ( + method => Str, + positional => [ + Address->plus_coercions(AddressFromStr), + Optional[HashRef], + ], +); +sub new_from_address($class, $address, $query={}) { + return $class->new(_args_from_address($address,$query)); +} + + +sub as_header_raw($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.1.2 + =head1 SYNOPSIS around list_addresses => sub($orig,$self) { @@ -39,35 +127,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 +=head1 METHODS -has comment => ( - is => 'ro', - isa => Str, -); - -=method C<new> +=head2 C<new> Sietima::HeaderURI->new({ uri => 'http://foo/', comment => 'a thing', @@ -97,46 +171,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($address, $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($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, @@ -152,20 +187,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 - -signature_for new_from_address => ( - method => Str, - positional => [ - Address->plus_coercions(AddressFromStr), - Optional[HashRef], - ], -); -sub new_from_address($class, $address, $query={}) { - 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); @@ -190,15 +212,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($self) { - my $str = sprintf '<%s>',$self->uri; - if (my $c = $self->comment) { - $str .= sprintf ' (%s)',$c; - } +=head1 AUTHOR - return $str; -} +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 diff --git a/lib/Sietima/MailStore.pm b/lib/Sietima/MailStore.pm index d29b3b6..fe9d4ca 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.1.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.1.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) 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 diff --git a/lib/Sietima/MailStore/FS.pm b/lib/Sietima/MailStore/FS.pm index 060e321..4f43d26 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.1.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 it 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 signature_for store => ( method => Object, @@ -91,18 +51,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 signature_for retrieve_by_id => ( method => Object, @@ -114,19 +62,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); @@ -162,19 +97,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_by_tags('t1') ==> [ - { id => $id1, mail => $msg1 }, - { id => $id2, mail => $msg2 }, - ] - -=cut signature_for retrieve_by_tags => ( method => Object, @@ -194,14 +116,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 signature_for remove => ( method => Object, @@ -216,18 +130,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.1.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 it 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_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. -=cut +=for Pod::Coverage BUILD -sub clear($self) { - do { $self->$_->remove_tree;$self->$_->mkpath } for qw(_tagdir _msgdir); - return; -} +=head1 AUTHOR -1; +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 diff --git a/lib/Sietima/Message.pm b/lib/Sietima/Message.pm index b0d82e6..45b2e2e 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.1.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.1.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) 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 diff --git a/lib/Sietima/Policy.pm b/lib/Sietima/Policy.pm index 130cb44..c3f8533 100644 --- a/lib/Sietima/Policy.pm +++ b/lib/Sietima/Policy.pm @@ -4,9 +4,35 @@ use strict; use warnings; use feature ':5.36'; -# VERSION +our $VERSION = '1.1.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; + feature->import(':5.36'); + return; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Policy - pragma for Sietima modules + +=head1 VERSION + +version 1.1.2 + =head1 SYNOPSIS use v5.36; @@ -23,15 +49,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; - feature->import(':5.36'); - return; -} +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 diff --git a/lib/Sietima/Role/AvoidDups.pm b/lib/Sietima/Role/AvoidDups.pm index e0a5bae..565d773 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.1.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.1.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) 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 diff --git a/lib/Sietima/Role/Debounce.pm b/lib/Sietima/Role/Debounce.pm index e6bd087..be0b7b6 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.1.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.1.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) 2023 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 fce7cf8..1c536d8 100644 --- a/lib/Sietima/Role/Headers.pm +++ b/lib/Sietima/Role/Headers.pm @@ -6,61 +6,9 @@ use Types::Standard qw(Str); use Sietima::Types qw(HeaderUriFromThings); use namespace::clean; -# VERSION +our $VERSION = '1.1.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, @@ -118,12 +66,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); @@ -132,3 +74,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.1.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) 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 diff --git a/lib/Sietima/Role/ManualSubscription.pm b/lib/Sietima/Role/ManualSubscription.pm index c2711f0..cfd290f 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.1.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.1.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) 2023 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..febbfdc 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.1.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.1.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) 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 diff --git a/lib/Sietima/Role/NoSpoof.pm b/lib/Sietima/Role/NoSpoof.pm index ba703cb..aa81a2c 100644 --- a/lib/Sietima/Role/NoSpoof.pm +++ b/lib/Sietima/Role/NoSpoof.pm @@ -4,9 +4,41 @@ use Sietima::Policy; use Email::Address; use namespace::clean; -# VERSION +our $VERSION = '1.1.2'; # VERSION # ABSTRACT: never sends out messages from subscribers' addresses + +with 'Sietima::Role::WithPostAddress'; + +around munge_mail => sub ($orig,$self,$incoming_mail) { + my $sender = $self->post_address->address; + my ($from) = Email::Address->parse($incoming_mail->header_str('From')); + + $from->address($sender); + + $incoming_mail->header_str_set( + From => $from, + ); + + return $self->$orig($incoming_mail); +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::NoSpoof - never sends out messages from subscribers' addresses + +=head1 VERSION + +version 1.1.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('NoSpoof')->new(\%args); @@ -21,21 +53,15 @@ C<post_address>|Sietima::Role::WithPostAddress >> (this is a This will make the list DMARC-compliant. -=cut +=head1 AUTHOR -with 'Sietima::Role::WithPostAddress'; +Gianni Ceccarelli <dakkar@thenautilus.net> -around munge_mail => sub ($orig,$self,$incoming_mail) { - my $sender = $self->post_address->address; - my ($from) = Email::Address->parse($incoming_mail->header_str('From')); +=head1 COPYRIGHT AND LICENSE - $from->address($sender); +This software is copyright (c) 2023 by Gianni Ceccarelli <dakkar@thenautilus.net>. - $incoming_mail->header_str_set( - From => $from, - ); +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. - return $self->$orig($incoming_mail); -}; - -1; +=cut diff --git a/lib/Sietima/Role/NoSpoof/DMARC.pm b/lib/Sietima/Role/NoSpoof/DMARC.pm index de021da..13624d3 100644 --- a/lib/Sietima/Role/NoSpoof/DMARC.pm +++ b/lib/Sietima/Role/NoSpoof/DMARC.pm @@ -5,45 +5,9 @@ use Email::Address; use Mail::DMARC::PurePerl; use namespace::clean; -# VERSION +our $VERSION = '1.1.2'; # VERSION # ABSTRACT: send out messages from subscribers' addresses only if DMARC allows it -=head1 SYNOPSIS - - my $sietima = Sietima->with_traits('NoSpoof::DMARC')->new(\%args); - -=head1 DESCRIPTION - -A L<< C<Sietima> >> list with this role applied will replace the -C<From> address with its own L<< -C<post_address>|Sietima::Role::WithPostAddress >> (this is a -"sub-role" of L<< C<WithPostAddress>|Sietima::Role::WithPostAddress ->>) I<if> the originating address's DMARC policy requires it. - -This will make the list DMARC-compliant while minimising the changes -to the messages. - -The original C<From> address will be preserved in the C<Original-From> -header, as required by RFC 5703. - -=head2 Some more details - -DMARC requires L<"identifier -alignment"|https://datatracker.ietf.org/doc/html/rfc7489#section-3.1>, -essentially the C<MAIL FROM> (envelope) and the header C<From> must -have the same domain (or at least belong to the same "organisational -domain", i.e. be both under a common non-top-level domain, roughly). - -Therefore, a mailing list that forwards a message sent from a -DMARC-enabled domain, I<must> rewrite the C<From> header, otherwise -the message will be discarded by recipient servers. If the originating -domain does not publish a DMARC policy (or publishes a C<none> -policy), the mailing list can leave the C<From> as is, but should add -a C<Sender> header with the list's own address. - -This role does exactly that. - -=cut with 'Sietima::Role::WithPostAddress'; @@ -91,3 +55,65 @@ around munge_mail => sub ($orig,$self,$incoming_mail) { }; 1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::NoSpoof::DMARC - send out messages from subscribers' addresses only if DMARC allows it + +=head1 VERSION + +version 1.1.2 + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('NoSpoof::DMARC')->new(\%args); + +=head1 DESCRIPTION + +A L<< C<Sietima> >> list with this role applied will replace the +C<From> address with its own L<< +C<post_address>|Sietima::Role::WithPostAddress >> (this is a +"sub-role" of L<< C<WithPostAddress>|Sietima::Role::WithPostAddress +>>) I<if> the originating address's DMARC policy requires it. + +This will make the list DMARC-compliant while minimising the changes +to the messages. + +The original C<From> address will be preserved in the C<Original-From> +header, as required by RFC 5703. + +=head2 Some more details + +DMARC requires L<"identifier +alignment"|https://datatracker.ietf.org/doc/html/rfc7489#section-3.1>, +essentially the C<MAIL FROM> (envelope) and the header C<From> must +have the same domain (or at least belong to the same "organisational +domain", i.e. be both under a common non-top-level domain, roughly). + +Therefore, a mailing list that forwards a message sent from a +DMARC-enabled domain, I<must> rewrite the C<From> header, otherwise +the message will be discarded by recipient servers. If the originating +domain does not publish a DMARC policy (or publishes a C<none> +policy), the mailing list can leave the C<From> as is, but should add +a C<Sender> header with the list's own address. + +This role does exactly that. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=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 diff --git a/lib/Sietima/Role/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm index 5ba828b..106c622 100644 --- a/lib/Sietima/Role/ReplyTo.pm +++ b/lib/Sietima/Role/ReplyTo.pm @@ -5,9 +5,79 @@ use Types::Standard qw(Bool); use List::AllUtils qw(part); use namespace::clean; -# VERSION +our $VERSION = '1.1.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.1.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('ReplyTo')->new({ @@ -35,26 +105,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, @@ -73,49 +135,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) 2023 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..b6b9159 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.1.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.1.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) 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 diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm index 112f85f..5df9636 100644 --- a/lib/Sietima/Role/SubscriberOnly.pm +++ b/lib/Sietima/Role/SubscriberOnly.pm @@ -7,9 +7,52 @@ use Types::Standard qw(Object CodeRef); use Type::Params -sigs; use namespace::clean; -# VERSION +our $VERSION = '1.1.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); + } +}; + + +signature_for ignoring_subscriberonly => ( + method => Object, + positional => [ CodeRef ], +); +sub ignoring_subscriberonly($self,$code) { + 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.1.2 + =head1 SYNOPSIS package Sietima::Role::SubscriberOnly::MyPolicy; @@ -29,7 +72,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) { ... } @@ -41,52 +86,37 @@ example to forward the email to the owner of the list. It can also have side-effects, like storing a copy of the message to approve later. -=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) 2023 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 - -signature_for ignoring_subscriberonly => ( - method => Object, - positional => [ CodeRef ], -); -sub ignoring_subscriberonly($self,$code) { - 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..1914f78 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.1.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.1.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) 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 diff --git a/lib/Sietima/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm index 42e5bc3..9de2967 100644 --- a/lib/Sietima/Role/SubscriberOnly/Moderate.pm +++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm @@ -4,9 +4,143 @@ use Sietima::Policy; use Email::Stuffer; use namespace::clean; -# VERSION +our $VERSION = '1.1.2'; # VERSION # ABSTRACT: moderate messages from non-subscribers + +with 'Sietima::Role::SubscriberOnly', + 'Sietima::Role::WithMailStore', + 'Sietima::Role::WithOwner'; + + +sub munge_mail_from_non_subscriber ($self,$mail) { + my $id = $self->mail_store->store($mail,'moderation'); + my $notice = Email::Stuffer + ->from($self->return_path->address) + ->to($self->owner->address) + ->subject("Message held for moderation - ".$mail->header_str('subject')) + ->text_body("Use id $id to refer to it") + ->attach( + $mail->as_string, + content_type => 'message/rfc822', + # some clients, most notably Claws-Mail, seem to have + # problems with encodings other than this + encoding => '7bit', + ); + + return Sietima::Message->new({ + mail => $notice->email, + from => $self->return_path, + to => [ $self->owner ], + }); +} + + +sub resume ($self,$mail_id) { + my $mail = $self->mail_store->retrieve_by_id($mail_id); + $self->ignoring_subscriberonly( + sub($s) { $s->handle_mail($mail) }, + ); + $self->mail_store->remove($mail_id); +} + + +sub drop ($self,$mail_id) { + $self->mail_store->remove($mail_id); +} + + +sub list_mails_in_moderation_queue ($self,$runner,@) { + my $mails = $self->mail_store->retrieve_by_tags('moderation'); + $runner->out(sprintf 'There are %d messages held for moderation:',scalar($mails->@*)); + for my $mail ($mails->@*) { + $runner->out(sprintf '* %s %s "%s" (%s)', + $mail->{id}, + $mail->{mail}->header_str('From')//'<no from>', + $mail->{mail}->header_str('Subject')//'<no subject>', + $mail->{mail}->header_str('Date')//'<no date>', + ); + } +} + + +sub show_mail_from_moderation_queue ($self,$runner,@) { + my $id = $runner->parameters->{'mail-id'}; + my $mail = $self->mail_store->retrieve_by_id($id); + $runner->out("Message $id:"); + $runner->out($mail->as_string =~ s{\r\n}{\n}gr); +} + + +sub resume_mail_from_moderation_queue ($self,$runner,@) { + $self->resume($runner->parameters->{'mail-id'}); +} + + +sub drop_mail_from_moderation_queue ($self,$runner,@) { + $self->drop($runner->parameters->{'mail-id'}); +} + + +around command_line_spec => sub ($orig,$self) { + my $spec = $self->$orig(); + + # this allows us to tab-complete identifiers from the shell! + my $list_mail_ids = sub ($self,$runner,$args) { + $self->mail_store->retrieve_ids_by_tags('moderation'); + }; + # a little factoring: $etc->($command_name) generates the spec for + # sub-commands that require a mail id + my $etc = sub($cmd) { + return ( + summary => "$cmd the given mail, currently held for moderation", + parameters => [ + { + name => 'mail-id', + required => 1, + summary => "id of the mail to $cmd", + completion => { op => $list_mail_ids }, + }, + ], + ); + }; + + $spec->{subcommands}{'list-held'} = { + op => 'list_mails_in_moderation_queue', + summary => 'list all mails currently held for moderation', + }; + $spec->{subcommands}{'show-held'} = { + op => 'show_mail_from_moderation_queue', + $etc->('show'), + }; + $spec->{subcommands}{'resume-held'} = { + op => 'resume_mail_from_moderation_queue', + $etc->('resume'), + }; + $spec->{subcommands}{'drop-held'} = { + op => 'drop_mail_from_moderation_queue', + $etc->('drop'), + }; + + return $spec; +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::SubscriberOnly::Moderate - moderate messages from non-subscribers + +=head1 VERSION + +version 1.1.2 + =head1 SYNOPSIS my $sietima = Sietima->with_traits('SubscribersOnly::Moderate')->new({ @@ -31,43 +165,15 @@ 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'; +=head1 METHODS -=method C<munge_mail_from_non_subscriber> +=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>. -=cut - -sub munge_mail_from_non_subscriber ($self,$mail) { - my $id = $self->mail_store->store($mail,'moderation'); - my $notice = Email::Stuffer - ->from($self->return_path->address) - ->to($self->owner->address) - ->subject("Message held for moderation - ".$mail->header_str('subject')) - ->text_body("Use id $id to refer to it") - ->attach( - $mail->as_string, - content_type => 'message/rfc822', - # some clients, most notably Claws-Mail, seem to have - # problems with encodings other than this - encoding => '7bit', - ); - - return Sietima::Message->new({ - mail => $notice->email, - from => $self->return_path, - to => [ $self->owner ], - }); -} - -=method C<resume> +=head2 C<resume> $sietima->resume($mail_id); @@ -78,17 +184,7 @@ 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); - $self->ignoring_subscriberonly( - sub($s) { $s->handle_mail($mail) }, - ); - $self->mail_store->remove($mail_id); -} - -=method C<drop> +=head2 C<drop> $sietima->drop($mail_id); @@ -96,13 +192,7 @@ Given the identifier returned when L<storing|Sietima::MailStore/store>-ing 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> +=head2 C<list_mails_in_moderation_queue> $sietima->list_mails_in_moderation_queue($sietima_runner); @@ -114,22 +204,7 @@ 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'); - $runner->out(sprintf 'There are %d messages held for moderation:',scalar($mails->@*)); - for my $mail ($mails->@*) { - $runner->out(sprintf '* %s %s "%s" (%s)', - $mail->{id}, - $mail->{mail}->header_str('From')//'<no from>', - $mail->{mail}->header_str('Subject')//'<no subject>', - $mail->{mail}->header_str('Date')//'<no date>', - ); - } -} - -=method C<show_mail_from_moderation_queue> +=head2 C<show_mail_from_moderation_queue> $sietima->show_mail_from_moderation_queue($sietima_runner); @@ -140,16 +215,7 @@ 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'}; - my $mail = $self->mail_store->retrieve_by_id($id); - $runner->out("Message $id:"); - $runner->out($mail->as_string =~ s{\r\n}{\n}gr); -} - -=method C<resume_mail_from_moderation_queue> +=head2 C<resume_mail_from_moderation_queue> $sietima->resume_mail_from_moderation_queue($sietima_runner); @@ -160,13 +226,7 @@ it. This method is usually invoked from the command line, see L<< /C<command_line_spec> >>. -=cut - -sub resume_mail_from_moderation_queue ($self,$runner,@) { - $self->resume($runner->parameters->{'mail-id'}); -} - -=method C<drop_mail_from_moderation_queue> +=head2 C<drop_mail_from_moderation_queue> $sietima->drop_mail_from_moderation_queue($sietima_runner); @@ -176,13 +236,9 @@ of the message requested from the command line, and L<drops|/drop> it. This method is usually invoked from the command line, see L<< /C<command_line_spec> >>. -=cut +=head1 MODIFIED METHODS -sub drop_mail_from_moderation_queue ($self,$runner,@) { - $self->drop($runner->parameters->{'mail-id'}); -} - -=modif C<command_line_spec> +=head2 C<command_line_spec> This method adds the following sub-commands for the command line: @@ -220,49 +276,15 @@ identifier is expected as a positional parameter. =back -=cut +=head1 AUTHOR -around command_line_spec => sub ($orig,$self) { - my $spec = $self->$orig(); +Gianni Ceccarelli <dakkar@thenautilus.net> - # this allows us to tab-complete identifiers from the shell! - my $list_mail_ids = sub ($self,$runner,$args) { - $self->mail_store->retrieve_ids_by_tags('moderation'); - }; - # a little factoring: $etc->($command_name) generates the spec for - # sub-commands that require a mail id - my $etc = sub($cmd) { - return ( - summary => "$cmd the given mail, currently held for moderation", - parameters => [ - { - name => 'mail-id', - required => 1, - summary => "id of the mail to $cmd", - completion => { op => $list_mail_ids }, - }, - ], - ); - }; +=head1 COPYRIGHT AND LICENSE - $spec->{subcommands}{'list-held'} = { - op => 'list_mails_in_moderation_queue', - summary => 'list all mails currently held for moderation', - }; - $spec->{subcommands}{'show-held'} = { - op => 'show_mail_from_moderation_queue', - $etc->('show'), - }; - $spec->{subcommands}{'resume-held'} = { - op => 'resume_mail_from_moderation_queue', - $etc->('resume'), - }; - $spec->{subcommands}{'drop-held'} = { - op => 'drop_mail_from_moderation_queue', - $etc->('drop'), - }; +This software is copyright (c) 2023 by Gianni Ceccarelli <dakkar@thenautilus.net>. - return $spec; -}; +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/WithMailStore.pm b/lib/Sietima/Role/WithMailStore.pm index 7ca4b4e..f30fde4 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.1.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.1.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) 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 diff --git a/lib/Sietima/Role/WithOwner.pm b/lib/Sietima/Role/WithOwner.pm index 1dfd362..c7c4d5c 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.1.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.1.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) 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 diff --git a/lib/Sietima/Role/WithPostAddress.pm b/lib/Sietima/Role/WithPostAddress.pm index 333c5e3..433b2ec 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.1.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.1.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) 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 diff --git a/lib/Sietima/Runner.pm b/lib/Sietima/Runner.pm index ca64348..816f12a 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.1.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.1.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) 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 diff --git a/lib/Sietima/Subscriber.pm b/lib/Sietima/Subscriber.pm index 606f61d..e25f8c6 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.1.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 signature_for match => ( method => Object, @@ -96,15 +50,85 @@ sub match($self,$addr) { $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.1.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) 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 diff --git a/lib/Sietima/Types.pm b/lib/Sietima/Types.pm index c6c7381..8652501 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.1.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.1.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) 2023 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 |