KevinSchoenmayer/GseTDDUebungKCLR
2
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Riley Schneider
2025-12-03 16:38:10 +01:00
parent c5e26bf594
commit b732d8d4b5
17680 changed files with 5977495 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

152
database/perl/vendor/lib/Email/Sender/Failure.pm vendored Normal file
View File

@@ -0,0 +1,152 @@
package Email::Sender::Failure;
# ABSTRACT: a report of failure from an email sending transport
$Email::Sender::Failure::VERSION = '1.300035';
use Moo;
extends 'Throwable::Error';
use Carp ();
use MooX::Types::MooseLike::Base qw(ArrayRef);
#pod =attr message
#pod
#pod This method returns the failure message, which should describe the failure.
#pod Failures stringify to this message.
#pod
#pod =attr code
#pod
#pod This returns the numeric code of the failure, if any. This is mostly useful
#pod for network protocol transports like SMTP. This may be undefined.
#pod
#pod =cut
has code => (
is => 'ro',
);
#pod =attr recipients
#pod
#pod This returns a list of addresses to which the email could not be sent.
#pod
#pod =cut
has recipients => (
isa => ArrayRef,
default => sub { [] },
writer => '_set_recipients',
reader => '__get_recipients',
is => 'rw',
accessor => undef,
);
sub __recipients { @{$_[0]->__get_recipients} }
sub recipients {
my ($self) = @_;
return $self->__recipients if wantarray;
return if ! defined wantarray;
Carp::carp("recipients in scalar context is deprecated and WILL BE REMOVED");
return $self->__get_recipients;
}
#pod =method throw
#pod
#pod This method can be used to instantiate and throw an Email::Sender::Failure
#pod object at once.
#pod
#pod Email::Sender::Failure->throw(\%arg);
#pod
#pod Instead of a hashref of args, you can pass a single string argument which will
#pod be used as the C<message> of the new failure.
#pod
#pod =cut
sub BUILD {
my ($self) = @_;
Carp::confess("message must contain non-space characters")
unless $self->message =~ /\S/;
}
#pod =head1 SEE ALSO
#pod
#pod =over
#pod
#pod =item * L<Email::Sender::Permanent>
#pod
#pod =item * L<Email::Sender::Temporary>
#pod
#pod =item * L<Email::Sender::Multi>
#pod
#pod =back
#pod
#pod =cut
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Failure - a report of failure from an email sending transport
=head1 VERSION
version 1.300035
=head1 ATTRIBUTES
=head2 message
This method returns the failure message, which should describe the failure.
Failures stringify to this message.
=head2 code
This returns the numeric code of the failure, if any. This is mostly useful
for network protocol transports like SMTP. This may be undefined.
=head2 recipients
This returns a list of addresses to which the email could not be sent.
=head1 METHODS
=head2 throw
This method can be used to instantiate and throw an Email::Sender::Failure
object at once.
Email::Sender::Failure->throw(\%arg);
Instead of a hashref of args, you can pass a single string argument which will
be used as the C<message> of the new failure.
=head1 SEE ALSO
=over
=item * L<Email::Sender::Permanent>
=item * L<Email::Sender::Temporary>
=item * L<Email::Sender::Multi>
=back
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

119
database/perl/vendor/lib/Email/Sender/Failure/Multi.pm vendored Normal file
View File

