diff options
47 files changed, 2480 insertions, 1387 deletions
diff --git a/.gitignore b/.gitignore deleted file mode 100644 index f713c58..0000000 --- a/.gitignore +++ /dev/null @@ -1,14 +0,0 @@ -blib -pm_to_blib -*.sw? -Makefile -Makefile.old -MANIFEST.bak -*.tar.gz -/inc/ -/META.* -/MYMETA.* -.prove -*~ -/.build/ -/Sietima-* diff --git a/.gitmodules b/.gitmodules deleted file mode 100644 index 7020267..0000000 --- a/.gitmodules +++ /dev/null @@ -1,6 +0,0 @@ -[submodule "docs/presentation/reveal.js"] - path = docs/presentation/reveal.js - url = git@github.com:hakimel/reveal.js.git -[submodule "docs/presentation/highlight.js"] - path = docs/presentation/highlight.js - url = git@github.com:isagalaev/highlight.js.git diff --git a/.proverc b/.proverc deleted file mode 100644 index ad83f73..0000000 --- a/.proverc +++ /dev/null @@ -1,2 +0,0 @@ ---lib ---recurse @@ -1,5 +1,3 @@ -{{$NEXT}} - 1.1.1 2023-02-28 13:02:33+00:00 Europe/London - documentation fixes - simplified SubscriberOnly::Moderate @@ -0,0 +1,379 @@ +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. + +Terms of the Perl programming language system itself + +a) the GNU General Public License as published by the Free + Software Foundation; either version 1, or (at your option) any + later version, or +b) the "Artistic License" + +--- The GNU General Public License, Version 1, February 1989 --- + +This software is Copyright (c) 2023 by Gianni Ceccarelli <dakkar@thenautilus.net>. + +This is free software, licensed under: + + The GNU General Public License, Version 1, February 1989 + + GNU GENERAL PUBLIC LICENSE + Version 1, February 1989 + + Copyright (C) 1989 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The license agreements of most software companies try to keep users +at the mercy of those companies. By contrast, our General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. The +General Public License applies to the Free Software Foundation's +software and to any other program whose authors commit to using it. +You can use it for your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Specifically, the General Public License is designed to make +sure that you have the freedom to give away or sell copies of free +software, that you receive source code or can get it if you want it, +that you can change the software or use pieces of it in new free +programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of a such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must tell them their rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any program or other work which +contains a notice placed by the copyright holder saying it may be +distributed under the terms of this General Public License. The +"Program", below, refers to any such program or work, and a "work based +on the Program" means either the Program or any work containing the +Program or a portion of it, either verbatim or with modifications. Each +licensee is addressed as "you". + + 1. You may copy and distribute verbatim copies of the Program's source +code as you receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice and +disclaimer of warranty; keep intact all the notices that refer to this +General Public License and to the absence of any warranty; and give any +other recipients of the Program a copy of this General Public License +along with the Program. You may charge a fee for the physical act of +transferring a copy. + + 2. You may modify your copy or copies of the Program or any portion of +it, and copy and distribute such modifications under the terms of Paragraph +1 above, provided that you also do the following: + + a) cause the modified files to carry prominent notices stating that + you changed the files and the date of any change; and + + b) cause the whole of any work that you distribute or publish, that + in whole or in part contains the Program or any part thereof, either + with or without modifications, to be licensed at no charge to all + third parties under the terms of this General Public License (except + that you may choose to grant warranty protection to some or all + third parties, at your option). + + c) If the modified program normally reads commands interactively when + run, you must cause it, when started running for such interactive use + in the simplest and most usual way, to print or display an + announcement including an appropriate copyright notice and a notice + that there is no warranty (or else, saying that you provide a + warranty) and that users may redistribute the program under these + conditions, and telling the user how to view a copy of this General + Public License. + + d) You may charge a fee for the physical act of transferring a + copy, and you may at your option offer warranty protection in + exchange for a fee. + +Mere aggregation of another independent work with the Program (or its +derivative) on a volume of a storage or distribution medium does not bring +the other work under the scope of these terms. + + 3. You may copy and distribute the Program (or a portion or derivative of +it, under Paragraph 2) in object code or executable form under the terms of +Paragraphs 1 and 2 above provided that you also do one of the following: + + a) accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of + Paragraphs 1 and 2 above; or, + + b) accompany it with a written offer, valid for at least three + years, to give any third party free (except for a nominal charge + for the cost of distribution) a complete machine-readable copy of the + corresponding source code, to be distributed under the terms of + Paragraphs 1 and 2 above; or, + + c) accompany it with the information you received as to where the + corresponding source code may be obtained. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form alone.) + +Source code for a work means the preferred form of the work for making +modifications to it. For an executable file, complete source code means +all the source code for all modules it contains; but, as a special +exception, it need not include source code for modules which are standard +libraries that accompany the operating system on which the executable +file runs, or for standard header files or definitions files that +accompany that operating system. + + 4. You may not copy, modify, sublicense, distribute or transfer the +Program except as expressly provided under this General Public License. +Any attempt otherwise to copy, modify, sublicense, distribute or transfer +the Program is void, and will automatically terminate your rights to use +the Program under this License. However, parties who have received +copies, or rights to use copies, from you under this General Public +License will not have their licenses terminated so long as such parties +remain in full compliance. + + 5. By copying, distributing or modifying the Program (or any work based +on the Program) you indicate your acceptance of this license to do so, +and all its terms and conditions. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the original +licensor to copy, distribute or modify the Program subject to these +terms and conditions. You may not impose any further restrictions on the +recipients' exercise of the rights granted herein. + + 7. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of the license which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +the license, you may choose any version ever published by the Free Software +Foundation. + + 8. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + Appendix: How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to humanity, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest to +attach them to the start of each source file to most effectively convey +the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) 19yy <name of author> + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 1, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) 19xx name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the +appropriate parts of the General Public License. Of course, the +commands you use may be called something other than `show w' and `show +c'; they could even be mouse-clicks or menu items--whatever suits your +program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + program `Gnomovision' (a program to direct compilers to make passes + at assemblers) written by James Hacker. + + <signature of Ty Coon>, 1 April 1989 + Ty Coon, President of Vice + +That's all there is to it! + + +--- The Artistic License 1.0 --- + +This software is Copyright (c) 2023 by Gianni Ceccarelli <dakkar@thenautilus.net>. + +This is free software, licensed under: + + The Artistic License 1.0 + +The Artistic License + +Preamble + +The intent of this document is to state the conditions under which a Package +may be copied, such that the Copyright Holder maintains some semblance of +artistic control over the development of the package, while giving the users of +the package the right to use and distribute the Package in a more-or-less +customary fashion, plus the right to make reasonable modifications. + +Definitions: + + - "Package" refers to the collection of files distributed by the Copyright + Holder, and derivatives of that collection of files created through + textual modification. + - "Standard Version" refers to such a Package if it has not been modified, + or has been modified in accordance with the wishes of the Copyright + Holder. + - "Copyright Holder" is whoever is named in the copyright or copyrights for + the package. + - "You" is you, if you're thinking about copying or distributing this Package. + - "Reasonable copying fee" is whatever you can justify on the basis of media + cost, duplication charges, time of people involved, and so on. (You will + not be required to justify it to the Copyright Holder, but only to the + computing community at large as a market that must bear the fee.) + - "Freely Available" means that no fee is charged for the item itself, though + there may be fees involved in handling the item. It also means that + recipients of the item may redistribute it under the same conditions they + received it. + +1. You may make and give away verbatim copies of the source form of the +Standard Version of this Package without restriction, provided that you +duplicate all of the original copyright notices and associated disclaimers. + +2. You may apply bug fixes, portability fixes and other modifications derived +from the Public Domain or from the Copyright Holder. A Package modified in such +a way shall still be considered the Standard Version. + +3. You may otherwise modify your copy of this Package in any way, provided that +you insert a prominent notice in each changed file stating how and when you +changed that file, and provided that you do at least ONE of the following: + + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or an + equivalent medium, or placing the modifications on a major archive site + such as ftp.uu.net, or by allowing the Copyright Holder to include your + modifications in the Standard Version of the Package. + + b) use the modified Package only within your corporation or organization. + + c) rename any non-standard executables so the names do not conflict with + standard executables, which must also be provided, and provide a separate + manual page for each non-standard executable that clearly documents how it + differs from the Standard Version. + + d) make other distribution arrangements with the Copyright Holder. + +4. You may distribute the programs of this Package in object code or executable +form, provided that you do at least ONE of the following: + + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where to + get the Standard Version. + + b) accompany the distribution with the machine-readable source of the Package + with your modifications. + + c) accompany any non-standard executables with their corresponding Standard + Version executables, giving the non-standard executables non-standard + names, and clearly documenting the differences in manual pages (or + equivalent), together with instructions on where to get the Standard + Version. + + d) make other distribution arrangements with the Copyright Holder. + +5. You may charge a reasonable copying fee for any distribution of this +Package. You may charge any fee you choose for support of this Package. You +may not charge a fee for this Package itself. However, you may distribute this +Package in aggregate with other (possibly commercial) programs as part of a +larger (possibly commercial) software distribution provided that you do not +advertise this Package as a product of your own. + +6. The scripts and library files supplied as input to or produced as output +from the programs of this Package do not automatically fall under the copyright +of this Package, but belong to whomever generated them, and may be sold +commercially, and may be aggregated with this Package. + +7. C or perl subroutines supplied by you and linked into this Package shall not +be considered part of this Package. + +8. The name of the Copyright Holder may not be used to endorse or promote +products derived from this software without specific prior written permission. + +9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED +WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + +The End + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..d507227 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,57 @@ +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.030. +Changes +LICENSE +MANIFEST +META.json +META.yml +Makefile.PL +TODO.md +example/sietima +lib/Sietima.pm +lib/Sietima/CmdLine.pm +lib/Sietima/HeaderURI.pm +lib/Sietima/MailStore.pm +lib/Sietima/MailStore/FS.pm +lib/Sietima/Message.pm +lib/Sietima/Policy.pm +lib/Sietima/Role/AvoidDups.pm +lib/Sietima/Role/Debounce.pm +lib/Sietima/Role/Headers.pm +lib/Sietima/Role/ManualSubscription.pm +lib/Sietima/Role/NoMail.pm +lib/Sietima/Role/NoSpoof.pm +lib/Sietima/Role/ReplyTo.pm +lib/Sietima/Role/SubjectTag.pm +lib/Sietima/Role/SubscriberOnly.pm +lib/Sietima/Role/SubscriberOnly/Drop.pm +lib/Sietima/Role/SubscriberOnly/Moderate.pm +lib/Sietima/Role/WithMailStore.pm +lib/Sietima/Role/WithOwner.pm +lib/Sietima/Role/WithPostAddress.pm +lib/Sietima/Runner.pm +lib/Sietima/Subscriber.pm +lib/Sietima/Types.pm +perlcritic.rc +t/author-critic.t +t/author-no-tabs.t +t/author-pod-coverage.t +t/author-pod-syntax.t +t/lib/Test/Sietima.pm +t/lib/Test/Sietima/MailStore.pm +t/tests/sietima.t +t/tests/sietima/cmdline.t +t/tests/sietima/headeruri.t +t/tests/sietima/mailstore.t +t/tests/sietima/message.t +t/tests/sietima/multi-role/debounce-moderate.t +t/tests/sietima/role/avoid-dups.t +t/tests/sietima/role/debounce.t +t/tests/sietima/role/headers.t +t/tests/sietima/role/manualsubscription.t +t/tests/sietima/role/nomail.t +t/tests/sietima/role/nospoof.t +t/tests/sietima/role/replyto.t +t/tests/sietima/role/subject-tag.t +t/tests/sietima/role/subscriberonly/drop.t +t/tests/sietima/role/subscriberonly/moderate.t +t/tests/sietima/subscriber.t diff --git a/META.json b/META.json new file mode 100644 index 0000000..3ce09f6 --- /dev/null +++ b/META.json @@ -0,0 +1,90 @@ +{ + "abstract" : "minimal mailing list manager", + "author" : [ + "Gianni Ceccarelli <dakkar@thenautilus.net>" + ], + "dynamic_config" : 0, + "generated_by" : "Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010", + "license" : [ + "perl_5" + ], + "meta-spec" : { + "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", + "version" : 2 + }, + "name" : "Sietima", + "no_index" : { + "directory" : [ + "t/lib" + ] + }, + "prereqs" : { + "configure" : { + "requires" : { + "ExtUtils::MakeMaker" : "7.66" + } + }, + "develop" : { + "requires" : { + "Pod::Coverage::TrustPod" : "0.100006", + "Test::More" : "1.302192", + "Test::NoTabs" : "2.02", + "Test::Perl::Critic" : "1.04", + "Test::Pod" : "1.52", + "Test::Pod::Coverage" : "1.10" + } + }, + "runtime" : { + "requires" : { + "App::Spec" : "0.013", + "App::Spec::Run" : "0.013", + "Digest::SHA" : "6.04", + "Email::Address" : "1.913", + "Email::MIME" : "1.953", + "Email::Sender::Simple" : "2.600", + "Email::Stuffer" : "0.020", + "List::AllUtils" : "0.19", + "Moo" : "2.005005", + "Moo::Role" : "2.005005", + "MooX::Traits" : "0.005", + "Type::Library" : "2.002001", + "Type::Params" : "2.002001", + "Type::Utils" : "2.002001", + "Types::Path::Tiny" : "0.006", + "Types::Standard" : "2.002001", + "Types::URI" : "0.007", + "feature" : "1.72", + "namespace::clean" : "0.27", + "perl" : "v5.36.0", + "strict" : "1.12", + "warnings" : "1.58" + } + }, + "test" : { + "requires" : { + "Data::Printer" : "1.001000", + "Email::Sender::Transport::Test" : "2.600", + "Import::Into" : "1.002005", + "Path::Tiny" : "0.144", + "Test2::API" : "1.302192", + "Test2::V0" : "0.000145", + "URI" : "5.17", + "lib" : "0.65" + } + } + }, + "release_status" : "stable", + "resources" : { + "homepage" : "https://www.thenautilus.net/SW/Sietima/", + "repository" : { + "type" : "git", + "url" : "https://www.thenautilus.net/cgit/Sietima", + "web" : "https://www.thenautilus.net/cgit/Sietima" + } + }, + "version" : "1.1.1", + "x_generated_by_perl" : "v5.36.0", + "x_serialization_backend" : "Cpanel::JSON::XS version 4.35", + "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" +} + diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..860869e --- /dev/null +++ b/META.yml @@ -0,0 +1,55 @@ +--- +abstract: 'minimal mailing list manager' +author: + - 'Gianni Ceccarelli <dakkar@thenautilus.net>' +build_requires: + Data::Printer: '1.001000' + Email::Sender::Transport::Test: '2.600' + Import::Into: '1.002005' + Path::Tiny: '0.144' + Test2::API: '1.302192' + Test2::V0: '0.000145' + URI: '5.17' + lib: '0.65' +configure_requires: + ExtUtils::MakeMaker: '7.66' +dynamic_config: 0 +generated_by: 'Dist::Zilla version 6.030, CPAN::Meta::Converter version 2.150010' +license: perl +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.4.html + version: '1.4' +name: Sietima +no_index: + directory: + - t/lib +requires: + App::Spec: '0.013' + App::Spec::Run: '0.013' + Digest::SHA: '6.04' + Email::Address: '1.913' + Email::MIME: '1.953' + Email::Sender::Simple: '2.600' + Email::Stuffer: '0.020' + List::AllUtils: '0.19' + Moo: '2.005005' + Moo::Role: '2.005005' + MooX::Traits: '0.005' + Type::Library: '2.002001' + Type::Params: '2.002001' + Type::Utils: '2.002001' + Types::Path::Tiny: '0.006' + Types::Standard: '2.002001' + Types::URI: '0.007' + feature: '1.72' + namespace::clean: '0.27' + perl: v5.36.0 + strict: '1.12' + warnings: '1.58' +resources: + homepage: https://www.thenautilus.net/SW/Sietima/ + repository: https://www.thenautilus.net/cgit/Sietima +version: 1.1.1 +x_generated_by_perl: v5.36.0 +x_serialization_backend: 'YAML::Tiny version 1.73' +x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..bb74d5f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,101 @@ +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.030. +use strict; +use warnings; + +use 5.036000; + +use ExtUtils::MakeMaker 7.30; + +my %WriteMakefileArgs = ( + "ABSTRACT" => "minimal mailing list manager", + "AUTHOR" => "Gianni Ceccarelli <dakkar\@thenautilus.net>", + "CONFIGURE_REQUIRES" => { + "ExtUtils::MakeMaker" => "7.66" + }, + "DISTNAME" => "Sietima", + "LICENSE" => "perl", + "MIN_PERL_VERSION" => "5.036000", + "NAME" => "Sietima", + "PREREQ_PM" => { + "App::Spec" => "0.013", + "App::Spec::Run" => "0.013", + "Digest::SHA" => "6.04", + "Email::Address" => "1.913", + "Email::MIME" => "1.953", + "Email::Sender::Simple" => "2.600", + "Email::Stuffer" => "0.020", + "List::AllUtils" => "0.19", + "Moo" => "2.005005", + "Moo::Role" => "2.005005", + "MooX::Traits" => "0.005", + "Type::Library" => "2.002001", + "Type::Params" => "2.002001", + "Type::Utils" => "2.002001", + "Types::Path::Tiny" => "0.006", + "Types::Standard" => "2.002001", + "Types::URI" => "0.007", + "feature" => "1.72", + "namespace::clean" => "0.27", + "strict" => "1.12", + "warnings" => "1.58" + }, + "TEST_REQUIRES" => { + "Data::Printer" => "1.001000", + "Email::Sender::Transport::Test" => "2.600", + "Import::Into" => "1.002005", + "Path::Tiny" => "0.144", + "Test2::API" => "1.302192", + "Test2::V0" => "0.000145", + "URI" => "5.17", + "lib" => "0.65" + }, + "VERSION" => "1.1.1", + "test" => { + "TESTS" => "t/*.t t/tests/*.t t/tests/sietima/*.t t/tests/sietima/multi-role/*.t t/tests/sietima/role/*.t t/tests/sietima/role/subscriberonly/*.t" + } +); + + +my %FallbackPrereqs = ( + "App::Spec" => "0.013", + "App::Spec::Run" => "0.013", + "Data::Printer" => "1.001000", + "Digest::SHA" => "6.04", + "Email::Address" => "1.913", + "Email::MIME" => "1.953", + "Email::Sender::Simple" => "2.600", + "Email::Sender::Transport::Test" => "2.600", + "Email::Stuffer" => "0.020", + "Import::Into" => "1.002005", + "List::AllUtils" => "0.19", + "Moo" => "2.005005", + "Moo::Role" => "2.005005", + "MooX::Traits" => "0.005", + "Path::Tiny" => "0.144", + "Test2::API" => "1.302192", + "Test2::V0" => "0.000145", + "Type::Library" => "2.002001", + "Type::Params" => "2.002001", + "Type::Utils" => "2.002001", + "Types::Path::Tiny" => "0.006", + "Types::Standard" => "2.002001", + "Types::URI" => "0.007", + "URI" => "5.17", + "feature" => "1.72", + "lib" => "0.65", + "namespace::clean" => "0.27", + "strict" => "1.12", + "warnings" => "1.58" +); + + +unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { + delete $WriteMakefileArgs{TEST_REQUIRES}; + delete $WriteMakefileArgs{BUILD_REQUIRES}; + $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; +} + +delete $WriteMakefileArgs{CONFIGURE_REQUIRES} + unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; + +WriteMakefile(%WriteMakefileArgs); diff --git a/dist.ini b/dist.ini deleted file mode 100644 index 29c7ccc..0000000 --- a/dist.ini +++ /dev/null @@ -1,94 +0,0 @@ -name = Sietima -author = Gianni Ceccarelli <dakkar@thenautilus.net> -license = Perl_5 -copyright_holder = Gianni Ceccarelli <dakkar@thenautilus.net> -copyright_year = 2023 - -[GatherDir] -exclude_match = ~$ -exclude_filename = dist.ini -exclude_filename = weaver.ini -prune_directory = docs - -[PruneCruft] - -[PodWeaver] -; authordep Pod::Elemental::Transformer::List - -[Git::Check] -allow_dirty = dist.ini - -[Git::NextVersion] -first_version = 1.0.0 - -[CheckChangeLog] - -[NextRelease] - -[AutoPrereqs] - -[Prereqs] -App::Spec = != 0.004_001 -App::Spec::Run = != 0.004_001 - -[OurPkgVersion] - -[ManifestSkip] - -[Test::NoTabs] - -[Test::Perl::Critic] - -[PodCoverageTests] - -[PodSyntaxTests] - -[ExtraTests] - -[Repository] -repository=https://www.thenautilus.net/cgit/Sietima -web=https://www.thenautilus.net/cgit/Sietima - -[MetaResources] -homepage = https://www.thenautilus.net/SW/Sietima/ - -[MetaNoIndex] -directory = t/lib - -[MetaYAML] - -[MetaJSON] - -[ExecDir] -dir = scripts - -[ShareDir] - -[MakeMaker] -eumm_version = 7.30 - -[Manifest] - -[Prereqs::MatchInstalled::All] - -[License] - -[TestRelease] - -[Git::Commit] - -[Git::CommitBuild] -branch = -release_branch = release/%b -release_message = Dzil-build release %v (from %h on %b) -multiple_inheritance = 1 - -[Git::Tag / master] -tag_format = v%v%t-dzilla - -[Git::Tag / release] -branch = release/master -tag_format = v%v%t - -[ConfirmRelease] -[UploadToCPAN] diff --git a/docs/presentation/css b/docs/presentation/css deleted file mode 120000 index e95a0e7..0000000 --- a/docs/presentation/css +++ /dev/null @@ -1 +0,0 @@ -reveal.js/css
\ No newline at end of file diff --git a/docs/presentation/css2 b/docs/presentation/css2 deleted file mode 120000 index 0ca84e4..0000000 --- a/docs/presentation/css2 +++ /dev/null @@ -1 +0,0 @@ -highlight.js/src/styles
\ No newline at end of file diff --git a/docs/presentation/highlight.js b/docs/presentation/highlight.js deleted file mode 160000 -Subproject ac3f2db5e434f6344d226d57d7e49290201696c diff --git a/docs/presentation/js b/docs/presentation/js deleted file mode 120000 index ebce293..0000000 --- a/docs/presentation/js +++ /dev/null @@ -1 +0,0 @@ -reveal.js/js
\ No newline at end of file diff --git a/docs/presentation/lib b/docs/presentation/lib deleted file mode 120000 index 892bcc7..0000000 --- a/docs/presentation/lib +++ /dev/null @@ -1 +0,0 @@ -reveal.js/lib
\ No newline at end of file diff --git a/docs/presentation/plugin b/docs/presentation/plugin deleted file mode 120000 index 426257b..0000000 --- a/docs/presentation/plugin +++ /dev/null @@ -1 +0,0 @@ -reveal.js/plugin
\ No newline at end of file diff --git a/docs/presentation/reveal.js b/docs/presentation/reveal.js deleted file mode 160000 -Subproject a349ff43c58c23f9c837b8ea9b5fc7d4761b8de diff --git a/docs/presentation/sietima.html b/docs/presentation/sietima.html deleted file mode 100644 index 8ac0a64..0000000 --- a/docs/presentation/sietima.html +++ /dev/null @@ -1,206 +0,0 @@ -<html> - <head> - <link rel="stylesheet" href="css/reveal.css"> - <link rel="stylesheet" href="css/theme/white.css" id="theme"> - <link rel="stylesheet" href="css2/github-gist.css"> - <style type="text/css"> - .reveal kbd { - font-size: 0.8em; - padding: 0.1em; - border: outset 0.2em #888; - background-color: #AAA; - color: #EEE; - } - </style> - <meta http-equiv="content-type" content="text/html; charset=utf-8"> - <title>Sietima — a minimalist MLM</title> - </head> - <body> - <div class="reveal"> - <div class="slides"> - <section> - <h1>Sietima — a minimalist MLM</h1> - <p>Author: dakkar <<a href="mailto:dakkar@thenautilus.net">dakkar@thenautilus.net</a>></p> - <p>Date: 2016-08-08</p> - </section> - <section> - <h2>A bit of history</h2> - <section> - <h3>Siesta</h3> - <aside class="notes"> - <p>Yes, I ran Siesta. It works!</p> - <p>I ran 3 lists, with 10-30 people on each</p> - <p>Richard Clamp, Greg McCarrol and Simon Winstow</p> - </aside> - </section> - <section> - <p>written in 2003</p> - </section> - <section> - <p>14 years ago</p> - </section> - <section> - <p><code>Class::DBI</code></p> - <p class="fragment">no <code>Moo(?:se)?</code></p> - <p class="fragment">Perl 5.8</p> - <aside class="notes"> - <p>Surely things have got better!</p> - <p>Can I rewrite it better?</p> - </aside> - </section> - </section> - <section> - <h2>Plugin style</h2> - <section> - <p>simple base class</p> - <pre><code class="perl">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; -}</code></pre> - </section> - <section> - <p>provide all the needed extensions points</p> - <pre><code class="perl">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), - }); -}</code></pre> - </section> - <section> - <p>but no more than that</p> - </section> - <section> - <p>traits / roles</p> - <ul class="fragment"> - <li><code>AvoidDups</code></li> - <li><code>Debounce</code></li> - <li><code>Headers</code></li> - <li><code>ManualSubscription</code></li> - <li><code>NoMail</code></li> - <li><code>ReplyTo</code></li> - <li><code>SubjectTag</code></li> - <li><code>SubscriberOnly::Drop</code></li> - <li><code>SubscriberOnly::Moderate</code></li> - </ul> - </section> - <section> - <p>try to avoid cross-trait dependencies</p> - <p class="fragment">«<code>ReplyTo</code> - needs <code>WithPostAddress</code>» is fine</p> - <p class="fragment">but - «<code>SubscriberOnly::Moderate</code> should be added - after <code>Debounce</code>» is not</p> - <p class="fragment">sadly I couldn't avoid it, suggestions - welcome</p> - <aside class="notes"> - <p>Debounce adds a X-Been-Here header; if that happens - before the message is put into moderation, when the - message comes out it will be dropped because it was - already seen!</p> - <p>Adding the header after the moderation happens is - fine</p> - </aside> - </section> - </section> - <section> - <h2>Driver</h2> - <section> - <p><code>App::Spec</code></p> - </section> - <section> - <p>minimal spec in base class</p> - <pre><code class="perl">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', - }, - }, - }; -}</code></pre> - </section> - <section> - <p>enriched by plugins</p> - <pre><code class="perl">around command_line_spec => sub ($orig,$self) { - my $spec = $self->$orig(); - $spec->{subcommands}{'show-held'} = { - op => 'show_mail_from_moderation_queue', - parameters => [ { - name => 'mail-id', required => 1, - completion => { op => sub ($self,$runner,$args) { - $self->mail_store->retrieve_ids_by_tags('moderation'); - } }, - } ], - }; - # etc etc - return $spec; -};</code></pre> - </section> - <section> - <pre>$ sietima-test <kbd>TAB</kbd> -drop-held -- drop the given mail, currently held for moderation -help -- Show command help -list-held -- list all mails currently held for moderation -resume-held -- resume the given mail, currently held for moderation -send -- send email from STDIN -show-held -- show the given mail, currently held for moderation</pre> - </section> - <section> - <pre>$ sietima-test show-held <kbd>TAB</kbd> -0f0571203ef5ee2f786b7f7f2832093ed4c34fe8 -4d43ee7a2a17457606c07475b14054839fad9b7e</pre> - </section> - </section> - <section> - <h2>Production ready!</h2> - <section> - <p>all my lists now run with Sietima</p> - </section> - <section> - <p>on CPAN now</p> - </section> - </section> - <section> - <h2>CPAN is awesome</h2> - <section> - <p><code>Email::*</code>, RJBS</p> - </section> - <section> - <p><code>Moo</code>, MST + HAARG</p> - <p><code>Type::Tiny</code>, TOBYINK</p> - </section> - <section> - <p><code>App::Spec</code>, TINITA</p> - </section> - <section> - <p><code>Test2</code>, EXODIST</p> - </section> - </section> - <section> - <h2>Thank you</h2> - </section> - </div> - </div> - <script src="lib/js/head.min.js"></script> - <script src="js/reveal.js"></script> - <script> - Reveal.initialize({ - dependencies: [ - { src: 'plugin/highlight/highlight.js', - async: true, - callback: function() { hljs.initHighlightingOnLoad(); } - }, - { src: 'plugin/notes/notes.js', async: true } - ], - }); - </script> - </body> -</html> diff --git a/lib/Sietima.pm b/lib/Sietima.pm index 52473f9..d30be2b 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.1'; # 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.1 + =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 diff --git a/lib/Sietima/CmdLine.pm b/lib/Sietima/CmdLine.pm index 180d3dd..ca88c71 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.1'; # 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.1 + =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..2b04eb5 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.1'; # VERSION # ABSTRACT: annotated URI for list headers + +has uri => ( + is => 'ro', + isa => Uri, + required => 1, + coerce => 1, +); + + +has comment => ( + is => 'ro', + isa => Str, +); + + +sub _args_from_address($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.1 + =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..911c183 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.1'; # 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.1 + =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..5fc1814 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.1'; # 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.1 + +=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..7073115 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.1'; # 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.1 + =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..68e85a5 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.1'; # 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.1 + =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..7f7a5c6 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.1'; # 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.1 + +=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..9e143b4 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.1'; # 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.1 + =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..e4422c6 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.1'; # 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.1 + +=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..5c884ec 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.1'; # 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.1 + =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..0f333ea 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.1'; # 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.1 + =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..88efdc7 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.1'; # 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.1 + =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/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm index 5ba828b..416e387 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.1'; # 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.1 + =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..d215f5e 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.1'; # 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.1 + =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..2ecb160 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.1'; # 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.1 + =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..0eb63b0 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.1'; # 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.1 + =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..1450597 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.1'; # 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.1 + =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..7fc1e37 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.1'; # 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.1 + =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..6800ab0 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.1'; # 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.1 + =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..f8ad443 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.1'; # 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.1 + =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..b4100d8 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.1'; # 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.1 + =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..a1c047a 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.1'; # 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.1 + +=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..2d9c6b4 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.1'; # 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.1 + +=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 diff --git a/t/author-critic.t b/t/author-critic.t new file mode 100644 index 0000000..22becf1 --- /dev/null +++ b/t/author-critic.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + + +use strict; +use warnings; + +use Test::Perl::Critic (-profile => "perlcritic.rc") x!! -e "perlcritic.rc"; +all_critic_ok(); diff --git a/t/author-no-tabs.t b/t/author-no-tabs.t new file mode 100644 index 0000000..8005d5e --- /dev/null +++ b/t/author-no-tabs.t @@ -0,0 +1,64 @@ + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + +use strict; +use warnings; + +# this test was generated with Dist::Zilla::Plugin::Test::NoTabs 0.15 + +use Test::More 0.88; +use Test::NoTabs; + +my @files = ( + 'lib/Sietima.pm', + 'lib/Sietima/CmdLine.pm', + 'lib/Sietima/HeaderURI.pm', + 'lib/Sietima/MailStore.pm', + 'lib/Sietima/MailStore/FS.pm', + 'lib/Sietima/Message.pm', + 'lib/Sietima/Policy.pm', + 'lib/Sietima/Role/AvoidDups.pm', + 'lib/Sietima/Role/Debounce.pm', + 'lib/Sietima/Role/Headers.pm', + 'lib/Sietima/Role/ManualSubscription.pm', + 'lib/Sietima/Role/NoMail.pm', + 'lib/Sietima/Role/NoSpoof.pm', + 'lib/Sietima/Role/ReplyTo.pm', + 'lib/Sietima/Role/SubjectTag.pm', + 'lib/Sietima/Role/SubscriberOnly.pm', + 'lib/Sietima/Role/SubscriberOnly/Drop.pm', + 'lib/Sietima/Role/SubscriberOnly/Moderate.pm', + 'lib/Sietima/Role/WithMailStore.pm', + 'lib/Sietima/Role/WithOwner.pm', + 'lib/Sietima/Role/WithPostAddress.pm', + 'lib/Sietima/Runner.pm', + 'lib/Sietima/Subscriber.pm', + 'lib/Sietima/Types.pm', + 't/lib/Test/Sietima.pm', + 't/lib/Test/Sietima/MailStore.pm', + 't/tests/sietima.t', + 't/tests/sietima/cmdline.t', + 't/tests/sietima/headeruri.t', + 't/tests/sietima/mailstore.t', + 't/tests/sietima/message.t', + 't/tests/sietima/multi-role/debounce-moderate.t', + 't/tests/sietima/role/avoid-dups.t', + 't/tests/sietima/role/debounce.t', + 't/tests/sietima/role/headers.t', + 't/tests/sietima/role/manualsubscription.t', + 't/tests/sietima/role/nomail.t', + 't/tests/sietima/role/nospoof.t', + 't/tests/sietima/role/replyto.t', + 't/tests/sietima/role/subject-tag.t', + 't/tests/sietima/role/subscriberonly/drop.t', + 't/tests/sietima/role/subscriberonly/moderate.t', + 't/tests/sietima/subscriber.t' +); + +notabs_ok($_) foreach @files; +done_testing; diff --git a/t/author-pod-coverage.t b/t/author-pod-coverage.t new file mode 100644 index 0000000..09473df --- /dev/null +++ b/t/author-pod-coverage.t @@ -0,0 +1,16 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. +use strict; +use warnings; +use Test::Pod::Coverage 1.08; +use Pod::Coverage::TrustPod; + +all_pod_coverage_ok({ coverage_class => 'Pod::Coverage::TrustPod' }); diff --git a/t/author-pod-syntax.t b/t/author-pod-syntax.t new file mode 100644 index 0000000..2233af0 --- /dev/null +++ b/t/author-pod-syntax.t @@ -0,0 +1,15 @@ +#!perl + +BEGIN { + unless ($ENV{AUTHOR_TESTING}) { + print qq{1..0 # SKIP these tests are for testing by the author\n}; + exit + } +} + +# This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. +use strict; use warnings; +use Test::More; +use Test::Pod 1.41; + +all_pod_files_ok(); diff --git a/weaver.ini b/weaver.ini deleted file mode 100644 index f4c9077..0000000 --- a/weaver.ini +++ /dev/null @@ -1,41 +0,0 @@ -[@CorePrep] - -[-SingleEncoding] - -[Name] -[Version] - -[Region / prelude] - -[Generic / SYNOPSIS] -[Generic / DESCRIPTION] -[Generic / OVERVIEW] - -[Collect / ATTRIBUTES] -command = attr - -[Collect / REQUIRED METHODS] -command = require - -[Collect / METHODS] -command = method - -[Collect / MODIFIED METHODS] -command = modif - -[Collect / FUNCTIONS] -command = func - -[Collect / TYPES] -command = type - -[Leftovers] - -[Region / postlude] - -[Authors] -[Legal] - -[-Transformer / Lists] -transformer = List -format_name = list |