@@ -0,0 +1,119 @@
package Email::Sender::Failure::Multi;
# ABSTRACT: an aggregate of multiple failures
$Email::Sender::Failure::Multi::VERSION = '1.300035';
use Moo;
extends 'Email::Sender::Failure';
use MooX::Types::MooseLike::Base qw(ArrayRef);
#pod =head1 DESCRIPTION
#pod
#pod A multiple failure report is raised when more than one failure is encountered
#pod when sending a single message, or when mixed states were encountered.
#pod
#pod =attr failures
#pod
#pod This method returns a list of other Email::Sender::Failure objects represented
#pod by this multi.
#pod
#pod =cut
has failures => (
is => 'ro',
isa => ArrayRef,
required => 1,
reader => '__get_failures',
);
sub __failures { @{$_[0]->__get_failures} }
sub failures {
my ($self) = @_;
return $self->__failures if wantarray;
return if ! defined wantarray;
Carp::carp("failures in scalar context is deprecated and WILL BE REMOVED");
return $self->__get_failures;
}
sub recipients {
my ($self) = @_;
my @rcpts = map { $_->recipients } $self->failures;
return @rcpts if wantarray;
return if ! defined wantarray;
Carp::carp("recipients in scalar context is deprecated and WILL BE REMOVED");
return \@rcpts;
}
#pod =method isa
#pod
#pod A multiple failure will report that it is a Permanent or Temporary if all of
#pod its contained failures are failures of that type.
#pod
#pod =cut
sub isa {
my ($self, $class) = @_;
if (
$class eq 'Email::Sender::Failure::Permanent'
or
$class eq 'Email::Sender::Failure::Temporary'
) {
my @failures = $self->failures;
return 1 if @failures == grep { $_->isa($class) } @failures;
}
return $self->SUPER::isa($class);
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Failure::Multi - an aggregate of multiple failures
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
A multiple failure report is raised when more than one failure is encountered
when sending a single message, or when mixed states were encountered.
=head1 ATTRIBUTES
=head2 failures
This method returns a list of other Email::Sender::Failure objects represented
by this multi.
=head1 METHODS
=head2 isa
A multiple failure will report that it is a Permanent or Temporary if all of
its contained failures are failures of that type.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

35
database/perl/vendor/lib/Email/Sender/Failure/Permanent.pm vendored Normal file
View File

@@ -0,0 +1,35 @@
package Email::Sender::Failure::Permanent;
# ABSTRACT: a permanent delivery failure
$Email::Sender::Failure::Permanent::VERSION = '1.300035';
use Moo;
extends 'Email::Sender::Failure';
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Failure::Permanent - a permanent delivery failure
=head1 VERSION
version 1.300035
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

35
database/perl/vendor/lib/Email/Sender/Failure/Temporary.pm vendored Normal file
View File

@@ -0,0 +1,35 @@
package Email::Sender::Failure::Temporary;
# ABSTRACT: a temporary delivery failure
$Email::Sender::Failure::Temporary::VERSION = '1.300035';
use Moo;
extends 'Email::Sender::Failure';
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Failure::Temporary - a temporary delivery failure
=head1 VERSION
version 1.300035
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

45
database/perl/vendor/lib/Email/Sender/Manual.pm vendored Normal file
View File

@@ -0,0 +1,45 @@
use strict;
use warnings;
package Email::Sender::Manual;
# ABSTRACT: table of contents for the Email::Sender manual
$Email::Sender::Manual::VERSION = '1.300035';
#pod =head1 THE MANUAL
#pod
#pod L<Email::Sender::Manual::QuickStart> tells you just what you need to know to
#pod start using Email::Sender.
#pod
#pod =cut
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Manual - table of contents for the Email::Sender manual
=head1 VERSION
version 1.300035
=head1 THE MANUAL
L<Email::Sender::Manual::QuickStart> tells you just what you need to know to
start using Email::Sender.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

499
database/perl/vendor/lib/Email/Sender/Manual/QuickStart.pm vendored Normal file
View File

@@ -0,0 +1,499 @@
use strict;
use warnings;
package Email::Sender::Manual::QuickStart;
# ABSTRACT: how to start using Email::Sender right now
$Email::Sender::Manual::QuickStart::VERSION = '1.300035';
#pod =head1 QUICK START
#pod
#pod =head2 Let's Send Some Mail!
#pod
#pod No messing around, let's just send some mail.
#pod
#pod use strict;
#pod use Email::Sender::Simple qw(sendmail);
#pod use Email::MIME;
#pod
#pod # You can make an email object in lots of ways. Pick one you like!
#pod my $email = Email::MIME->create(...);
#pod
#pod sendmail($email);
#pod
#pod That's it. Your message goes out into the internet and tries to get delivered
#pod to C<x.ample@example.com>.
#pod
#pod In the example above, C<$email> could be an Email::MIME object, a MIME::Entity,
#pod a string containing an email message, or one of several other types of input.
#pod If C<Email::Abstract> can understand a value, it can be passed to
#pod Email::Sender::Simple. Email::Sender::Simple tries to make a good guess about
#pod how to send the message. It will usually try to use the F<sendmail> program on
#pod unix-like systems and to use SMTP on Windows. You can specify a transport, if
#pod you need to, but normally that shouldn't be an issue. (See L</Picking a
#pod Transport>, though, for more information.)
#pod
#pod Also note that we imported and used a C<sendmail> routine in the example above.
#pod This is exactly the same as saying:
#pod
#pod Email::Sender::Simple->send($email);
#pod
#pod ...but it's a lot easier to type. You can use either one.
#pod
#pod =head3 envelope information
#pod
#pod We didn't have to tell Email::Sender::Simple where to send the message. If you
#pod don't specify recipients, it will use all the email addresses it can find in
#pod the F<To> and F<Cc> headers by default. It will use L<Email::Address> to parse
#pod those fields. Similarly, if no sender is specified, it will use the first
#pod address found in the F<From> header.
#pod
#pod In most email transmission systems, though, the headers are not by necessity
#pod tied to the addresses used as the sender and recipients. For example, your
#pod message header might say "From: mailing-list@example.com" while your SMTP
#pod client says "MAIL FROM:E<lt>verp-1234@lists.example.comE<gt>". This is a
#pod powerful feature, and is necessary for many email application. Being able to
#pod set those distinctly is important, and Email::Sender::Simple lets you do this:
#pod
#pod sendmail($email, { to => [ $to_1, $to_2 ], from => $sender });
#pod
#pod =head3 in case of error
#pod
#pod When the message is sent successfully (at least on to its next hop),
#pod C<sendmail> will return a true value -- specifically, an
#pod L<Email::Sender::Success> object. This object only rarely has much use.
#pod What's more useful is what happens if the message can't be sent.
#pod
#pod If there is an error sending the message, an exception will be thrown. It will
#pod be an object belonging to the class L<Email::Sender::Failure>. This object
#pod will have a C<message> attribute describing the nature of the failure. There
#pod are several specialized forms of failure, like
#pod L<Email::Sender::Failure::Multi>, which is thrown when more than one error is
#pod encountered when trying to send. You don't need to know about these to use
#pod Email::Sender::Simple, though. All you need to know is that C<sendmail>
#pod returns true on success and dies on failure.
#pod
#pod If you'd rather not have to catch exceptions for failure to send mail, you can
#pod use the C<try_to_send> method, which can be imported as C<try_to_sendmail>.
#pod This method will return just false on failure to send mail.
#pod
#pod For example:
#pod
#pod Email::Sender::Simple->try_to_send($email, { ... });
#pod
#pod use Email::Sender::Simple qw(try_to_sendmail);
#pod try_to_sendmail($email, { ... });
#pod
#pod Some Email::Sender transports can signal success if some, but not all,
#pod recipients could be reached. Email::Sender::Simple does its best to ensure
#pod that this never happens. When you are using Email::Sender::Simple, mail should
#pod either be sent or not. Partial success should never occur.
#pod
#pod =head2 Picking a Transport
#pod
#pod =head3 passing in your own transport
#pod
#pod If Email::Sender::Simple doesn't pick the transport you want, or if you have
#pod more specific needs, you can specify a transport in several ways. The simplest
#pod is to build a transport object and pass it in. You can read more about
#pod transports elsewhere. For now, we'll just assume that you need to send mail
#pod via SMTP on an unusual port. You can send mail like this:
#pod
#pod my $transport = Email::Sender::Transport::SMTP->new({
#pod host => 'smtp.example.com',
#pod port => 2525,
#pod });
#pod
#pod sendmail($email, { transport => $transport });
#pod
#pod Now, instead of guessing at what transport to use, Email::Sender::Simple will
#pod use the one you provided. This transport will have to be specified for each
#pod call to C<sendmail>, so you might want to look at other options, which follow.
#pod
#pod =head3 specifying transport in the environment
#pod
#pod If you have a program that makes several calls to Email::Sender::Simple, and
#pod you need to run this program using a different mailserver, you can set
#pod environment variables to change the default. For example:
#pod
#pod $ export EMAIL_SENDER_TRANSPORT=SMTP
#pod $ export EMAIL_SENDER_TRANSPORT_host=smtp.example.com
#pod $ export EMAIL_SENDER_TRANSPORT_port=2525
#pod
#pod $ perl your-program
#pod
#pod It is important to note that if you have set the default transport by using the
#pod environment, I<< no subsequent C<transport> args to C<sendmail> will be
#pod respected >>. If you set the default transport via the environment, that's it.
#pod Everything will use that transport. (Also, note that while we gave the host and
#pod port arguments above in lower case, the casing of arguments in the environment
#pod is flattened to support systems where environment variables are of a fixed
#pod case. So, C<EMAIL_SENDER_TRANSPORT_PORT> would also work.
#pod
#pod This is extremely valuable behavior, as it allows you to audit every message
#pod that would be sent by a program by running something like this:
#pod
#pod $ export EMAIL_SENDER_TRANSPORT=Maildir
#pod $ perl your-program
#pod
#pod In that example, any message sent via Email::Sender::Simple would be delivered
#pod to a maildir in the current directory.
#pod
#pod =head3 subclassing to change the default transport
#pod
#pod If you want to use a library that will behave like Email::Sender::Simple but
#pod with a different default transport, you can subclass Email::Sender::Simple and
#pod replace the C<build_default_transport> method.
#pod
#pod =head2 Testing
#pod
#pod Email::Sender::Simple makes it very, very easy to test code that sends email.
#pod The simplest way is to do something like this:
#pod
#pod use Test::More;
#pod BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} = 'Test' }
#pod use YourCode;
#pod
#pod YourCode->run;
#pod
#pod my @deliveries = Email::Sender::Simple->default_transport->deliveries;
#pod
#pod Now you've got an array containing every delivery performed through
#pod Email::Sender::Simple, in order. Because you set the transport via the
#pod environment, no other code will be able to force a different transport.
#pod
#pod When testing code that forks, L<Email::Sender::Transport::SQLite> can be used
#pod to allow every child process to deliver to a single, easy to inspect
#pod destination database.
#pod
#pod =head2 Hey, where's my Bcc support?
#pod
#pod A common question is "Why doesn't Email::Sender::Simple automatically respect
#pod my Bcc header?" This is often combined with, "Here is a patch to 'fix' it."
#pod This is not a bug or oversight. Bcc is being ignored intentionally for now
#pod because simply adding the Bcc addresses to the message recipients would not
#pod produce the usually-desired behavior.
#pod
#pod For example, here is a set of headers:
#pod
#pod From: sender@example.com
#pod To: to_rcpt@example.com
#pod Cc: cc_rcpt@example.com
#pod Bcc: the_boss@example.com
#pod
#pod In this case, we'd expect the message to be delivered to three people:
#pod to_rcpt, cc_rcpt, and the_boss. This is why it's often suggested that the
#pod Bcc header should be a source for envelope recipients. In fact, though, a
#pod message with a Bcc header should probably be delivered I<only> to the Bcc
#pod recipients. The "B" in Bcc means "blind." The other recipients should not
#pod see who has been Bcc'd. This means you want to send I<two> messages: one to
#pod to_rcpt and cc_rcpt, with no Bcc header present; and another to the_boss
#pod only, with the Bcc header. B<If you just pick up Bcc addresses as
#pod recipients, everyone will see who was Bcc'd.>
#pod
#pod Email::Sender::Simple promises to send messages atomically. That is: it
#pod won't deliver to only some of the recipients, and not to others. That means
#pod it can't automatically detect the Bcc header and make two deliveries. There
#pod would be a possibility for the second to fail after the first succeeded,
#pod which would break the promise of a pure failure or success.
#pod
#pod The other strategy for dealing with Bcc is to remove the Bcc header from the
#pod message and then inject the message with an envelope including the Bcc
#pod addresses. The envelope information will not be visible to the final
#pod recipients, so this is safe. Unfortunately, this requires modifying the
#pod message, and Email::Sender::Simple should not be altering the mutable email
#pod object passed to it. There is no C<clone> method on Email::Abstract, so it
#pod cannot just build a clone and modify that, either. When such a method
#pod exists, Bcc handling may be possible.
#pod
#pod =head3 Example Bcc Handling
#pod
#pod If you want to support the Bcc header now, it is up to you to deal with how
#pod you want to munge the mail and inject the (possibly) munged copies into your
#pod outbound mailflow. It is not reasonable to suggest that
#pod Email::Sender::Simple do this job.
#pod
#pod =head4 Example 1: Explicitly set the envelope recipients for Bcc recipients
#pod
#pod Create the email without a Bcc header, send it to the Bcc users explicitly
#pod and then send it to the To/Cc users implicitly.
#pod
#pod my $message = create_email_mime_msg; # <- whatever you do to get the message
#pod
#pod $message->header_set('bcc'); # delete the Bcc header before sending
#pod sendmail($message, { to => $rcpt }); # send to explicit Bcc address
#pod sendmail($message); # and then send as normal
#pod
#pod =head4 Example 2: Explicitly set the envelope recipients for all recipients
#pod
#pod You can make a single call to C<sendmail> by pulling all the recipient
#pod addresses from the headers yourself and specifying all the envelope
#pod recipients once. Again, delete the Bcc header before the message is sent.
#pod
#pod =head1 SEE ALSO
#pod
#pod =head2 This is awesome! Where can I learn more?
#pod
#pod Have a look at L<Email::Sender::Manual>, where all the manual's documents are
#pod listed. You can also look at the documentation for L<Email::Sender::Simple>
#pod and the various Email::Sender::Transport classes.
#pod
#pod =cut
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Manual::QuickStart - how to start using Email::Sender right now
=head1 VERSION
version 1.300035
=head1 QUICK START
=head2 Let's Send Some Mail!
No messing around, let's just send some mail.
use strict;
use Email::Sender::Simple qw(sendmail);
use Email::MIME;
# You can make an email object in lots of ways. Pick one you like!
my $email = Email::MIME->create(...);
sendmail($email);
That's it. Your message goes out into the internet and tries to get delivered
to C<x.ample@example.com>.
In the example above, C<$email> could be an Email::MIME object, a MIME::Entity,
a string containing an email message, or one of several other types of input.
If C<Email::Abstract> can understand a value, it can be passed to
Email::Sender::Simple. Email::Sender::Simple tries to make a good guess about
how to send the message. It will usually try to use the F<sendmail> program on
unix-like systems and to use SMTP on Windows. You can specify a transport, if
you need to, but normally that shouldn't be an issue. (See L</Picking a
Transport>, though, for more information.)
Also note that we imported and used a C<sendmail> routine in the example above.
This is exactly the same as saying:
Email::Sender::Simple->send($email);
...but it's a lot easier to type. You can use either one.
=head3 envelope information
We didn't have to tell Email::Sender::Simple where to send the message. If you
don't specify recipients, it will use all the email addresses it can find in
the F<To> and F<Cc> headers by default. It will use L<Email::Address> to parse
those fields. Similarly, if no sender is specified, it will use the first
address found in the F<From> header.
In most email transmission systems, though, the headers are not by necessity
tied to the addresses used as the sender and recipients. For example, your
message header might say "From: mailing-list@example.com" while your SMTP
client says "MAIL FROM:E<lt>verp-1234@lists.example.comE<gt>". This is a
powerful feature, and is necessary for many email application. Being able to
set those distinctly is important, and Email::Sender::Simple lets you do this:
sendmail($email, { to => [ $to_1, $to_2 ], from => $sender });
=head3 in case of error
When the message is sent successfully (at least on to its next hop),
C<sendmail> will return a true value -- specifically, an
L<Email::Sender::Success> object. This object only rarely has much use.
What's more useful is what happens if the message can't be sent.
If there is an error sending the message, an exception will be thrown. It will
be an object belonging to the class L<Email::Sender::Failure>. This object
will have a C<message> attribute describing the nature of the failure. There
are several specialized forms of failure, like
L<Email::Sender::Failure::Multi>, which is thrown when more than one error is
encountered when trying to send. You don't need to know about these to use
Email::Sender::Simple, though. All you need to know is that C<sendmail>
returns true on success and dies on failure.
If you'd rather not have to catch exceptions for failure to send mail, you can
use the C<try_to_send> method, which can be imported as C<try_to_sendmail>.
This method will return just false on failure to send mail.
For example:
Email::Sender::Simple->try_to_send($email, { ... });
use Email::Sender::Simple qw(try_to_sendmail);
try_to_sendmail($email, { ... });
Some Email::Sender transports can signal success if some, but not all,
recipients could be reached. Email::Sender::Simple does its best to ensure
that this never happens. When you are using Email::Sender::Simple, mail should
either be sent or not. Partial success should never occur.
=head2 Picking a Transport
=head3 passing in your own transport
If Email::Sender::Simple doesn't pick the transport you want, or if you have
more specific needs, you can specify a transport in several ways. The simplest
is to build a transport object and pass it in. You can read more about
transports elsewhere. For now, we'll just assume that you need to send mail
via SMTP on an unusual port. You can send mail like this:
my $transport = Email::Sender::Transport::SMTP->new({
host => 'smtp.example.com',
port => 2525,
});
sendmail($email, { transport => $transport });
Now, instead of guessing at what transport to use, Email::Sender::Simple will
use the one you provided. This transport will have to be specified for each
call to C<sendmail>, so you might want to look at other options, which follow.
=head3 specifying transport in the environment
If you have a program that makes several calls to Email::Sender::Simple, and
you need to run this program using a different mailserver, you can set
environment variables to change the default. For example:
$ export EMAIL_SENDER_TRANSPORT=SMTP
$ export EMAIL_SENDER_TRANSPORT_host=smtp.example.com
$ export EMAIL_SENDER_TRANSPORT_port=2525
$ perl your-program
It is important to note that if you have set the default transport by using the
environment, I<< no subsequent C<transport> args to C<sendmail> will be
respected >>. If you set the default transport via the environment, that's it.
Everything will use that transport. (Also, note that while we gave the host and
port arguments above in lower case, the casing of arguments in the environment
is flattened to support systems where environment variables are of a fixed
case. So, C<EMAIL_SENDER_TRANSPORT_PORT> would also work.
This is extremely valuable behavior, as it allows you to audit every message
that would be sent by a program by running something like this:
$ export EMAIL_SENDER_TRANSPORT=Maildir
$ perl your-program
In that example, any message sent via Email::Sender::Simple would be delivered
to a maildir in the current directory.
=head3 subclassing to change the default transport
If you want to use a library that will behave like Email::Sender::Simple but
with a different default transport, you can subclass Email::Sender::Simple and
replace the C<build_default_transport> method.
=head2 Testing
Email::Sender::Simple makes it very, very easy to test code that sends email.
The simplest way is to do something like this:
use Test::More;
BEGIN { $ENV{EMAIL_SENDER_TRANSPORT} = 'Test' }
use YourCode;
YourCode->run;
my @deliveries = Email::Sender::Simple->default_transport->deliveries;
Now you've got an array containing every delivery performed through
Email::Sender::Simple, in order. Because you set the transport via the
environment, no other code will be able to force a different transport.
When testing code that forks, L<Email::Sender::Transport::SQLite> can be used
to allow every child process to deliver to a single, easy to inspect
destination database.
=head2 Hey, where's my Bcc support?
A common question is "Why doesn't Email::Sender::Simple automatically respect
my Bcc header?" This is often combined with, "Here is a patch to 'fix' it."
This is not a bug or oversight. Bcc is being ignored intentionally for now
because simply adding the Bcc addresses to the message recipients would not
produce the usually-desired behavior.
For example, here is a set of headers:
From: sender@example.com
To: to_rcpt@example.com
Cc: cc_rcpt@example.com
Bcc: the_boss@example.com
In this case, we'd expect the message to be delivered to three people:
to_rcpt, cc_rcpt, and the_boss. This is why it's often suggested that the
Bcc header should be a source for envelope recipients. In fact, though, a
message with a Bcc header should probably be delivered I<only> to the Bcc
recipients. The "B" in Bcc means "blind." The other recipients should not
see who has been Bcc'd. This means you want to send I<two> messages: one to
to_rcpt and cc_rcpt, with no Bcc header present; and another to the_boss
only, with the Bcc header. B<If you just pick up Bcc addresses as
recipients, everyone will see who was Bcc'd.>
Email::Sender::Simple promises to send messages atomically. That is: it
won't deliver to only some of the recipients, and not to others. That means
it can't automatically detect the Bcc header and make two deliveries. There
would be a possibility for the second to fail after the first succeeded,
which would break the promise of a pure failure or success.
The other strategy for dealing with Bcc is to remove the Bcc header from the
message and then inject the message with an envelope including the Bcc
addresses. The envelope information will not be visible to the final
recipients, so this is safe. Unfortunately, this requires modifying the
message, and Email::Sender::Simple should not be altering the mutable email
object passed to it. There is no C<clone> method on Email::Abstract, so it
cannot just build a clone and modify that, either. When such a method
exists, Bcc handling may be possible.
=head3 Example Bcc Handling
If you want to support the Bcc header now, it is up to you to deal with how
you want to munge the mail and inject the (possibly) munged copies into your
outbound mailflow. It is not reasonable to suggest that
Email::Sender::Simple do this job.
=head4 Example 1: Explicitly set the envelope recipients for Bcc recipients
Create the email without a Bcc header, send it to the Bcc users explicitly
and then send it to the To/Cc users implicitly.
my $message = create_email_mime_msg; # <- whatever you do to get the message
$message->header_set('bcc'); # delete the Bcc header before sending
sendmail($message, { to => $rcpt }); # send to explicit Bcc address
sendmail($message); # and then send as normal
=head4 Example 2: Explicitly set the envelope recipients for all recipients
You can make a single call to C<sendmail> by pulling all the recipient
addresses from the headers yourself and specifying all the envelope
recipients once. Again, delete the Bcc header before the message is sent.
=head1 SEE ALSO
=head2 This is awesome! Where can I learn more?
Have a look at L<Email::Sender::Manual>, where all the manual's documents are
listed. You can also look at the documentation for L<Email::Sender::Simple>
and the various Email::Sender::Transport classes.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

184
database/perl/vendor/lib/Email/Sender/Role/CommonSending.pm vendored Normal file
View File

@@ -0,0 +1,184 @@
package Email::Sender::Role::CommonSending;
# ABSTRACT: the common sending tasks most Email::Sender classes will need
$Email::Sender::Role::CommonSending::VERSION = '1.300035';
use Moo::Role;
use Carp ();
use Email::Abstract 3.006;
use Email::Sender::Success;
use Email::Sender::Failure::Temporary;
use Email::Sender::Failure::Permanent;
use Scalar::Util ();
use Try::Tiny;
#pod =head1 DESCRIPTION
#pod
#pod Email::Sender::Role::CommonSending provides a number of features that should
#pod ease writing new classes that perform the L<Email::Sender> role. Instead of
#pod writing a C<send> method, implementors will need to write a smaller
#pod C<send_email> method, which will be passed an L<Email::Abstract> object and
#pod envelope containing C<from> and C<to> entries. The C<to> entry will be
#pod guaranteed to be an array reference.
#pod
#pod A C<success> method will also be provided as a shortcut for calling:
#pod
#pod Email::Sender::Success->new(...);
#pod
#pod A few other minor details are handled by CommonSending; for more information,
#pod consult the source.
#pod
#pod The methods documented here may be overridden to alter the behavior of the
#pod CommonSending role.
#pod
#pod =cut
with 'Email::Sender';
requires 'send_email';
sub send {
my ($self, $message, $env, @rest) = @_;
my $email = $self->prepare_email($message);
my $envelope = $self->prepare_envelope($env);
try {
return $self->send_email($email, $envelope, @rest);
} catch {
Carp::confess('unknown error') unless my $err = $_;
if (
try { $err->isa('Email::Sender::Failure') }
and ! (my @tmp = $err->recipients)
) {
$err->_set_recipients([ @{ $envelope->{to} } ]);
}
die $err;
}
}
#pod =method prepare_email
#pod
#pod This method is passed a scalar and is expected to return an Email::Abstract
#pod object. You probably shouldn't override it in most cases.
#pod
#pod =cut
sub prepare_email {
my ($self, $msg) = @_;
Carp::confess("no email passed in to sender") unless defined $msg;
# We check blessed because if someone would pass in a large message, in some
# perls calling isa on the string would create a package with the string as
# the name. If the message was (say) two megs, now you'd have a two meg hash
# key in the stash. Oops! -- rjbs, 2008-12-04
return $msg if Scalar::Util::blessed($msg) and eval { $msg->isa('Email::Abstract') };
return Email::Abstract->new($msg);
}
#pod =method prepare_envelope
#pod
#pod This method is passed a hashref and returns a new hashref that should be used
#pod as the envelope passed to the C<send_email> method. This method is responsible
#pod for ensuring that the F<to> entry is an array.
#pod
#pod =cut
sub prepare_envelope {
my ($self, $env) = @_;
my %new_env;
$new_env{to} = ref $env->{to} ? $env->{to} : [ grep {defined} $env->{to} ];
$new_env{from} = $env->{from};
return \%new_env;
}
#pod =method success
#pod
#pod ...
#pod return $self->success;
#pod
#pod This method returns a new Email::Sender::Success object. Arguments passed to
#pod this method are passed along to the Success's constructor. This is provided as
#pod a convenience for returning success from subclasses' C<send_email> methods.
#pod
#pod =cut
sub success {
my $self = shift;
my $success = Email::Sender::Success->new(@_);
}
no Moo::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Role::CommonSending - the common sending tasks most Email::Sender classes will need
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
Email::Sender::Role::CommonSending provides a number of features that should
ease writing new classes that perform the L<Email::Sender> role. Instead of
writing a C<send> method, implementors will need to write a smaller
C<send_email> method, which will be passed an L<Email::Abstract> object and
envelope containing C<from> and C<to> entries. The C<to> entry will be
guaranteed to be an array reference.
A C<success> method will also be provided as a shortcut for calling:
Email::Sender::Success->new(...);
A few other minor details are handled by CommonSending; for more information,
consult the source.
The methods documented here may be overridden to alter the behavior of the
CommonSending role.
=head1 METHODS
=head2 prepare_email
This method is passed a scalar and is expected to return an Email::Abstract
object. You probably shouldn't override it in most cases.
=head2 prepare_envelope
This method is passed a hashref and returns a new hashref that should be used
as the envelope passed to the C<send_email> method. This method is responsible
for ensuring that the F<to> entry is an array.
=head2 success
...
return $self->success;
This method returns a new Email::Sender::Success object. Arguments passed to
this method are passed along to the Success's constructor. This is provided as
a convenience for returning success from subclasses' C<send_email> methods.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

51
database/perl/vendor/lib/Email/Sender/Role/HasMessage.pm vendored Normal file
View File

@@ -0,0 +1,51 @@
package Email::Sender::Role::HasMessage;
# ABSTRACT: an object that has a message
$Email::Sender::Role::HasMessage::VERSION = '1.300035';
use Moo::Role;
#pod =attr message
#pod
#pod This attribute is a message associated with the object.
#pod
#pod =cut
has message => (
is => 'ro',
required => 1,
);
no Moo::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Role::HasMessage - an object that has a message
=head1 VERSION
version 1.300035
=head1 ATTRIBUTES
=head2 message
This attribute is a message associated with the object.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

200
database/perl/vendor/lib/Email/Sender/Simple.pm vendored Normal file
View File

@@ -0,0 +1,200 @@
package Email::Sender::Simple;
# ABSTRACT: the simple interface for sending mail with Sender
$Email::Sender::Simple::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Role::CommonSending';
#pod =head1 SEE INSTEAD
#pod
#pod For now, the best documentation of this class is in
#pod L<Email::Sender::Manual::QuickStart>.
#pod
#pod =cut
use Sub::Exporter::Util ();
use Sub::Exporter -setup => {
exports => {
sendmail => Sub::Exporter::Util::curry_class('send'),
try_to_sendmail => Sub::Exporter::Util::curry_class('try_to_send'),
},
};
use Email::Address;
use Email::Sender::Transport;
use Email::Sender::Util;
use Try::Tiny;
{
my $DEFAULT_TRANSPORT;
my $DEFAULT_FROM_ENV;
sub _default_was_from_env {
my ($class) = @_;
$class->default_transport;
return $DEFAULT_FROM_ENV;
}
sub transport_from_env {
my ($class, $env_base) = @_;
$env_base ||= 'EMAIL_SENDER_TRANSPORT';
my $transport_class = $ENV{$env_base};
return unless defined $transport_class and length $transport_class;
my %arg;
for my $key (grep { /^\Q$env_base\E_[_0-9A-Za-z]+$/ } keys %ENV) {
(my $new_key = $key) =~ s/^\Q$env_base\E_//;
$arg{lc $new_key} = $ENV{$key};
}
return Email::Sender::Util->easy_transport($transport_class, \%arg);
}
sub default_transport {
return $DEFAULT_TRANSPORT if $DEFAULT_TRANSPORT;
my ($class) = @_;
my $transport = $class->transport_from_env;
if ($transport) {
$DEFAULT_FROM_ENV = 1;
$DEFAULT_TRANSPORT = $transport;
} else {
$DEFAULT_FROM_ENV = 0;
$DEFAULT_TRANSPORT = $class->build_default_transport;
}
return $DEFAULT_TRANSPORT;
}
sub build_default_transport {
require Email::Sender::Transport::Sendmail;
my $transport = eval { Email::Sender::Transport::Sendmail->new };
return $transport if $transport;
require Email::Sender::Transport::SMTP;
Email::Sender::Transport::SMTP->new;
}
sub reset_default_transport {
undef $DEFAULT_TRANSPORT;
undef $DEFAULT_FROM_ENV;
}
}
# Maybe this should be an around, but I'm just not excited about figuring out
# order at the moment. It just has to work. -- rjbs, 2009-06-05
around prepare_envelope => sub {
my ($orig, $class, $arg) = @_;
$arg ||= {};
my $env = $class->$orig($arg);
$env = {
%$arg,
%$env,
};
return $env;
};
sub send_email {
my ($class, $email, $arg) = @_;
my $transport = $class->default_transport;
if ($arg->{transport}) {
$arg = { %$arg }; # So we can delete transport without ill effects.
$transport = delete $arg->{transport} unless $class->_default_was_from_env;
}
Carp::confess("transport $transport not safe for use with Email::Sender::Simple")
unless $transport->is_simple;
my ($to, $from) = $class->_get_to_from($email, $arg);
Email::Sender::Failure::Permanent->throw("no recipients") if ! @$to;
Email::Sender::Failure::Permanent->throw("no sender") if ! defined $from;
return $transport->send(
$email,
{
to => $to,
from => $from,
},
);
}
sub try_to_send {
my ($class, $email, $arg) = @_;
try {
return $class->send($email, $arg);
} catch {
my $error = $_ || 'unknown error';
return if try { $error->isa('Email::Sender::Failure') };
die $error;
};
}
sub _get_to_from {
my ($class, $email, $arg) = @_;
my $to = $arg->{to};
unless (@$to) {
my @to_addrs =
map { $_->address }
grep { defined }
map { Email::Address->parse($_) }
map { $email->get_header($_) }
qw(to cc);
$to = \@to_addrs;
}
my $from = $arg->{from};
unless (defined $from) {
($from) =
map { $_->address }
grep { defined }
map { Email::Address->parse($_) }
map { $email->get_header($_) }
qw(from);
}
return ($to, $from);
}
no Moo;
"220 OK";
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Simple - the simple interface for sending mail with Sender
=head1 VERSION
version 1.300035
=head1 SEE INSTEAD
For now, the best documentation of this class is in
L<Email::Sender::Manual::QuickStart>.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

46
database/perl/vendor/lib/Email/Sender/Success.pm vendored Normal file
View File

@@ -0,0 +1,46 @@
package Email::Sender::Success;
# ABSTRACT: the result of successfully sending mail
$Email::Sender::Success::VERSION = '1.300035';
use Moo;
#pod =head1 DESCRIPTION
#pod
#pod An Email::Sender::Success object is just an indicator that an email message was
#pod successfully sent. Unless extended, it has no properties of its own.
#pod
#pod =cut
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Success - the result of successfully sending mail
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
An Email::Sender::Success object is just an indicator that an email message was
successfully sent. Unless extended, it has no properties of its own.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

59
database/perl/vendor/lib/Email/Sender/Success/Partial.pm vendored Normal file
View File

@@ -0,0 +1,59 @@
package Email::Sender::Success::Partial;
# ABSTRACT: a report of partial success when delivering
$Email::Sender::Success::Partial::VERSION = '1.300035';
use Moo;
extends 'Email::Sender::Success';
use MooX::Types::MooseLike::Base qw(InstanceOf);
#pod =head1 DESCRIPTION
#pod
#pod These objects indicate that some delivery was accepted for some recipients and
#pod not others. The success object's C<failure> attribute will return a
#pod L<Email::Sender::Failure::Multi> describing which parts of the delivery failed.
#pod
#pod =cut
use Email::Sender::Failure::Multi;
has failure => (
is => 'ro',
isa => InstanceOf['Email::Sender::Failure::Multi'],
required => 1,
);
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Success::Partial - a report of partial success when delivering
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
These objects indicate that some delivery was accepted for some recipients and
not others. The success object's C<failure> attribute will return a
L<Email::Sender::Failure::Multi> describing which parts of the delivery failed.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

90
database/perl/vendor/lib/Email/Sender/Transport.pm vendored Normal file
View File

@@ -0,0 +1,90 @@
package Email::Sender::Transport;
# ABSTRACT: a role for email transports
$Email::Sender::Transport::VERSION = '1.300035';
use Moo::Role;
#pod =head1 DESCRIPTION
#pod
#pod Email::Sender::Transport is a Moo role to aid in writing classes used to send
#pod mail. For the most part, its behavior comes entirely from the role
#pod L<Email::Sender::Role::CommonSending>, which it includes. The important
#pod difference is that Transports are often intended to be used by
#pod L<Email::Sender::Simple>, and they provide two methods related to that purpose.
#pod
#pod =for Pod::Coverage is_simple allow_partial_success
#pod
#pod First, they provide an C<allow_partial_success> method which returns true or
#pod false to indicate whether the transport will ever signal partial success.
#pod
#pod Second, they provide an C<is_simple> method, which returns true if the
#pod transport is suitable for use with Email::Sender::Simple. By default, this
#pod method returns the inverse of C<allow_partial_success>.
#pod
#pod It is B<imperative> that these methods be accurate to prevent
#pod Email::Sender::Simple users from sending partially successful transmissions.
#pod Partial success is a complex case that almost all users will wish to avoid at
#pod all times.
#pod
#pod =cut
with 'Email::Sender::Role::CommonSending';
sub is_simple {
my ($self) = @_;
return if $self->allow_partial_success;
return 1;
}
sub allow_partial_success { 0 }
no Moo::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport - a role for email transports
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
Email::Sender::Transport is a Moo role to aid in writing classes used to send
mail. For the most part, its behavior comes entirely from the role
L<Email::Sender::Role::CommonSending>, which it includes. The important
difference is that Transports are often intended to be used by
L<Email::Sender::Simple>, and they provide two methods related to that purpose.
=for Pod::Coverage is_simple allow_partial_success
First, they provide an C<allow_partial_success> method which returns true or
false to indicate whether the transport will ever signal partial success.
Second, they provide an C<is_simple> method, which returns true if the
transport is suitable for use with Email::Sender::Simple. By default, this
method returns the inverse of C<allow_partial_success>.
It is B<imperative> that these methods be accurate to prevent
Email::Sender::Simple users from sending partially successful transmissions.
Partial success is a complex case that almost all users will wish to avoid at
all times.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

49
database/perl/vendor/lib/Email/Sender/Transport/DevNull.pm vendored Normal file
View File

@@ -0,0 +1,49 @@
package Email::Sender::Transport::DevNull;
# ABSTRACT: happily throw away your mail
$Email::Sender::Transport::DevNull::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
#pod =head1 DESCRIPTION
#pod
#pod This class implements L<Email::Sender::Transport>. Any mail sent through a
#pod DevNull transport will be silently discarded.
#pod
#pod =cut
sub send_email { return $_[0]->success }
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::DevNull - happily throw away your mail
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This class implements L<Email::Sender::Transport>. Any mail sent through a
DevNull transport will be silently discarded.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

92
database/perl/vendor/lib/Email/Sender/Transport/Failable.pm vendored Normal file
View File

@@ -0,0 +1,92 @@
package Email::Sender::Transport::Failable;
# ABSTRACT: a wrapper to makes things fail predictably
$Email::Sender::Transport::Failable::VERSION = '1.300035';
use Moo;
extends 'Email::Sender::Transport::Wrapper';
use MooX::Types::MooseLike::Base qw(ArrayRef);
#pod =head1 DESCRIPTION
#pod
#pod This transport extends L<Email::Sender::Transport::Wrapper>, meaning that it
#pod must be created with a C<transport> attribute of another
#pod Email::Sender::Transport. It will proxy all email sending to that transport,
#pod but only after first deciding if it should fail.
#pod
#pod It does this by calling each coderef in its C<failure_conditions> attribute,
#pod which must be an arrayref of code references. Each coderef will be called and
#pod will be passed the Failable transport, the Email::Abstract object, the
#pod envelope, and a reference to an array containing the rest of the arguments to
#pod C<send>.
#pod
#pod If any coderef returns a true value, the value will be used to signal failure.
#pod
#pod =cut
has 'failure_conditions' => (
isa => ArrayRef,
default => sub { [] },
is => 'ro',
reader => '_failure_conditions',
);
sub failure_conditions { @{$_[0]->_failure_conditions} }
sub fail_if { push @{shift->_failure_conditions}, @_ }
sub clear_failure_conditions { @{$_[0]->{failure_conditions}} = () }
around send_email => sub {
my ($orig, $self, $email, $env, @rest) = @_;
for my $cond ($self->failure_conditions) {
my $reason = $cond->($self, $email, $env, \@rest);
next unless $reason;
die (ref $reason ? $reason : Email::Sender::Failure->new($reason));
}
return $self->$orig($email, $env, @rest);
};
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Failable - a wrapper to makes things fail predictably
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport extends L<Email::Sender::Transport::Wrapper>, meaning that it
must be created with a C<transport> attribute of another
Email::Sender::Transport. It will proxy all email sending to that transport,
but only after first deciding if it should fail.
It does this by calling each coderef in its C<failure_conditions> attribute,
which must be an arrayref of code references. Each coderef will be called and
will be passed the Failable transport, the Email::Abstract object, the
envelope, and a reference to an array containing the rest of the arguments to
C<send>.
If any coderef returns a true value, the value will be used to signal failure.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

222
database/perl/vendor/lib/Email/Sender/Transport/Maildir.pm vendored Normal file
View File

@@ -0,0 +1,222 @@
package Email::Sender::Transport::Maildir;
# ABSTRACT: deliver mail to a maildir on disk
$Email::Sender::Transport::Maildir::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
use Errno ();
use Fcntl;
use File::Path 2.06;
use File::Spec;
use Sys::Hostname;
use MooX::Types::MooseLike::Base qw(Bool);
#pod =head1 DESCRIPTION
#pod
#pod This transport delivers into a maildir. The maildir's location may be given as
#pod the F<dir> argument to the constructor, and defaults to F<Maildir> in the
#pod current directory (at the time of transport initialization).
#pod
#pod If the directory does not exist, it will be created.
#pod
#pod By default, three headers will be added:
#pod
#pod * X-Email-Sender-From - the envelope sender
#pod * X-Email-Sender-To - the envelope recipients (one header per rcpt)
#pod * Lines - the number of lines in the body
#pod
#pod These can be controlled with the C<add_lines_header> and
#pod C<add_envelope_headers> constructor arguments.
#pod
#pod The L<Email::Sender::Success> object returned on success has a C<filename>
#pod method that returns the filename to which the message was delivered.
#pod
#pod =cut
{
package
Email::Sender::Success::MaildirSuccess;
use Moo;
use MooX::Types::MooseLike::Base qw(Str);
extends 'Email::Sender::Success';
has filename => (
is => 'ro',
isa => Str,
required => 1,
);
no Moo;
}
my $HOSTNAME;
BEGIN { ($HOSTNAME = hostname) =~ s/\..*//; }
sub _hostname { $HOSTNAME }
my $MAILDIR_TIME = 0;
my $MAILDIR_COUNTER = 0;
has [ qw(add_lines_header add_envelope_headers) ] => (
is => 'ro',
isa => Bool,
default => sub { 1 },
);
has dir => (
is => 'ro',
required => 1,
default => sub { File::Spec->catdir(File::Spec->curdir, 'Maildir') },
);
sub send_email {
my ($self, $email, $env) = @_;
my $dupe = Email::Abstract->new(\do { $email->as_string });
if ($self->add_envelope_headers) {
$dupe->set_header('X-Email-Sender-From' =>
(defined $env->{from} ? $env->{from} : '-'),
);
my @to = grep {; defined } @{ $env->{to} };
$dupe->set_header('X-Email-Sender-To' => (@to ? @to : '-'));
}
$self->_ensure_maildir_exists;
$self->_add_lines_header($dupe) if $self->add_lines_header;
$self->_update_time;
my $fn = $self->_deliver_email($dupe);
return Email::Sender::Success::MaildirSuccess->new({
filename => $fn,
});
}
sub _ensure_maildir_exists {
my ($self) = @_;
for my $dir (qw(cur tmp new)) {
my $subdir = File::Spec->catdir($self->dir, $dir);
next if -d $subdir;
Email::Sender::Failure->throw("couldn't create $subdir: $!")
unless File::Path::make_path($subdir) || -d $subdir;
}
}
sub _add_lines_header {
my ($class, $email) = @_;
return if $email->get_header("Lines");
my $lines = $email->get_body =~ tr/\n/\n/;
$email->set_header("Lines", $lines);
}
sub _update_time {
my $time = time;
if ($MAILDIR_TIME != $time) {
$MAILDIR_TIME = $time;
$MAILDIR_COUNTER = 0;
} else {
$MAILDIR_COUNTER++;
}
}
sub _deliver_email {
my ($self, $email) = @_;
my ($tmp_filename, $tmp_fh) = $self->_delivery_fh;
# if (eval { $email->can('stream_to') }) {
# eval { $mail->stream_to($fh); 1 } or return;
#} else {
my $string = $email->as_string;
$string =~ s/\x0D\x0A/\x0A/g unless $^O eq 'MSWin32';
print $tmp_fh $string
or Email::Sender::Failure->throw("could not write to $tmp_filename: $!");
close $tmp_fh
or Email::Sender::Failure->throw("error closing $tmp_filename: $!");
my $target_name = File::Spec->catfile($self->dir, 'new', $tmp_filename);
my $ok = rename(
File::Spec->catfile($self->dir, 'tmp', $tmp_filename),
$target_name,
);
Email::Sender::Failure->throw("could not move $tmp_filename from tmp to new")
unless $ok;
return $target_name;
}
sub _delivery_fh {
my ($self) = @_;
my $hostname = $self->_hostname;
my ($filename, $fh);
until ($fh) {
$filename = join q{.}, $MAILDIR_TIME, $$, ++$MAILDIR_COUNTER, $hostname;
my $filespec = File::Spec->catfile($self->dir, 'tmp', $filename);
sysopen $fh, $filespec, O_CREAT|O_EXCL|O_WRONLY;
binmode $fh;
Email::Sender::Failure->throw("cannot create $filespec for delivery: $!")
unless $fh or $!{EEXIST};
}
return ($filename, $fh);
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Maildir - deliver mail to a maildir on disk
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport delivers into a maildir. The maildir's location may be given as
the F<dir> argument to the constructor, and defaults to F<Maildir> in the
current directory (at the time of transport initialization).
If the directory does not exist, it will be created.
By default, three headers will be added:
* X-Email-Sender-From - the envelope sender
* X-Email-Sender-To - the envelope recipients (one header per rcpt)
* Lines - the number of lines in the body
These can be controlled with the C<add_lines_header> and
C<add_envelope_headers> constructor arguments.
The L<Email::Sender::Success> object returned on success has a C<filename>
method that returns the filename to which the message was delivered.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

150
database/perl/vendor/lib/Email/Sender/Transport/Mbox.pm vendored Normal file
View File

@@ -0,0 +1,150 @@
package Email::Sender::Transport::Mbox;
# ABSTRACT: deliver mail to an mbox on disk
$Email::Sender::Transport::Mbox::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
use Carp;
use File::Path;
use File::Basename;
use IO::File 1.11; # binmode
use Email::Simple 1.998; # needed for ->header_obj
use Fcntl ':flock';
#pod =head1 DESCRIPTION
#pod
#pod This transport delivers into an mbox. The mbox file may be given by the
#pod F<filename> argument to the constructor, and defaults to F<mbox>.
#pod
#pod The transport I<currently> assumes that the mbox is in F<mboxo> format, but
#pod this may change or be configurable in the future.
#pod
#pod =cut
has 'filename' => (is => 'ro', default => sub { 'mbox' }, required => 1);
sub send_email {
my ($self, $email, $env) = @_;
my $filename = $self->filename;
my $fh = $self->_open_fh($filename);
my $ok = eval {
if ($fh->tell > 0) {
$fh->print("\n") or Carp::confess("couldn't write to $filename: $!");
}
$fh->print($self->_from_line($email, $env))
or Carp::confess("couldn't write to $filename: $!");
$fh->print($self->_escape_from_body($email))
or Carp::confess("couldn't write to $filename: $!");
# This will make streaming a bit more annoying. -- rjbs, 2007-05-25
$fh->print("\n")
or Carp::confess("couldn't write to $filename: $!")
unless $email->as_string =~ /\n$/;
$self->_close_fh($fh)
or Carp::confess "couldn't close file $filename: $!";
1;
};
die unless $ok;
# Email::Sender::Failure->throw($@ || 'unknown error') unless $ok;
return $self->success;
}
sub _open_fh {
my ($class, $file) = @_;
my $dir = dirname($file);
Carp::confess "couldn't make path $dir: $!" if not -d $dir or mkpath($dir);
my $fh = IO::File->new($file, '>>')
or Carp::confess "couldn't open $file for appending: $!";
$fh->binmode(':raw');
$class->_getlock($fh, $file);
$fh->seek(0, 2);
return $fh;
}
sub _close_fh {
my ($class, $fh, $file) = @_;
$class->_unlock($fh);
return $fh->close;
}
sub _escape_from_body {
my ($class, $email) = @_;
my $body = $email->get_body;
$body =~ s/^(From )/>$1/gm;
my $simple = $email->cast('Email::Simple');
return $simple->header_obj->as_string . $simple->crlf . $body;
}
sub _from_line {
my ($class, $email, $envelope) = @_;
my $fromtime = localtime;
$fromtime =~ s/(:\d\d) \S+ (\d{4})$/$1 $2/; # strip timezone.
return "From $envelope->{from} $fromtime\n";
}
sub _getlock {
my ($class, $fh, $fn) = @_;
for (1 .. 10) {
return 1 if flock($fh, LOCK_EX | LOCK_NB);
sleep $_;
}
Carp::confess "couldn't lock file $fn";
}
sub _unlock {
my ($class, $fh) = @_;
flock($fh, LOCK_UN);
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Mbox - deliver mail to an mbox on disk
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport delivers into an mbox. The mbox file may be given by the
F<filename> argument to the constructor, and defaults to F<mbox>.
The transport I<currently> assumes that the mbox is in F<mboxo> format, but
this may change or be configurable in the future.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

75
database/perl/vendor/lib/Email/Sender/Transport/Print.pm vendored Normal file
View File

@@ -0,0 +1,75 @@
package Email::Sender::Transport::Print;
# ABSTRACT: print email to a filehandle (like stdout)
$Email::Sender::Transport::Print::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
#pod =head1 DESCRIPTION
#pod
#pod When this transport is handed mail, it prints it to a filehandle. By default,
#pod it will print to STDOUT, but it can be given any L<IO::Handle> object to print
#pod to as its C<fh> attribute.
#pod
#pod =cut
use IO::Handle;
use MooX::Types::MooseLike::Base qw(InstanceOf);
has 'fh' => (
is => 'ro',
isa => InstanceOf['IO::Handle'],
required => 1,
default => sub { IO::Handle->new_from_fd(fileno(STDOUT), 'w') },
);
sub send_email {
my ($self, $email, $env) = @_;
my $fh = $self->fh;
$fh->printf("ENVELOPE TO : %s\n", join(q{, }, @{ $env->{to} }) || '-');
$fh->printf("ENVELOPE FROM: %s\n", defined $env->{from} ? $env->{from} : '-');
$fh->print(q{-} x 10 . " begin message\n");
$fh->print( $email->as_string );
$fh->print(q{-} x 10 . " end message\n");
return $self->success;
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Print - print email to a filehandle (like stdout)
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
When this transport is handed mail, it prints it to a filehandle. By default,
it will print to STDOUT, but it can be given any L<IO::Handle> object to print
to as its C<fh> attribute.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

413
database/perl/vendor/lib/Email/Sender/Transport/SMTP.pm vendored Normal file
View File

@@ -0,0 +1,413 @@
package Email::Sender::Transport::SMTP;
# ABSTRACT: send email over SMTP
$Email::Sender::Transport::SMTP::VERSION = '1.300035';
use Moo;
use Email::Sender::Failure::Multi;
use Email::Sender::Success::Partial;
use Email::Sender::Role::HasMessage ();
use Email::Sender::Util;
use MooX::Types::MooseLike::Base qw(Bool Int Str HashRef);
use Net::SMTP 3.07; # SSL support, fixed datasend
use utf8 (); # See below. -- rjbs, 2015-05-14
#pod =head1 DESCRIPTION
#pod
#pod This transport is used to send email over SMTP, either with or without secure
#pod sockets (SSL/TLS). It is one of the most complex transports available, capable
#pod of partial success.
#pod
#pod For a potentially more efficient version of this transport, see
#pod L<Email::Sender::Transport::SMTP::Persistent>.
#pod
#pod =head1 ATTRIBUTES
#pod
#pod The following attributes may be passed to the constructor:
#pod
#pod =over 4
#pod
#pod =item C<hosts>: an arrayref of names of the host to try, in order; defaults to a single element array containing C<localhost>
#pod
#pod The attribute C<host> may be given, instead, which contains a single hostname.
#pod
#pod =item C<ssl>: if 'starttls', use STARTTLS; if 'ssl' (or 1), connect securely;
#pod otherwise, no security
#pod
#pod =item C<ssl_options>: passed to Net::SMTP constructor for 'ssl' connections or
#pod to starttls for 'starttls' connections; should contain extra options for
#pod IO::Socket::SSL
#pod
#pod =item C<port>: port to connect to; defaults to 25 for non-SSL, 465 for 'ssl',
#pod 587 for 'starttls'
#pod
#pod =item C<timeout>: maximum time in secs to wait for server; default is 120
#pod
#pod =cut
sub BUILD {
my ($self) = @_;
Carp::croak("do not pass port number to SMTP transport in host, use port parameter")
if grep {; /:/ } $self->hosts;
}
sub BUILDARGS {
my ($self, @rest) = @_;
my $arg = $self->SUPER::BUILDARGS(@rest);
if (exists $arg->{host}) {
Carp::croak("can't pass both host and hosts to constructor")
if exists $arg->{hosts};
$arg->{hosts} = [ delete $arg->{host} ];
}
return $arg;
}
has ssl => (is => 'ro', isa => Str, default => sub { 0 });
has _hosts => (
is => 'ro',
isa => sub {
die "invalid hosts in Email::Sender::Transport::SMTP constructor"
unless defined $_[0]
&& (ref $_[0] eq 'ARRAY')
&& (grep {; length } @{ $_[0] }) > 0;
},
default => sub { [ 'localhost' ] },
init_arg => 'hosts',
);
sub hosts { @{ $_[0]->_hosts } }
sub host { $_[0]->_hosts->[0] }
has _security => (
is => 'ro',
lazy => 1,
init_arg => undef,
default => sub {
my $ssl = $_[0]->ssl;
return '' unless $ssl;
$ssl = lc $ssl;
return 'starttls' if 'starttls' eq $ssl;
return 'ssl' if $ssl eq 1 or $ssl eq 'ssl';
Carp::cluck(qq{true "ssl" argument to Email::Sender::Transport::SMTP should be 'ssl' or 'startls' or '1' but got '$ssl'});
return 1;
},
);
has ssl_options => (is => 'ro', isa => HashRef, default => sub { {} });
has port => (
is => 'ro',
isa => Int,
lazy => 1,
default => sub {
return $_[0]->_security eq 'starttls' ? 587
: $_[0]->_security eq 'ssl' ? 465
: 25
},
);
has timeout => (is => 'ro', isa => Int, default => sub { 120 });
#pod =item C<sasl_username>: the username to use for auth; optional
#pod
#pod =item C<sasl_password>: the password to use for auth; required if C<sasl_username> is provided
#pod
#pod =item C<allow_partial_success>: if true, will send data even if some recipients were rejected; defaults to false
#pod
#pod =cut
has sasl_username => (is => 'ro', isa => Str);
has sasl_password => (is => 'ro', isa => Str);
has allow_partial_success => (is => 'ro', isa => Bool, default => sub { 0 });
#pod =item C<helo>: what to say when saying HELO; no default
#pod
#pod =item C<localaddr>: local address from which to connect
#pod
#pod =item C<localport>: local port from which to connect
#pod
#pod =cut
has helo => (is => 'ro', isa => Str);
has localaddr => (is => 'ro');
has localport => (is => 'ro', isa => Int);
#pod =item C<debug>: if true, put the L<Net::SMTP> object in debug mode
#pod
#pod =back
#pod
#pod =cut
has debug => (is => 'ro', isa => Bool, default => sub { 0 });
# I am basically -sure- that this is wrong, but sending hundreds of millions of
# messages has shown that it is right enough. I will try to make it textbook
# later. -- rjbs, 2008-12-05
sub _quoteaddr {
my $addr = shift;
my @localparts = split /\@/, $addr;
my $domain = pop @localparts;
my $localpart = join q{@}, @localparts;
return $addr # The first regex here is RFC 821 "specials" excepting dot.
unless $localpart =~ /[\x00-\x1F\x7F<>\(\)\[\]\\,;:@"]/
or $localpart =~ /^\./
or $localpart =~ /\.$/;
return join q{@}, qq("$localpart"), $domain;
}
sub _smtp_client {
my ($self) = @_;
my $class = "Net::SMTP";
my $smtp = $class->new( $self->_net_smtp_args );
unless ($smtp) {
$self->_throw(
sprintf "unable to establish SMTP connection to (%s) port %s",
(join q{, }, $self->hosts),
$self->port,
);
}
if ($self->_security eq 'starttls') {
$self->_throw("can't STARTTLS: " . $smtp->message)
unless $smtp->starttls(%{ $self->ssl_options });
}
if ($self->sasl_username) {
$self->_throw("sasl_username but no sasl_password")
unless defined $self->sasl_password;
unless ($smtp->auth($self->sasl_username, $self->sasl_password)) {
if ($smtp->message =~ /MIME::Base64|Authen::SASL/) {
Carp::confess("SMTP auth requires MIME::Base64 and Authen::SASL");
}
$self->_throw('failed AUTH', $smtp);
}
}
return $smtp;
}
sub _net_smtp_args {
my ($self) = @_;
return (
[ $self->hosts ],
Port => $self->port,
Timeout => $self->timeout,
Debug => $self->debug,
(($self->_security eq 'ssl')
? (SSL => 1, %{ $self->ssl_options })
: ()),
defined $self->helo ? (Hello => $self->helo) : (),
defined $self->localaddr ? (LocalAddr => $self->localaddr) : (),
defined $self->localport ? (LocalPort => $self->localport) : (),
);
}
sub _throw {
my ($self, @rest) = @_;
Email::Sender::Util->_failure(@rest)->throw;
}
sub send_email {
my ($self, $email, $env) = @_;
Email::Sender::Failure->throw("no valid addresses in recipient list")
unless my @to = grep { defined and length } @{ $env->{to} };
my $smtp = $self->_smtp_client;
my $FAULT = sub { $self->_throw($_[0], $smtp); };
$smtp->mail(_quoteaddr($env->{from}))
or $FAULT->("$env->{from} failed after MAIL FROM");
my @failures;
my @ok_rcpts;
for my $addr (@to) {
if ($smtp->to(_quoteaddr($addr))) {
push @ok_rcpts, $addr;
} else {
# my ($self, $error, $smtp, $error_class, @rest) = @_;
push @failures, Email::Sender::Util->_failure(
undef,
$smtp,
recipients => [ $addr ],
);
}
}
# This logic used to include: or (@ok_rcpts == 1 and $ok_rcpts[0] eq '0')
# because if called without SkipBad, $smtp->to can return 1 or 0. This
# should not happen because we now always pass SkipBad and do the counting
# ourselves. Still, I've put this comment here (a) in memory of the
# suffering it caused to have to find that problem and (b) in case the
# original problem is more insidious than I thought! -- rjbs, 2008-12-05
if (
@failures
and ((@ok_rcpts == 0) or (! $self->allow_partial_success))
) {
$failures[0]->throw if @failures == 1;
my $message = sprintf '%s recipients were rejected during RCPT',
@ok_rcpts ? 'some' : 'all';
Email::Sender::Failure::Multi->throw(
message => $message,
failures => \@failures,
);
}
# restore Pobox's support for streaming, code-based messages, and arrays here
# -- rjbs, 2008-12-04
$smtp->data or $FAULT->("error at DATA start");
my $msg_string = $email->as_string;
my $hunk_size = $self->_hunk_size;
while (length $msg_string) {
my $next_hunk = substr $msg_string, 0, $hunk_size, '';
$smtp->datasend($next_hunk) or $FAULT->("error at during DATA");
}
$smtp->dataend or $FAULT->("error at after DATA");
my $message = $smtp->message;
$self->_message_complete($smtp);
# We must report partial success (failures) if applicable.
return $self->success({ message => $message }) unless @failures;
return $self->partial_success({
message => $message,
failure => Email::Sender::Failure::Multi->new({
message => 'some recipients were rejected during RCPT',
failures => \@failures
}),
});
}
sub _hunk_size { 2**20 } # send messages to DATA in hunks of 1 mebibyte
sub success {
my $self = shift;
my $success = Moo::Role->create_class_with_roles('Email::Sender::Success', 'Email::Sender::Role::HasMessage')->new(@_);
}
sub partial_success {
my $self = shift;
my $partial_success = Moo::Role->create_class_with_roles('Email::Sender::Success::Partial', 'Email::Sender::Role::HasMessage')->new(@_);
}
sub _message_complete { $_[1]->quit; }
#pod =head1 PARTIAL SUCCESS
#pod
#pod If C<allow_partial_success> was set when creating the transport, the transport
#pod may return L<Email::Sender::Success::Partial> objects. Consult that module's
#pod documentation.
#pod
#pod =cut
with 'Email::Sender::Transport';
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::SMTP - send email over SMTP
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport is used to send email over SMTP, either with or without secure
sockets (SSL/TLS). It is one of the most complex transports available, capable
of partial success.
For a potentially more efficient version of this transport, see
L<Email::Sender::Transport::SMTP::Persistent>.
=head1 ATTRIBUTES
The following attributes may be passed to the constructor:
=over 4
=item C<hosts>: an arrayref of names of the host to try, in order; defaults to a single element array containing C<localhost>
The attribute C<host> may be given, instead, which contains a single hostname.
=item C<ssl>: if 'starttls', use STARTTLS; if 'ssl' (or 1), connect securely;
otherwise, no security
=item C<ssl_options>: passed to Net::SMTP constructor for 'ssl' connections or
to starttls for 'starttls' connections; should contain extra options for
IO::Socket::SSL
=item C<port>: port to connect to; defaults to 25 for non-SSL, 465 for 'ssl',
587 for 'starttls'
=item C<timeout>: maximum time in secs to wait for server; default is 120
=item C<sasl_username>: the username to use for auth; optional
=item C<sasl_password>: the password to use for auth; required if C<sasl_username> is provided
=item C<allow_partial_success>: if true, will send data even if some recipients were rejected; defaults to false
=item C<helo>: what to say when saying HELO; no default
=item C<localaddr>: local address from which to connect
=item C<localport>: local port from which to connect
=item C<debug>: if true, put the L<Net::SMTP> object in debug mode
=back
=head1 PARTIAL SUCCESS
If C<allow_partial_success> was set when creating the transport, the transport
may return L<Email::Sender::Success::Partial> objects. Consult that module's
documentation.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

99
database/perl/vendor/lib/Email/Sender/Transport/SMTP/Persistent.pm vendored Normal file
View File

@@ -0,0 +1,99 @@
package Email::Sender::Transport::SMTP::Persistent;
# ABSTRACT: an SMTP client that stays online
$Email::Sender::Transport::SMTP::Persistent::VERSION = '1.300035';
use Moo;
extends 'Email::Sender::Transport::SMTP';
#pod =head1 DESCRIPTION
#pod
#pod The stock L<Email::Sender::Transport::SMTP> reconnects each time it sends a
#pod message. This transport only reconnects when the existing connection fails.
#pod
#pod =cut
use Net::SMTP;
has _cached_client => (
is => 'rw',
);
sub _smtp_client {
my ($self) = @_;
if (my $client = $self->_cached_client) {
return $client if eval { $client->reset; $client->ok; };
my $error = $@
|| 'error resetting cached SMTP connection: ' . $client->message;
Carp::carp($error);
}
my $client = $self->SUPER::_smtp_client;
$self->_cached_client($client);
return $client;
}
sub _message_complete { }
#pod =method disconnect
#pod
#pod $transport->disconnect;
#pod
#pod This method sends an SMTP QUIT command and destroys the SMTP client, if on
#pod exists and is connected.
#pod
#pod =cut
sub disconnect {
my ($self) = @_;
return unless $self->_cached_client;
$self->_cached_client->quit;
$self->_cached_client(undef);
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::SMTP::Persistent - an SMTP client that stays online
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
The stock L<Email::Sender::Transport::SMTP> reconnects each time it sends a
message. This transport only reconnects when the existing connection fails.
=head1 METHODS
=head2 disconnect
$transport->disconnect;
This method sends an SMTP QUIT command and destroys the SMTP client, if on
exists and is connected.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

139
database/perl/vendor/lib/Email/Sender/Transport/Sendmail.pm vendored Normal file
View File

@@ -0,0 +1,139 @@
package Email::Sender::Transport::Sendmail;
# ABSTRACT: send mail via sendmail(1)
$Email::Sender::Transport::Sendmail::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
use MooX::Types::MooseLike::Base qw(Str);
#pod =head2 DESCRIPTION
#pod
#pod This transport sends mail by piping it to the F<sendmail> command. If the
#pod location of the F<sendmail> command is not provided in the constructor (see
#pod below) then the library will look for an executable file called F<sendmail> in
#pod the path.
#pod
#pod To specify the location of sendmail:
#pod
#pod my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $path });
#pod
#pod =cut
use File::Spec ();
has 'sendmail' => (
is => 'ro',
isa => Str,
required => 1,
lazy => 1,
default => sub {
# This should not have to be lazy, but Moose has a bug(?) that prevents the
# instance or partial-instance from being passed in to the default sub.
# Laziness doesn't hurt much, though, because (ugh) of the BUILD below.
# -- rjbs, 2008-12-04
# return $ENV{PERL_SENDMAIL_PATH} if $ENV{PERL_SENDMAIL_PATH}; # ???
return $_[0]->_find_sendmail('sendmail');
},
);
sub BUILD {
$_[0]->sendmail; # force population -- rjbs, 2009-06-08
}
sub _find_sendmail {
my ($self, $program_name) = @_;
$program_name ||= 'sendmail';
my @path = File::Spec->path;
if ($program_name eq 'sendmail') {
# for 'real' sendmail we will look in common locations -- rjbs, 2009-07-12
push @path, (
File::Spec->catfile('', qw(usr sbin)),
File::Spec->catfile('', qw(usr lib)),
);
}
for my $dir (@path) {
my $sendmail = File::Spec->catfile($dir, $program_name);
return $sendmail if ($^O eq 'MSWin32') ? -f $sendmail : -x $sendmail;
}
Carp::confess("couldn't find a sendmail executable");
}
sub _sendmail_pipe {
my ($self, $envelope) = @_;
my $prog = $self->sendmail;
my ($first, @args) = $^O eq 'MSWin32'
? qq(| "$prog" -i -f $envelope->{from} @{$envelope->{to}})
: (q{|-}, $prog, '-i', '-f', $envelope->{from}, '--', @{$envelope->{to}});
no warnings 'exec'; ## no critic
my $pipe;
Email::Sender::Failure->throw("couldn't open pipe to sendmail ($prog): $!")
unless open($pipe, $first, @args);
return $pipe;
}
sub send_email {
my ($self, $email, $envelope) = @_;
my $pipe = $self->_sendmail_pipe($envelope);
my $string = $email->as_string;
$string =~ s/\x0D\x0A/\x0A/g unless $^O eq 'MSWin32';
print $pipe $string
or Email::Sender::Failure->throw("couldn't send message to sendmail: $!");
close $pipe
or Email::Sender::Failure->throw("error when closing pipe to sendmail: $!");
return $self->success;
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Sendmail - send mail via sendmail(1)
=head1 VERSION
version 1.300035
=head2 DESCRIPTION
This transport sends mail by piping it to the F<sendmail> command. If the
location of the F<sendmail> command is not provided in the constructor (see
below) then the library will look for an executable file called F<sendmail> in
the path.
To specify the location of sendmail:
my $sender = Email::Sender::Transport::Sendmail->new({ sendmail => $path });
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

219
database/perl/vendor/lib/Email/Sender/Transport/Test.pm vendored Normal file
View File

@@ -0,0 +1,219 @@
package Email::Sender::Transport::Test;
# ABSTRACT: deliver mail in memory for testing
$Email::Sender::Transport::Test::VERSION = '1.300035';
use Moo;
use Email::Sender::Failure::Multi;
use Email::Sender::Success::Partial;
use MooX::Types::MooseLike::Base qw(ArrayRef Bool);
#pod =head1 DESCRIPTION
#pod
#pod This transport is meant for testing email deliveries in memory. It will store
#pod a record of any delivery made so that they can be inspected afterward.
#pod
#pod =for Pod::Coverage recipient_failure delivery_failure
#pod
#pod By default, the Test transport will not allow partial success and will always
#pod succeed. It can be made to fail predictably, however, if it is extended and
#pod its C<recipient_failure> or C<delivery_failure> methods are overridden. These
#pod methods are called as follows:
#pod
#pod $self->delivery_failure($email, $envelope);
#pod
#pod $self->recipient_failure($to);
#pod
#pod If they return true, the sending will fail. If the transport was created with
#pod a true C<allow_partial_success> attribute, recipient failures can cause partial
#pod success to be returned.
#pod
#pod For more flexible failure modes, you can override more aggressively or can use
#pod L<Email::Sender::Transport::Failable>.
#pod
#pod =attr deliveries
#pod
#pod =for Pod::Coverage clear_deliveries
#pod
#pod This attribute stores an arrayref of all the deliveries made via the transport.
#pod The C<clear_deliveries> method returns a list of them.
#pod
#pod Each delivery is a hashref, in the following format:
#pod
#pod {
#pod email => $email,
#pod envelope => $envelope,
#pod successes => \@ok_rcpts,
#pod failures => \@failures,
#pod }
#pod
#pod Both successful and failed deliveries are stored.
#pod
#pod A number of methods related to this attribute are provided:
#pod
#pod =for :list
#pod * delivery_count
#pod * clear_deliveries
#pod * shift_deliveries
#pod
#pod =cut
has allow_partial_success => (is => 'ro', isa => Bool, default => sub { 0 });
sub recipient_failure { }
sub delivery_failure { }
has deliveries => (
isa => ArrayRef,
init_arg => undef,
default => sub { [] },
is => 'ro',
reader => '_deliveries',
);
sub delivery_count { scalar @{ $_[0]->_deliveries } }
sub record_delivery { push @{ shift->_deliveries }, @_ }
sub deliveries { @{ $_[0]->_deliveries } }
sub shift_deliveries { shift @{ $_[0]->_deliveries } }
sub clear_deliveries { @{ $_[0]->_deliveries } = () }
sub send_email {
my ($self, $email, $envelope) = @_;
my @failures;
my @ok_rcpts;
if (my $failure = $self->delivery_failure($email, $envelope)) {
$failure->throw;
}
for my $to (@{ $envelope->{to} }) {
if (my $failure = $self->recipient_failure($to)) {
push @failures, $failure;
} else {
push @ok_rcpts, $to;
}
}
if (
@failures
and ((@ok_rcpts == 0) or (! $self->allow_partial_success))
) {
$failures[0]->throw if @failures == 1 and @ok_rcpts == 0;
my $message = sprintf '%s recipients were rejected',
@ok_rcpts ? 'some' : 'all';
Email::Sender::Failure::Multi->throw(
message => $message,
failures => \@failures,
);
}
$self->record_delivery({
email => $email,
envelope => $envelope,
successes => \@ok_rcpts,
failures => \@failures,
});
# XXX: We must report partial success (failures) if applicable.
return $self->success unless @failures;
return Email::Sender::Success::Partial->new({
failure => Email::Sender::Failure::Multi->new({
message => 'some recipients were rejected',
failures => \@failures
}),
});
}
with 'Email::Sender::Transport';
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Test - deliver mail in memory for testing
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
This transport is meant for testing email deliveries in memory. It will store
a record of any delivery made so that they can be inspected afterward.
=head1 ATTRIBUTES
=head2 deliveries
=for Pod::Coverage recipient_failure delivery_failure
By default, the Test transport will not allow partial success and will always
succeed. It can be made to fail predictably, however, if it is extended and
its C<recipient_failure> or C<delivery_failure> methods are overridden. These
methods are called as follows:
$self->delivery_failure($email, $envelope);
$self->recipient_failure($to);
If they return true, the sending will fail. If the transport was created with
a true C<allow_partial_success> attribute, recipient failures can cause partial
success to be returned.
For more flexible failure modes, you can override more aggressively or can use
L<Email::Sender::Transport::Failable>.
=for Pod::Coverage clear_deliveries
This attribute stores an arrayref of all the deliveries made via the transport.
The C<clear_deliveries> method returns a list of them.
Each delivery is a hashref, in the following format:
{
email => $email,
envelope => $envelope,
successes => \@ok_rcpts,
failures => \@failures,
}
Both successful and failed deliveries are stored.
A number of methods related to this attribute are provided:
=over 4
=item *
delivery_count
=item *
clear_deliveries
=item *
shift_deliveries
=back
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

90
database/perl/vendor/lib/Email/Sender/Transport/Wrapper.pm vendored Normal file
View File

@@ -0,0 +1,90 @@
package Email::Sender::Transport::Wrapper;
# ABSTRACT: a mailer to wrap a mailer for mailing mail
$Email::Sender::Transport::Wrapper::VERSION = '1.300035';
use Moo;
with 'Email::Sender::Transport';
use Email::Sender::Util;
#pod =head1 DESCRIPTION
#pod
#pod Email::Sender::Transport::Wrapper wraps a transport, provided as the
#pod C<transport> argument to the constructor. It is provided as a simple way to
#pod use method modifiers to create wrapping classes.
#pod
#pod =cut
has transport => (
is => 'ro',
does => 'Email::Sender::Transport',
required => 1,
);
sub send_email {
my $self = shift;
$self->transport->send_email(@_);
}
sub is_simple {
return $_[0]->transport->is_simple;
}
sub allow_partial_success {
return $_[0]->transport->allow_partial_success;
}
sub BUILDARGS {
my $self = shift;
my $href = $self->SUPER::BUILDARGS(@_);
if (my $class = delete $href->{transport_class}) {
Carp::confess("given both a transport and transport_class")
if $href->{transport};
my %arg;
for my $key (map {; /^transport_arg_(.+)$/ ? "$1" : () } keys %$href) {
$arg{$key} = delete $href->{"transport_arg_$key"};
}
$href->{transport} = Email::Sender::Util->easy_transport($class, \%arg);
}
return $href;
}
no Moo;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Transport::Wrapper - a mailer to wrap a mailer for mailing mail
=head1 VERSION
version 1.300035
=head1 DESCRIPTION
Email::Sender::Transport::Wrapper wraps a transport, provided as the
C<transport> argument to the constructor. It is provided as a simple way to
use method modifiers to create wrapping classes.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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

141
database/perl/vendor/lib/Email/Sender/Util.pm vendored Normal file
View File

@@ -0,0 +1,141 @@
use strict;
use warnings;
package Email::Sender::Util;
# ABSTRACT: random stuff that makes Email::Sender go
$Email::Sender::Util::VERSION = '1.300035';
use Email::Address;
use Email::Sender::Failure;
use Email::Sender::Failure::Permanent;
use Email::Sender::Failure::Temporary;
use List::Util 1.45 ();
use Module::Runtime qw(require_module);
# This code will be used by Email::Sender::Simple. -- rjbs, 2008-12-04
sub _recipients_from_email {
my ($self, $email) = @_;
my @to = List::Util::uniq(
map { $_->address }
map { Email::Address->parse($_) }
map { $email->get_header($_) }
qw(to cc bcc));
return \@to;
}
sub _sender_from_email {
my ($self, $email) = @_;
my ($sender) = map { $_->address }
map { Email::Address->parse($_) }
scalar $email->get_header('from');
return $sender;
}
# It's probably reasonable to make this code publicker at some point, but for
# now I don't want to deal with making a sane set of args. -- rjbs, 2008-12-09
sub _failure {
my ($self, $error, $smtp, @rest) = @_;
my ($code, $message);
if ($smtp) {
$code = $smtp->code;
$message = $smtp->message;
$message = ! defined $message ? "(no SMTP error message)"
: ! length $message ? "(empty SMTP error message)"
: $message;
$message = defined $error && length $error
? "$error: $message"
: $message;
} else {
$message = $error;
$message = "(no error given)" unless defined $message;
$message = "(empty error string)" unless length $message;
}
my $error_class = ! $code ? 'Email::Sender::Failure'
: $code =~ /^4/ ? 'Email::Sender::Failure::Temporary'
: $code =~ /^5/ ? 'Email::Sender::Failure::Permanent'
: 'Email::Sender::Failure';
$error_class->new({
message => $message,
code => $code,
@rest,
});
}
#pod =method easy_transport
#pod
#pod my $transport = Email::Sender::Util->easy_transport($class => \%arg);
#pod
#pod This takes the name of a transport class and a set of args to new. It returns
#pod an Email::Sender::Transport object of that class.
#pod
#pod C<$class> is rewritten to C<Email::Sender::Transport::$class> unless it starts
#pod with an equals sign (C<=>) or contains a colon. The equals sign, if present,
#pod will be removed.
#pod
#pod =cut
sub _rewrite_class {
my $transport_class = $_[1];
if ($transport_class !~ s/^=// and $transport_class !~ m{:}) {
$transport_class = "Email::Sender::Transport::$transport_class";
}
return $transport_class;
}
sub easy_transport {
my ($self, $transport_class, $arg) = @_;
$transport_class = $self->_rewrite_class($transport_class);
require_module($transport_class);
return $transport_class->new($arg);
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::Sender::Util - random stuff that makes Email::Sender go
=head1 VERSION
version 1.300035
=head1 METHODS
=head2 easy_transport
my $transport = Email::Sender::Util->easy_transport($class => \%arg);
This takes the name of a transport class and a set of args to new. It returns
an Email::Sender::Transport object of that class.
C<$class> is rewritten to C<Email::Sender::Transport::$class> unless it starts
with an equals sign (C<=>) or contains a colon. The equals sign, if present,
will be removed.
=head1 AUTHOR
Ricardo Signes <rjbs@semiotic.systems>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2020 by Ricardo Signes.
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