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

702
database/perl/vendor/lib/Email/MIME/ContentType.pm vendored Normal file
View File

@@ -0,0 +1,702 @@
use strict;
use warnings;
package Email::MIME::ContentType;
# ABSTRACT: Parse and build a MIME Content-Type or Content-Disposition Header
$Email::MIME::ContentType::VERSION = '1.026';
use Carp;
use Encode 2.87 qw(encode find_mime_encoding);
use Exporter 5.57 'import';
use Text::Unidecode;
our @EXPORT = qw(parse_content_type parse_content_disposition build_content_type build_content_disposition);
#pod =head1 SYNOPSIS
#pod
#pod use Email::MIME::ContentType;
#pod
#pod # Content-Type: text/plain; charset="us-ascii"; format=flowed
#pod my $ct = 'text/plain; charset="us-ascii"; format=flowed';
#pod my $data = parse_content_type($ct);
#pod
#pod $data = {
#pod type => "text",
#pod subtype => "plain",
#pod attributes => {
#pod charset => "us-ascii",
#pod format => "flowed"
#pod }
#pod };
#pod
#pod my $ct_new = build_content_type($data);
#pod # text/plain; charset=us-ascii; format=flowed
#pod
#pod
#pod # Content-Type: application/x-stuff;
#pod # title*0*=us-ascii'en'This%20is%20even%20more%20;
#pod # title*1*=%2A%2A%2Afun%2A%2A%2A%20;
#pod # title*2="isn't it!"
#pod my $ct = q(application/x-stuff;
#pod title*0*=us-ascii'en'This%20is%20even%20more%20;
#pod title*1*=%2A%2A%2Afun%2A%2A%2A%20;
#pod title*2="isn't it!");
#pod my $data = parse_content_type($ct);
#pod
#pod $data = {
#pod type => "application",
#pod subtype => "x-stuff",
#pod attributes => {
#pod title => "This is even more ***fun*** isn't it!"
#pod }
#pod };
#pod
#pod
#pod # Content-Disposition: attachment; filename=genome.jpeg;
#pod # modification-date="Wed, 12 Feb 1997 16:29:51 -0500"
#pod my $cd = q(attachment; filename=genome.jpeg;
#pod modification-date="Wed, 12 Feb 1997 16:29:51 -0500");
#pod my $data = parse_content_disposition($cd);
#pod
#pod $data = {
#pod type => "attachment",
#pod attributes => {
#pod filename => "genome.jpeg",
#pod "modification-date" => "Wed, 12 Feb 1997 16:29:51 -0500"
#pod }
#pod };
#pod
#pod my $cd_new = build_content_disposition($data);
#pod # attachment; filename=genome.jpeg; modification-date="Wed, 12 Feb 1997 16:29:51 -0500"
#pod
#pod =cut
our $STRICT_PARAMS = 1;
my $ct_default = 'text/plain; charset=us-ascii';
my $re_token = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7E]+/; # US-ASCII except SPACE, CTLs and tspecials ()<>@,;:\\"/[]?=
my $re_token_non_strict = qr/([\x00-\x08\x0B\x0C\x0E-\x1F\x7E-\xFF]+|$re_token)/; # allow CTLs and above ASCII
my $re_qtext = qr/[\x01-\x08\x0B\x0C\x0E-\x1F\x21\x23-\x5B\x5D-\x7E\x7F]/; # US-ASCII except CR, LF, white space, backslash and quote
my $re_quoted_pair = qr/\\[\x00-\x7F]/;
my $re_quoted_string = qr/"((?:[ \t]*(?:$re_qtext|$re_quoted_pair))*[ \t]*)"/;
my $re_qtext_non_strict = qr/[\x80-\xFF]|$re_qtext/;
my $re_quoted_pair_non_strict = qr/\\[\x00-\xFF]/;
my $re_quoted_string_non_strict = qr/"((?:[ \t]*(?:$re_qtext_non_strict|$re_quoted_pair_non_strict))*[ \t]*)"/;
my $re_charset = qr/[!"#\$%&'+\-0-9A-Z\\\^_`a-z\{\|\}~]+/;
my $re_language = qr/[A-Za-z]{1,8}(?:-[0-9A-Za-z]{1,8})*/;
my $re_exvalue = qr/($re_charset)?'(?:$re_language)?'(.*)/;
sub parse_content_type {
my $ct = shift;
# If the header isn't there or is empty, give default answer.
return parse_content_type($ct_default) unless defined $ct and length $ct;
_unfold_lines($ct);
_clean_comments($ct);
# It is also recommend (sic.) that this default be assumed when a
# syntactically invalid Content-Type header field is encountered.
unless ($ct =~ s/^($re_token)\/($re_token)//) {
unless ($STRICT_PARAMS and $ct =~ s/^($re_token_non_strict)\/($re_token_non_strict)//) {
carp "Invalid Content-Type '$ct'";
return parse_content_type($ct_default);
}
}
my ($type, $subtype) = (lc $1, lc $2);
_clean_comments($ct);
$ct =~ s/\s+$//;
my $attributes = {};
if ($STRICT_PARAMS and length $ct and $ct !~ /^;/) {
carp "Missing semicolon before first Content-Type parameter '$ct'";
} else {
$attributes = _process_rfc2231(_parse_attributes($ct));
}
return {
type => $type,
subtype => $subtype,
attributes => $attributes,
# This is dumb. Really really dumb. For backcompat. -- rjbs,
# 2013-08-10
discrete => $type,
composite => $subtype,
};
}
my $cd_default = 'attachment';
sub parse_content_disposition {
my $cd = shift;
return parse_content_disposition($cd_default) unless defined $cd and length $cd;
_unfold_lines($cd);
_clean_comments($cd);
unless ($cd =~ s/^($re_token)//) {
unless ($STRICT_PARAMS and $cd =~ s/^($re_token_non_strict)//) {
carp "Invalid Content-Disposition '$cd'";
return parse_content_disposition($cd_default);
}
}
my $type = lc $1;
_clean_comments($cd);
$cd =~ s/\s+$//;
my $attributes = {};
if ($STRICT_PARAMS and length $cd and $cd !~ /^;/) {
carp "Missing semicolon before first Content-Disposition parameter '$cd'";
} else {
$attributes = _process_rfc2231(_parse_attributes($cd));
}
return {
type => $type,
attributes => $attributes,
};
}
my $re_invalid_for_quoted_value = qr/[\x00-\x08\x0A-\x1F\x7F-\xFF]/; # non-US-ASCII and CTLs without SPACE and TAB
my $re_escape_extended_value = qr/[\x00-\x20\x7F-\xFF\*'%()<>@,;:\\"\/\[\]?=]/; # non-US-ASCII, SPACE, CTLs, *'% and tspecials ()<>@,;:\\"/[]?=
sub build_content_type {
my $ct = shift;
croak 'Missing Content-Type \'type\' parameter' unless exists $ct->{type};
croak 'Missing Content-Type \'subtype\' parameter' unless exists $ct->{subtype};
croak 'Invalid Content-Type \'type\' parameter' if $ct->{type} !~ /^(?:$re_token)*$/;
croak 'Invalid Content-Type \'subtype\' parameter' if $ct->{subtype} !~ /^(?:$re_token)*$/;
croak 'Too long Content-Type \'type\' and \'subtype\' parameters' if length($ct->{type}) + length($ct->{subtype}) > 76;
my ($extra) = grep !/(?:type|subtype|attributes)/, sort keys %{$ct};
croak "Extra Content-Type '$extra' parameter" if defined $extra;
my $ret = $ct->{type} . '/' . $ct->{subtype};
my $attrs = exists $ct->{attributes} ? _build_attributes($ct->{attributes}) : '';
$ret .= "; $attrs" if length($attrs);
return $ret;
}
sub build_content_disposition {
my $cd = shift;
croak 'Missing Content-Type \'type\' parameter' unless exists $cd->{type};
croak 'Invalid Content-Type \'type\' parameter' if $cd->{type} !~ /^(?:$re_token)*$/;
croak 'Too long Content-Type \'type\' parameter' if length($cd->{type}) > 77;
my ($extra) = grep !/(?:type|attributes)/, sort keys %{$cd};
croak "Extra Content-Type '$extra' parameter" if defined $extra;
my $ret = $cd->{type};
my $attrs = exists $cd->{attributes} ? _build_attributes($cd->{attributes}) : '';
$ret .= "; $attrs" if length($attrs);
return $ret;
}
sub _build_attributes {
my $attributes = shift;
my $ret = '';
foreach my $key (sort keys %{$attributes}) {
my $value = $attributes->{$key};
my $ascii_value = $value;
my @continuous_value;
my $extended_value_charset;
croak "Invalid attribute '$key'" if $key =~ /$re_escape_extended_value/; # complement to attribute-char in 8bit space
croak "Undefined attribute '$key'" unless defined $value;
if ($value =~ /\P{ASCII}/) {
$ascii_value = unidecode($value);
$ascii_value =~ s/\P{ASCII}/_/g;
@continuous_value = map { encode('UTF-8', $_) } split //, $value;
$extended_value_charset = 'UTF-8';
}
if ($ascii_value !~ /^(?:$re_token)*$/ or $ascii_value =~ /'/) {
if ($ascii_value =~ /$re_invalid_for_quoted_value/) {
@continuous_value = split //, $value unless @continuous_value;
$ascii_value =~ s/[\n\r]/ /g;
$ascii_value =~ s/$re_invalid_for_quoted_value/_/g;
}
$ascii_value =~ s/(["\\])/\\$1/g;
$ascii_value = "\"$ascii_value\"";
}
if (length($key) + length($ascii_value) > 75) { # length(" $key=$ascii_value;") > 78
croak "Too long attribute '$key'" if length($key) > 71; # length(" $key=...;") > 78
my $pos = $ascii_value =~ /"$/ ? 71 : 72;
substr($ascii_value, $pos - length($key), length($ascii_value) + length($key) - 72, '...');
@continuous_value = split //, $value unless @continuous_value;
}
if (@continuous_value) {
my $needs_quote;
unless (defined $extended_value_charset) {
$needs_quote = 1 if grep { $_ !~ /^(?:$re_token)*$/ or $_ =~ /'/ } @continuous_value;
$extended_value_charset = 'US-ASCII' if $needs_quote and grep /$re_invalid_for_quoted_value/, @continuous_value;
}
my $add_param_len = 4; # for '; *='
if (defined $extended_value_charset) {
$_ =~ s/($re_escape_extended_value)/sprintf('%%%02X', ord($1))/eg foreach @continuous_value;
substr($continuous_value[0], 0, 0, "$extended_value_charset''");
$add_param_len += 1; # for '*' - charset
} elsif ($needs_quote) {
$_ =~ s/(["\\])/\\$1/g foreach @continuous_value;
$add_param_len += 2; # for quotes
}
if ($value =~ /\P{ASCII}/ and length(my $oneparameter = "; $key*=" . join '', @continuous_value) <= 78) {
$ret .= $oneparameter;
} else {
my $buf = '';
my $count = 0;
foreach (@continuous_value) {
if (length($key) + length($count) + length($buf) + length($_) + $add_param_len > 78) {
$buf = "\"$buf\"" if $needs_quote;
my $parameter = "; $key*$count";
$parameter .= '*' if defined $extended_value_charset;
$parameter .= "=$buf";
croak "Too long attribute '$key'" if length($parameter) > 78;
$ret .= $parameter;
$buf = '';
$count++;
}
$buf .= $_;
}
if (length($buf)) {
$buf = "\"$buf\"" if $needs_quote;
my $parameter = "; $key*$count";
$parameter .= '*' if defined $extended_value_charset;
$parameter .= "=$buf";
croak "Too long attribute '$key'" if length($parameter) > 78;
$ret .= $parameter;
}
}
}
$ret .= "; $key=$ascii_value";
}
substr($ret, 0, 2, '') if length $ret;
return $ret;
}
sub _unfold_lines {
$_[0] =~ s/(?:\r\n|[\r\n])(?=[ \t])//g;
}
sub _clean_comments {
my $ret = ($_[0] =~ s/^\s+//);
while (length $_[0]) {
last unless $_[0] =~ s/^\(//;
my $level = 1;
while (length $_[0]) {
my $ch = substr $_[0], 0, 1, '';
if ($ch eq '(') {
$level++;
} elsif ($ch eq ')') {
$level--;
last if $level == 0;
} elsif ($ch eq '\\') {
substr $_[0], 0, 1, '';
}
}
carp "Unbalanced comment" if $level != 0 and $STRICT_PARAMS;
$ret |= ($_[0] =~ s/^\s+//);
}
return $ret;
}
sub _process_rfc2231 {
my ($attribs) = @_;
my %cont;
my %encoded;
foreach (keys %{$attribs}) {
next unless $_ =~ m/^(.*)\*([0-9]+)\*?$/;
my ($attr, $sec) = ($1, $2);
$cont{$attr}->{$sec} = $attribs->{$_};
$encoded{$attr} = 1 if $_ =~ m/\*$/;
delete $attribs->{$_};
}
foreach (keys %cont) {
my $key = $_;
$key .= '*' if $encoded{$_};
$attribs->{$key} = join '', @{$cont{$_}}{sort { $a <=> $b } keys %{$cont{$_}}};
}
foreach (keys %{$attribs}) {
next unless $_ =~ m/^(.*)\*$/;
my $key = $1;
next unless defined $attribs->{$_} and $attribs->{$_} =~ m/^$re_exvalue$/;
my ($charset, $value) = ($1, $2);
$value =~ s/%([0-9A-Fa-f]{2})/pack('C', hex($1))/eg;
if (length $charset) {
my $enc = find_mime_encoding($charset);
if (defined $enc) {
$value = $enc->decode($value);
} else {
carp "Unknown charset '$charset' in attribute '$key' value";
}
}
$attribs->{$key} = $value;
delete $attribs->{$_};
}
return $attribs;
}
sub _parse_attributes {
local $_ = shift;
substr($_, 0, 0, '; ') if length $_ and $_ !~ /^;/;
my $attribs = {};
while (length $_) {
s/^;// or $STRICT_PARAMS and do {
carp "Missing semicolon before parameter '$_'";
return $attribs;
};
_clean_comments($_);
unless (length $_) {
# Some mail software generates a Content-Type like this:
# "Content-Type: text/plain;"
# RFC 1521 section 3 says a parameter must exist if there is a
# semicolon.
carp "Extra semicolon after last parameter" if $STRICT_PARAMS;
return $attribs;
}
my $attribute;
if (s/^($re_token)=//) {
$attribute = lc $1;
} else {
if ($STRICT_PARAMS) {
carp "Illegal parameter '$_'";
return $attribs;
}
if (s/^($re_token_non_strict)=//) {
$attribute = lc $1;
} else {
unless (s/^([^;=\s]+)\s*=//) {
carp "Cannot parse parameter '$_'";
return $attribs;
}
$attribute = lc $1;
}
}
_clean_comments($_);
my $value = _extract_attribute_value();
$attribs->{$attribute} = $value;
_clean_comments($_);
}
return $attribs;
}
sub _extract_attribute_value { # EXPECTS AND MODIFIES $_
my $value;
while (length $_) {
if (s/^($re_token)//) {
$value .= $1;
} elsif (s/^$re_quoted_string//) {
my $sub = $1;
$sub =~ s/\\(.)/$1/g;
$value .= $sub;
} elsif ($STRICT_PARAMS) {
my $char = substr $_, 0, 1;
carp "Unquoted '$char' not allowed";
return;
} elsif (s/^($re_token_non_strict)//) {
$value .= $1;
} elsif (s/^$re_quoted_string_non_strict//) {
my $sub = $1;
$sub =~ s/\\(.)/$1/g;
$value .= $sub;
}
my $erased = _clean_comments($_);
last if !length $_ or /^;/;
if ($STRICT_PARAMS) {
my $char = substr $_, 0, 1;
carp "Extra '$char' found after parameter";
return;
}
if ($erased) {
# Sometimes semicolon is missing, so check for = char
last if m/^$re_token_non_strict=/;
$value .= ' ';
}
$value .= substr $_, 0, 1, '';
}
return $value;
}
1;
#pod =func parse_content_type
#pod
#pod This routine is exported by default.
#pod
#pod This routine parses email content type headers according to section 5.1 of RFC
#pod 2045 and also RFC 2231 (Character Set and Parameter Continuations). It returns
#pod a hash as above, with entries for the C<type>, the C<subtype>, and a hash of
#pod C<attributes>.
#pod
#pod For backward compatibility with a really unfortunate misunderstanding of RFC
#pod 2045 by the early implementors of this module, C<discrete> and C<composite> are
#pod also present in the returned hashref, with the values of C<type> and C<subtype>
#pod respectively.
#pod
#pod =func parse_content_disposition
#pod
#pod This routine is exported by default.
#pod
#pod This routine parses email Content-Disposition headers according to RFC 2183 and
#pod RFC 2231. It returns a hash as above, with entries for the C<type>, and a hash
#pod of C<attributes>.
#pod
#pod =func build_content_type
#pod
#pod This routine is exported by default.
#pod
#pod This routine builds email Content-Type header according to RFC 2045 and RFC 2231.
#pod It takes a hash as above, with entries for the C<type>, the C<subtype>, and
#pod optionally also a hash of C<attributes>. It returns a string representing
#pod Content-Type header. Non-ASCII attributes are encoded to UTF-8 according to
#pod Character Set section of RFC 2231. Attribute which has more then 78 ASCII
#pod characters is split into more attributes accorrding to Parameter Continuations
#pod of RFC 2231. For compatibility reasons with clients which do not support
#pod RFC 2231, output string contains also truncated ASCII version of any too long or
#pod non-ASCII attribute. Encoding to ASCII is done via Text::Unidecode module.
#pod
#pod =func build_content_disposition
#pod
#pod This routine is exported by default.
#pod
#pod This routine builds email Content-Disposition header according to RFC 2182 and
#pod RFC 2231. It takes a hash as above, with entries for the C<type>, and
#pod optionally also a hash of C<attributes>. It returns a string representing
#pod Content-Disposition header. Non-ASCII or too long attributes are handled in
#pod the same way like in L<build_content_type function|/build_content_type>.
#pod
#pod =head1 WARNINGS
#pod
#pod This is not a valid content-type header, according to both RFC 1521 and RFC
#pod 2045:
#pod
#pod Content-Type: type/subtype;
#pod
#pod If a semicolon appears, a parameter must. C<parse_content_type> will carp if
#pod it encounters a header of this type, but you can suppress this by setting
#pod C<$Email::MIME::ContentType::STRICT_PARAMS> to a false value. Please consider
#pod localizing this assignment!
#pod
#pod Same applies for C<parse_content_disposition>.
#pod
#pod =cut
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::ContentType - Parse and build a MIME Content-Type or Content-Disposition Header
=head1 VERSION
version 1.026
=head1 SYNOPSIS
use Email::MIME::ContentType;
# Content-Type: text/plain; charset="us-ascii"; format=flowed
my $ct = 'text/plain; charset="us-ascii"; format=flowed';
my $data = parse_content_type($ct);
$data = {
type => "text",
subtype => "plain",
attributes => {
charset => "us-ascii",
format => "flowed"
}
};
my $ct_new = build_content_type($data);
# text/plain; charset=us-ascii; format=flowed
# Content-Type: application/x-stuff;
# title*0*=us-ascii'en'This%20is%20even%20more%20;
# title*1*=%2A%2A%2Afun%2A%2A%2A%20;
# title*2="isn't it!"
my $ct = q(application/x-stuff;
title*0*=us-ascii'en'This%20is%20even%20more%20;
title*1*=%2A%2A%2Afun%2A%2A%2A%20;
title*2="isn't it!");
my $data = parse_content_type($ct);
$data = {
type => "application",
subtype => "x-stuff",
attributes => {
title => "This is even more ***fun*** isn't it!"
}
};
# Content-Disposition: attachment; filename=genome.jpeg;
# modification-date="Wed, 12 Feb 1997 16:29:51 -0500"
my $cd = q(attachment; filename=genome.jpeg;
modification-date="Wed, 12 Feb 1997 16:29:51 -0500");
my $data = parse_content_disposition($cd);
$data = {
type => "attachment",
attributes => {
filename => "genome.jpeg",
"modification-date" => "Wed, 12 Feb 1997 16:29:51 -0500"
}
};
my $cd_new = build_content_disposition($data);
# attachment; filename=genome.jpeg; modification-date="Wed, 12 Feb 1997 16:29:51 -0500"
=head1 FUNCTIONS
=head2 parse_content_type
This routine is exported by default.
This routine parses email content type headers according to section 5.1 of RFC
2045 and also RFC 2231 (Character Set and Parameter Continuations). It returns
a hash as above, with entries for the C<type>, the C<subtype>, and a hash of
C<attributes>.
For backward compatibility with a really unfortunate misunderstanding of RFC
2045 by the early implementors of this module, C<discrete> and C<composite> are
also present in the returned hashref, with the values of C<type> and C<subtype>
respectively.
=head2 parse_content_disposition
This routine is exported by default.
This routine parses email Content-Disposition headers according to RFC 2183 and
RFC 2231. It returns a hash as above, with entries for the C<type>, and a hash
of C<attributes>.
=head2 build_content_type
This routine is exported by default.
This routine builds email Content-Type header according to RFC 2045 and RFC 2231.
It takes a hash as above, with entries for the C<type>, the C<subtype>, and
optionally also a hash of C<attributes>. It returns a string representing
Content-Type header. Non-ASCII attributes are encoded to UTF-8 according to
Character Set section of RFC 2231. Attribute which has more then 78 ASCII
characters is split into more attributes accorrding to Parameter Continuations
of RFC 2231. For compatibility reasons with clients which do not support
RFC 2231, output string contains also truncated ASCII version of any too long or
non-ASCII attribute. Encoding to ASCII is done via Text::Unidecode module.
=head2 build_content_disposition
This routine is exported by default.
This routine builds email Content-Disposition header according to RFC 2182 and
RFC 2231. It takes a hash as above, with entries for the C<type>, and
optionally also a hash of C<attributes>. It returns a string representing
Content-Disposition header. Non-ASCII or too long attributes are handled in
the same way like in L<build_content_type function|/build_content_type>.
=head1 WARNINGS
This is not a valid content-type header, according to both RFC 1521 and RFC
2045:
Content-Type: type/subtype;
If a semicolon appears, a parameter must. C<parse_content_type> will carp if
it encounters a header of this type, but you can suppress this by setting
C<$Email::MIME::ContentType::STRICT_PARAMS> to a false value. Please consider
localizing this assignment!
Same applies for C<parse_content_disposition>.
=head1 AUTHORS
=over 4
=item *
Simon Cozens <simon@cpan.org>
=item *
Casey West <casey@geeknest.com>
=item *
Ricardo SIGNES <rjbs@cpan.org>
=back
=head1 CONTRIBUTORS
=for stopwords Matthew Green Pali Ricardo Signes Thomas Szukala
=over 4
=item *
Matthew Green <mrg@eterna.com.au>
=item *
Pali <pali@cpan.org>
=item *
Ricardo Signes <rjbs@semiotic.systems>
=item *
Thomas Szukala <ts@abusix.com>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Simon Cozens.
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

78
database/perl/vendor/lib/Email/MIME/Creator.pm vendored Normal file
View File

@@ -0,0 +1,78 @@
use 5.008001;
use strict;
use warnings;
package Email::MIME::Creator;
# ABSTRACT: obsolete do-nothing library
$Email::MIME::Creator::VERSION = '1.949';
use parent q[Email::Simple::Creator];
use Email::MIME;
use Encode ();
sub _construct_part {
my ($class, $body) = @_;
my $is_binary = $body =~ /[\x00\x80-\xFF]/;
my $content_type = $is_binary ? 'application/x-binary' : 'text/plain';
Email::MIME->create(
attributes => {
content_type => $content_type,
encoding => ($is_binary ? 'base64' : ''), # be safe
},
body => $body,
);
}
1;
#pod =head1 SYNOPSIS
#pod
#pod You don't need to use this module for anything.
#pod
#pod =cut
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Creator - obsolete do-nothing library
=head1 VERSION
version 1.949
=head1 SYNOPSIS
You don't need to use this module for anything.
=head1 AUTHORS
=over 4
=item *
Ricardo SIGNES <rjbs@cpan.org>
=item *
Casey West <casey@geeknest.com>
=item *
Simon Cozens <simon@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Simon Cozens and Casey West.
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

210
database/perl/vendor/lib/Email/MIME/Encode.pm vendored Normal file
View File

@@ -0,0 +1,210 @@
use strict;
use warnings;
package Email::MIME::Encode;
# ABSTRACT: a private helper for MIME header encoding
$Email::MIME::Encode::VERSION = '1.949';
use Carp ();
use Encode ();
use Email::MIME::Header;
use MIME::Base64();
use Module::Runtime ();
use Scalar::Util;
our @CARP_NOT;
my %no_mime_headers = map { $_ => undef } qw(date message-id in-reply-to references downgraded-message-id downgraded-in-reply-to downgraded-references);
sub maybe_mime_encode_header {
my ($header, $val, $charset) = @_;
$header = lc $header;
my $header_name_length = length($header) + length(": ");
if (Scalar::Util::blessed($val) && $val->can("as_mime_string")) {
return $val->as_mime_string({
charset => $charset,
header_name_length => $header_name_length,
});
}
return _object_encode($val, $charset, $header_name_length, $Email::MIME::Header::header_to_class_map{$header})
if exists $Email::MIME::Header::header_to_class_map{$header};
my $min_wrap_length = 78 - $header_name_length + 1;
return $val
unless _needs_mime_encode($val) || $val =~ /[^\s]{$min_wrap_length,}/;
return $val
if exists $no_mime_headers{$header};
return mime_encode($val, $charset, $header_name_length);
}
sub _needs_mime_encode {
my ($val) = @_;
return defined $val && $val =~ /(?:\P{ASCII}|=\?|[^\s]{79,}|^\s+|\s+$)/s;
}
sub _needs_mime_encode_addr {
my ($val) = @_;
return _needs_mime_encode($val) || ( defined $val && $val =~ /[:;,]/ );
}
sub _object_encode {
my ($val, $charset, $header_name_length, $class) = @_;
local @CARP_NOT = qw(Email::MIME Email::MIME::Header);
{
local $@;
Carp::croak("Cannot load package '$class': $@") unless eval { Module::Runtime::require_module($class) };
}
Carp::croak("Class '$class' does not have method 'from_string'") unless $class->can('from_string');
my $object = $class->from_string(ref $val eq 'ARRAY' ? @{$val} : $val);
Carp::croak("Object from class '$class' does not have method 'as_mime_string'") unless $object->can('as_mime_string');
return $object->as_mime_string({
charset => $charset,
header_name_length => $header_name_length,
});
}
# XXX this is copied directly out of Courriel::Header
# eventually, this should be extracted out into something that could be shared
sub mime_encode {
my ($text, $charset, $header_name_length) = @_;
$header_name_length = 0 unless defined $header_name_length;
$charset = 'UTF-8' unless defined $charset;
my $enc_obj = Encode::find_encoding($charset);
my $head = '=?' . $enc_obj->mime_name() . '?B?';
my $tail = '?=';
my $mime_length = length($head) + length($tail);
# This code is copied from Mail::Message::Field::Full in the Mail-Box
# distro.
my $real_length = int( ( 75 - $mime_length ) / 4 ) * 3;
my $first_length = int( ( 75 - $header_name_length - $mime_length ) / 4 ) * 3;
my @result;
my $chunk = q{};
my $first_processed = 0;
while ( length( my $chr = substr( $text, 0, 1, '' ) ) ) {
my $chr = $enc_obj->encode( $chr, 0 );
if ( length($chunk) + length($chr) > ( $first_processed ? $real_length : $first_length ) ) {
if ( length($chunk) > 0 ) {
push @result, $head . MIME::Base64::encode_base64( $chunk, q{} ) . $tail;
$chunk = q{};
}
$first_processed = 1
unless $first_processed;
}
$chunk .= $chr;
}
push @result, $head . MIME::Base64::encode_base64( $chunk, q{} ) . $tail
if length $chunk;
return join q{ }, @result;
}
sub maybe_mime_decode_header {
my ($header, $val) = @_;
$header = lc $header;
return _object_decode($val, $Email::MIME::Header::header_to_class_map{$header})
if exists $Email::MIME::Header::header_to_class_map{$header};
return $val
if exists $no_mime_headers{$header};
return $val
unless $val =~ /=\?/;
return mime_decode($val);
}
sub _object_decode {
my ($string, $class) = @_;
local @CARP_NOT = qw(Email::MIME Email::MIME::Header);
{
local $@;
Carp::croak("Cannot load package '$class': $@") unless eval { Module::Runtime::require_module($class) };
}
Carp::croak("Class '$class' does not have method 'from_mime_string'") unless $class->can('from_mime_string');
my $object = $class->from_mime_string($string);
Carp::croak("Object from class '$class' does not have method 'as_string'") unless $object->can('as_string');
return $object->as_string();
}
sub mime_decode {
my ($text) = @_;
return undef unless defined $text;
# The eval is to cope with unknown encodings, like Latin-62, or other
# nonsense that gets put in there by spammers and weirdos
# -- rjbs, 2014-12-04
local $@;
my $result = eval { Encode::decode("MIME-Header", $text) };
return defined $result ? $result : $text;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Encode - a private helper for MIME header encoding
=head1 VERSION
version 1.949
=head1 AUTHORS
=over 4
=item *
Ricardo SIGNES <rjbs@cpan.org>
=item *
Casey West <casey@geeknest.com>
=item *
Simon Cozens <simon@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Simon Cozens and Casey West.
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

123
database/perl/vendor/lib/Email/MIME/Encodings.pm vendored Normal file
View File

@@ -0,0 +1,123 @@
use strict;
use warnings;
package Email::MIME::Encodings;
{
$Email::MIME::Encodings::VERSION = '1.315';
}
# ABSTRACT: A unified interface to MIME encoding and decoding
use MIME::Base64 3.05;
use MIME::QuotedPrint 3.05;
sub identity { $_[0] }
for (qw(7bit 8bit binary)) {
no strict 'refs';
*{"encode_$_"} = *{"decode_$_"} = \&identity;
}
sub codec {
my ($which, $how, $what, $fb) = @_;
$how = lc $how;
$how = "qp" if $how eq "quotedprint" or $how eq "quoted-printable";
my $sub = __PACKAGE__->can("$which\_$how");
if (! $sub && $fb) {
$fb = lc $fb;
$fb = "qp" if $fb eq "quotedprint" or $fb eq "quoted-printable";
$sub = __PACKAGE__->can("$which\_$fb");
}
unless ($sub) {
require Carp;
Carp::croak("Don't know how to $which $how");
}
# RFC2822 requires all email lines to end in CRLF. The Quoted-Printable
# RFC requires CRLF to not be encoded, when representing newlins. We will
# assume, in this code, that QP is being used for plain text and not binary
# data. This may, someday, be wrong -- but if you are using QP to encode
# binary data, you are already doing something bizarre.
#
# The only way to achieve this with MIME::QuotedPrint is to replace all
# CRLFs with just LF and then let MIME::QuotedPrint replace all LFs with
# CRLF. Otherwise MIME::QuotedPrint (by default) encodes CR as =0D, which
# is against RFCs and breaks MUAs (such as Thunderbird).
#
# We don't modify data before Base64 encoding it because that is usually
# binary data and modifying it at all is a bad idea. We do however specify
# that the encoder should end lines with CRLF (since that's the email
# standard).
# -- rjbs and mkanat, 2009-04-16
my $eol = "\x0d\x0a";
if ($which eq 'encode') {
$what =~ s/$eol/\x0a/sg if $how eq 'qp';
return $sub->($what, $eol);
} else {
my $txt = $sub->($what);
$txt =~ s/\x0a/$eol/sg if $how eq 'qp';
return $txt;
}
}
sub decode { return codec("decode", @_) }
sub encode { return codec("encode", @_) }
1;
__END__
=pod
=head1 NAME
Email::MIME::Encodings - A unified interface to MIME encoding and decoding
=head1 VERSION
version 1.315
=head1 SYNOPSIS
use Email::MIME::Encodings;
my $encoded = Email::MIME::Encodings::encode(base64 => $body);
my $decoded = Email::MIME::Encodings::decode(base64 => $encoded);
If a third argument is given, it is the encoding to which to fall back. If no
valid codec can be found (considering both the first and third arguments) then
an exception is raised.
=head1 DESCRIPTION
This module simply wraps C<MIME::Base64> and C<MIME::QuotedPrint>
so that you can throw the contents of a C<Content-Transfer-Encoding>
header at some text and have the right thing happen.
C<MIME::Base64>, C<MIME::QuotedPrint>, C<Email::MIME>.
=head1 AUTHORS
=over 4
=item *
Simon Cozens <simon@cpan.org>
=item *
Casey West <casey@geeknest.com>
=item *
Ricardo SIGNES <rjbs@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Simon Cozens and Casey West.
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

208
database/perl/vendor/lib/Email/MIME/Header.pm vendored Normal file
View File

@@ -0,0 +1,208 @@
use strict;
use warnings;
package Email::MIME::Header;
# ABSTRACT: the header of a MIME message
$Email::MIME::Header::VERSION = '1.949';
use parent 'Email::Simple::Header';
use Carp ();
use Email::MIME::Encode;
use Encode 1.9801;
use Module::Runtime ();
our @CARP_NOT;
our %header_to_class_map;
BEGIN {
my @address_list_headers = qw(from sender reply-to to cc bcc);
push @address_list_headers, map { "resent-$_" } @address_list_headers;
push @address_list_headers, map { "downgraded-$_" } @address_list_headers; # RFC 5504
push @address_list_headers, qw(original-from disposition-notification-to); # RFC 5703 and RFC 3798
$header_to_class_map{$_} = 'Email::MIME::Header::AddressList' foreach @address_list_headers;
}
#pod =head1 DESCRIPTION
#pod
#pod This object behaves like a standard Email::Simple header, with the following
#pod changes:
#pod
#pod =for :list
#pod * the C<header> method automatically decodes encoded headers if possible
#pod * the C<header_as_obj> method returns an object representation of the header value
#pod * the C<header_raw> method returns the raw header; (read only for now)
#pod * stringification uses C<header_raw> rather than C<header>
#pod
#pod Note that C<header_set> does not do encoding for you, and expects an
#pod encoded header. Thus, C<header_set> round-trips with C<header_raw>,
#pod not C<header>! Be sure to properly encode your headers with
#pod C<Encode::encode('MIME-Header', $value)> before passing them to
#pod C<header_set>. And be sure to use minimal version 2.83 of Encode
#pod module due to L<bugs in MIME-Header|Encode::MIME::Header/BUGS>.
#pod
#pod Alternately, if you have Unicode (character) strings to set in headers, use the
#pod C<header_str_set> method.
#pod
#pod =cut
sub header_str {
my $self = shift;
my $wanta = wantarray;
return unless defined $wanta; # ??
my @header = $wanta ? $self->header_raw(@_)
: scalar $self->header_raw(@_);
foreach my $header (@header) {
next unless defined $header;
next unless $header =~ /=\?/;
_maybe_decode($_[0], \$header);
}
return $wanta ? @header : $header[0];
}
sub header {
my $self = shift;
return $self->header_str(@_);
}
sub header_str_set {
my ($self, $name, @vals) = @_;
my @values = map {
Email::MIME::Encode::maybe_mime_encode_header($name, $_, 'UTF-8')
} @vals;
$self->header_raw_set($name => @values);
}
sub header_str_pairs {
my ($self) = @_;
my @pairs = $self->header_pairs;
for (grep { $_ % 2 } (1 .. $#pairs)) {
_maybe_decode($pairs[$_-1], \$pairs[$_]);
}
return @pairs;
}
sub header_as_obj {
my ($self, $name, $index, $class) = @_;
$class = $self->get_class_for_header($name) unless defined $class;
{
local @CARP_NOT = qw(Email::MIME);
local $@;
Carp::croak("No class for header '$name' was specified") unless defined $class;
Carp::croak("Cannot load package '$class' for header '$name': $@") unless eval { Module::Runtime::require_module($class) };
Carp::croak("Class '$class' does not have method 'from_mime_string'") unless $class->can('from_mime_string');
}
my @values = $self->header_raw($name, $index);
if (wantarray) {
return map { $class->from_mime_string($_) } @values;
} else {
return $class->from_mime_string(@values);
}
}
sub _maybe_decode {
my ($name, $str_ref) = @_;
$$str_ref = Email::MIME::Encode::maybe_mime_decode_header($name, $$str_ref);
return;
}
sub get_class_for_header {
my ($self, $name) = @_;
return $header_to_class_map{lc $name};
}
sub set_class_for_header {
my ($self, $class, $header) = @_;
$header = lc $header;
Carp::croak("Class for header '$header' is already set") if defined $header_to_class_map{$header};
$header_to_class_map{$header} = $class;
return;
}
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Header - the header of a MIME message
=head1 VERSION
version 1.949
=head1 DESCRIPTION
This object behaves like a standard Email::Simple header, with the following
changes:
=over 4
=item *
the C<header> method automatically decodes encoded headers if possible
=item *
the C<header_as_obj> method returns an object representation of the header value
=item *
the C<header_raw> method returns the raw header; (read only for now)
=item *
stringification uses C<header_raw> rather than C<header>
=back
Note that C<header_set> does not do encoding for you, and expects an
encoded header. Thus, C<header_set> round-trips with C<header_raw>,
not C<header>! Be sure to properly encode your headers with
C<Encode::encode('MIME-Header', $value)> before passing them to
C<header_set>. And be sure to use minimal version 2.83 of Encode
module due to L<bugs in MIME-Header|Encode::MIME::Header/BUGS>.
Alternately, if you have Unicode (character) strings to set in headers, use the
C<header_str_set> method.
=head1 AUTHORS
=over 4
=item *
Ricardo SIGNES <rjbs@cpan.org>
=item *
Casey West <casey@geeknest.com>
=item *
Simon Cozens <simon@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Simon Cozens and Casey West.
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

507
database/perl/vendor/lib/Email/MIME/Header/AddressList.pm vendored Normal file
View File

@@ -0,0 +1,507 @@
# Copyright (c) 2016-2017 by Pali <pali@cpan.org>
package Email::MIME::Header::AddressList;
$Email::MIME::Header::AddressList::VERSION = '1.949';
use strict;
use warnings;
use Carp ();
use Email::Address::XS;
use Email::MIME::Encode;
#pod =encoding utf8
#pod
#pod =head1 NAME
#pod
#pod Email::MIME::Header::AddressList - MIME support for list of Email::Address::XS objects
#pod
#pod =head1 SYNOPSIS
#pod
#pod my $address1 = Email::Address::XS->new('Name1' => 'address1@host.com');
#pod my $address2 = Email::Address::XS->new("Name2 \N{U+263A}" => 'address2@host.com');
#pod my $mime_address = Email::Address::XS->new('=?UTF-8?B?TmFtZTIg4pi6?=' => 'address2@host.com');
#pod
#pod my $list1 = Email::MIME::Header::AddressList->new($address1, $address2);
#pod
#pod $list1->append_groups('undisclosed-recipients' => []);
#pod
#pod $list1->first_address();
#pod # returns $address1
#pod
#pod $list1->groups();
#pod # returns (undef, [ $address1, $address2 ], 'undisclosed-recipients', [])
#pod
#pod $list1->as_string();
#pod # returns 'Name1 <address1@host.com>, "Name2 ☺" <address2@host.com>, undisclosed-recipients:;'
#pod
#pod $list1->as_mime_string();
#pod # returns 'Name1 <address1@host.com>, =?UTF-8?B?TmFtZTIg4pi6?= <address2@host.com>, undisclosed-recipients:;'
#pod
#pod my $list2 = Email::MIME::Header::AddressList->new_groups(Group => [ $address1, $address2 ]);
#pod
#pod $list2->append_addresses($address2);
#pod
#pod $list2->addresses();
#pod # returns ($address2, $address1, $address2)
#pod
#pod $list2->groups();
#pod # returns (undef, [ $address2 ], 'Group', [ $address1, $address2 ])
#pod
#pod my $list3 = Email::MIME::Header::AddressList->new_mime_groups('=?UTF-8?B?4pi6?=' => [ $mime_address ]);
#pod $list3->as_string();
#pod # returns '☺: "Name2 ☺" <address2@host.com>;'
#pod
#pod my $list4 = Email::MIME::Header::AddressList->from_string('Name1 <address1@host.com>, "Name2 ☺" <address2@host.com>, undisclosed-recipients:;');
#pod my $list5 = Email::MIME::Header::AddressList->from_string('Name1 <address1@host.com>', '"Name2 ☺" <address2@host.com>', 'undisclosed-recipients:;');
#pod
#pod my $list6 = Email::MIME::Header::AddressList->from_mime_string('Name1 <address1@host.com>, =?UTF-8?B?TmFtZTIg4pi6?= <address2@host.com>, undisclosed-recipients:;');
#pod my $list7 = Email::MIME::Header::AddressList->from_mime_string('Name1 <address1@host.com>', '=?UTF-8?B?TmFtZTIg4pi6?= <address2@host.com>', 'undisclosed-recipients:;');
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module implements object representation for the list of the
#pod L<Email::Address::XS|Email::Address::XS> objects. It provides methods for
#pod L<RFC 2047|https://tools.ietf.org/html/rfc2047> MIME encoding and decoding
#pod suitable for L<RFC 2822|https://tools.ietf.org/html/rfc2822> address-list
#pod structure.
#pod
#pod =head2 EXPORT
#pod
#pod None
#pod
#pod =head2 Class Methods
#pod
#pod =over 4
#pod
#pod =item new_empty
#pod
#pod Construct new empty C<Email::MIME::Header::AddressList> object.
#pod
#pod =cut
sub new_empty {
my ($class) = @_;
return bless { addresses => [], groups => [] }, $class;
}
#pod =item new
#pod
#pod Construct new C<Email::MIME::Header::AddressList> object from list of
#pod L<Email::Address::XS|Email::Address::XS> objects.
#pod
#pod =cut
sub new {
my ($class, @addresses) = @_;
my $self = $class->new_empty();
$self->append_addresses(@addresses);
return $self;
}
#pod =item new_groups
#pod
#pod Construct new C<Email::MIME::Header::AddressList> object from named groups of
#pod L<Email::Address::XS|Email::Address::XS> objects.
#pod
#pod =cut
sub new_groups {
my ($class, @groups) = @_;
my $self = $class->new_empty();
$self->append_groups(@groups);
return $self;
}
#pod =item new_mime_groups
#pod
#pod Like L<C<new_groups>|/new_groups> but in this method group names and objects properties are
#pod expected to be already MIME encoded, thus ASCII strings.
#pod
#pod =cut
sub new_mime_groups {
my ($class, @groups) = @_;
if (scalar @groups % 2) {
Carp::carp 'Odd number of elements in argument list';
return;
}
foreach (0 .. scalar @groups / 2 - 1) {
$groups[2 * $_] = Email::MIME::Encode::mime_decode($groups[2 * $_])
if defined $groups[2 * $_] and $groups[2 * $_] =~ /=\?/;
$groups[2 * $_ + 1] = [ @{$groups[2 * $_ + 1]} ];
foreach (@{$groups[2 * $_ + 1]}) {
next unless Email::Address::XS->is_obj($_);
my $decode_phrase = (defined $_->phrase and $_->phrase =~ /=\?/);
my $decode_comment = (defined $_->comment and $_->comment =~ /=\?/);
next unless $decode_phrase or $decode_comment;
$_ = ref($_)->new(copy => $_);
$_->phrase(Email::MIME::Encode::mime_decode($_->phrase))
if $decode_phrase;
$_->comment(Email::MIME::Encode::mime_decode($_->comment))
if $decode_comment;
}
}
return $class->new_groups(@groups);
}
#pod =item from_string
#pod
#pod Construct new C<Email::MIME::Header::AddressList> object from input string arguments.
#pod Calls L<Email::Address::XS::parse_email_groups|Email::Address::XS/parse_email_groups>.
#pod
#pod =cut
sub from_string {
my ($class, @strings) = @_;
return $class->new_groups(map { Email::Address::XS::parse_email_groups($_) } @strings);
}
#pod =item from_mime_string
#pod
#pod Like L<C<from_string>|/from_string> but input string arguments are expected to
#pod be already MIME encoded.
#pod
#pod =cut
sub from_mime_string {
my ($class, @strings) = @_;
return $class->new_mime_groups(map { Email::Address::XS::parse_email_groups($_) } @strings);
}
#pod =back
#pod
#pod =head2 Object Methods
#pod
#pod =over 4
#pod
#pod =item as_string
#pod
#pod Returns string representation of C<Email::MIME::Header::AddressList> object.
#pod Calls L<Email::Address::XS::format_email_groups|Email::Address::XS/format_email_groups>.
#pod
#pod =cut
sub as_string {
my ($self) = @_;
return Email::Address::XS::format_email_groups($self->groups());
}
#pod =item as_mime_string
#pod
#pod Like L<C<as_string>|/as_string> but output string will be properly and
#pod unambiguously MIME encoded. MIME encoding is done before calling
#pod L<Email::Address::XS::format_email_groups|Email::Address::XS/format_email_groups>.
#pod
#pod =cut
sub as_mime_string {
my ($self, $arg) = @_;
my $charset = $arg->{charset};
my $header_name_length = $arg->{header_name_length};
my @groups = $self->groups();
foreach (0 .. scalar @groups / 2 - 1) {
$groups[2 * $_] = Email::MIME::Encode::mime_encode($groups[2 * $_], $charset)
if Email::MIME::Encode::_needs_mime_encode_addr($groups[2 * $_]);
$groups[2 * $_ + 1] = [ @{$groups[2 * $_ + 1]} ];
foreach (@{$groups[2 * $_ + 1]}) {
my $encode_phrase = Email::MIME::Encode::_needs_mime_encode_addr($_->phrase);
my $encode_comment = Email::MIME::Encode::_needs_mime_encode_addr($_->comment);
next unless $encode_phrase or $encode_comment;
$_ = ref($_)->new(copy => $_);
$_->phrase(Email::MIME::Encode::mime_encode($_->phrase, $charset))
if $encode_phrase;
$_->comment(Email::MIME::Encode::mime_encode($_->comment, $charset))
if $encode_comment;
}
}
return Email::Address::XS::format_email_groups(@groups);
}
#pod =item first_address
#pod
#pod Returns first L<Email::Address::XS|Email::Address::XS> object.
#pod
#pod =cut
sub first_address {
my ($self) = @_;
return $self->{addresses}->[0] if @{$self->{addresses}};
my $groups = $self->{groups};
foreach (0 .. @{$groups} / 2 - 1) {
next unless @{$groups->[2 * $_ + 1]};
return $groups->[2 * $_ + 1]->[0];
}
return undef;
}
#pod =item addresses
#pod
#pod Returns list of all L<Email::Address::XS|Email::Address::XS> objects.
#pod
#pod =cut
sub addresses {
my ($self) = @_;
my $t = 1;
my @addresses = @{$self->{addresses}};
push @addresses, map { @{$_} } grep { $t ^= 1 } @{$self->{groups}};
return @addresses;
}
#pod =item groups
#pod
#pod Like L<C<addresses>|/addresses> but returns objects with named groups.
#pod
#pod =cut
sub groups {
my ($self) = @_;
my @groups = @{$self->{groups}};
$groups[2 * $_ + 1] = [ @{$groups[2 * $_ + 1]} ]
foreach 0 .. scalar @groups / 2 - 1;
unshift @groups, undef, [ @{$self->{addresses}} ]
if @{$self->{addresses}};
return @groups;
}
#pod =item append_addresses
#pod
#pod Append L<Email::Address::XS|Email::Address::XS> objects.
#pod
#pod =cut
sub append_addresses {
my ($self, @addresses) = @_;
my @valid_addresses = grep { Email::Address::XS->is_obj($_) } @addresses;
Carp::carp 'Argument is not an Email::Address::XS object' if scalar @valid_addresses != scalar @addresses;
push @{$self->{addresses}}, @valid_addresses;
}
#pod =item append_groups
#pod
#pod Like L<C<append_addresses>|/append_addresses> but arguments are pairs of name of
#pod group and array reference of L<Email::Address::XS|Email::Address::XS> objects.
#pod
#pod =cut
sub append_groups {
my ($self, @groups) = @_;
if (scalar @groups % 2) {
Carp::carp 'Odd number of elements in argument list';
return;
}
my $carp_invalid = 1;
my @valid_groups;
foreach (0 .. scalar @groups / 2 - 1) {
push @valid_groups, $groups[2 * $_];
my $addresses = $groups[2 * $_ + 1];
my @valid_addresses = grep { Email::Address::XS->is_obj($_) } @{$addresses};
if ($carp_invalid and scalar @valid_addresses != scalar @{$addresses}) {
Carp::carp 'Array element is not an Email::Address::XS object';
$carp_invalid = 0;
}
push @valid_groups, \@valid_addresses;
}
push @{$self->{groups}}, @valid_groups;
}
#pod =back
#pod
#pod =head1 SEE ALSO
#pod
#pod L<RFC 2047|https://tools.ietf.org/html/rfc2047>,
#pod L<RFC 2822|https://tools.ietf.org/html/rfc2822>,
#pod L<Email::MIME>,
#pod L<Email::Address::XS>
#pod
#pod =head1 AUTHOR
#pod
#pod Pali E<lt>pali@cpan.orgE<gt>
#pod
#pod =cut
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Header::AddressList
=head1 VERSION
version 1.949
=head1 SYNOPSIS
my $address1 = Email::Address::XS->new('Name1' => 'address1@host.com');
my $address2 = Email::Address::XS->new("Name2 \N{U+263A}" => 'address2@host.com');
my $mime_address = Email::Address::XS->new('=?UTF-8?B?TmFtZTIg4pi6?=' => 'address2@host.com');
my $list1 = Email::MIME::Header::AddressList->new($address1, $address2);
$list1->append_groups('undisclosed-recipients' => []);
$list1->first_address();
# returns $address1
$list1->groups();
# returns (undef, [ $address1, $address2 ], 'undisclosed-recipients', [])
$list1->as_string();
# returns 'Name1 <address1@host.com>, "Name2 ☺" <address2@host.com>, undisclosed-recipients:;'
$list1->as_mime_string();
# returns 'Name1 <address1@host.com>, =?UTF-8?B?TmFtZTIg4pi6?= <address2@host.com>, undisclosed-recipients:;'
my $list2 = Email::MIME::Header::AddressList->new_groups(Group => [ $address1, $address2 ]);
$list2->append_addresses($address2);
$list2->addresses();
# returns ($address2, $address1, $address2)
$list2->groups();
# returns (undef, [ $address2 ], 'Group', [ $address1, $address2 ])
my $list3 = Email::MIME::Header::AddressList->new_mime_groups('=?UTF-8?B?4pi6?=' => [ $mime_address ]);
$list3->as_string();
# returns '☺: "Name2 ☺" <address2@host.com>;'
my $list4 = Email::MIME::Header::AddressList->from_string('Name1 <address1@host.com>, "Name2 ☺" <address2@host.com>, undisclosed-recipients:;');
my $list5 = Email::MIME::Header::AddressList->from_string('Name1 <address1@host.com>', '"Name2 ☺" <address2@host.com>', 'undisclosed-recipients:;');
my $list6 = Email::MIME::Header::AddressList->from_mime_string('Name1 <address1@host.com>, =?UTF-8?B?TmFtZTIg4pi6?= <address2@host.com>, undisclosed-recipients:;');
my $list7 = Email::MIME::Header::AddressList->from_mime_string('Name1 <address1@host.com>', '=?UTF-8?B?TmFtZTIg4pi6?= <address2@host.com>', 'undisclosed-recipients:;');
=head1 DESCRIPTION
This module implements object representation for the list of the
L<Email::Address::XS|Email::Address::XS> objects. It provides methods for
L<RFC 2047|https://tools.ietf.org/html/rfc2047> MIME encoding and decoding
suitable for L<RFC 2822|https://tools.ietf.org/html/rfc2822> address-list
structure.
=head2 EXPORT
None
=head2 Class Methods
=over 4
=item new_empty
Construct new empty C<Email::MIME::Header::AddressList> object.
=item new
Construct new C<Email::MIME::Header::AddressList> object from list of
L<Email::Address::XS|Email::Address::XS> objects.
=item new_groups
Construct new C<Email::MIME::Header::AddressList> object from named groups of
L<Email::Address::XS|Email::Address::XS> objects.
=item new_mime_groups
Like L<C<new_groups>|/new_groups> but in this method group names and objects properties are
expected to be already MIME encoded, thus ASCII strings.
=item from_string
Construct new C<Email::MIME::Header::AddressList> object from input string arguments.
Calls L<Email::Address::XS::parse_email_groups|Email::Address::XS/parse_email_groups>.
=item from_mime_string
Like L<C<from_string>|/from_string> but input string arguments are expected to
be already MIME encoded.
=back
=head2 Object Methods
=over 4
=item as_string
Returns string representation of C<Email::MIME::Header::AddressList> object.
Calls L<Email::Address::XS::format_email_groups|Email::Address::XS/format_email_groups>.
=item as_mime_string
Like L<C<as_string>|/as_string> but output string will be properly and
unambiguously MIME encoded. MIME encoding is done before calling
L<Email::Address::XS::format_email_groups|Email::Address::XS/format_email_groups>.
=item first_address
Returns first L<Email::Address::XS|Email::Address::XS> object.
=item addresses
Returns list of all L<Email::Address::XS|Email::Address::XS> objects.
=item groups
Like L<C<addresses>|/addresses> but returns objects with named groups.
=item append_addresses
Append L<Email::Address::XS|Email::Address::XS> objects.
=item append_groups
Like L<C<append_addresses>|/append_addresses> but arguments are pairs of name of
group and array reference of L<Email::Address::XS|Email::Address::XS> objects.
=back
=head1 NAME
Email::MIME::Header::AddressList - MIME support for list of Email::Address::XS objects
=head1 SEE ALSO
L<RFC 2047|https://tools.ietf.org/html/rfc2047>,
L<RFC 2822|https://tools.ietf.org/html/rfc2822>,
L<Email::MIME>,
L<Email::Address::XS>
=head1 AUTHOR
Pali E<lt>pali@cpan.orgE<gt>
=head1 AUTHORS
=over 4
=item *
Ricardo SIGNES <rjbs@cpan.org>
=item *
Casey West <casey@geeknest.com>
=item *
Simon Cozens <simon@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Simon Cozens and Casey West.
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

447
database/perl/vendor/lib/Email/MIME/Kit.pm vendored Normal file
View File

@@ -0,0 +1,447 @@
package Email::MIME::Kit;
# ABSTRACT: build messages from templates
$Email::MIME::Kit::VERSION = '3.000006';
require 5.008;
use Moose 0.65; # maybe_type
use Moose::Util::TypeConstraints;
use Email::MIME 1.930; # header_raw
use Email::MessageID 1.400; # for in_brackets method
use Module::Runtime ();
use String::RewritePrefix;
#pod =head1 SYNOPSIS
#pod
#pod use Email::MIME::Kit;
#pod
#pod my $kit = Email::MIME::Kit->new({ source => 'mkits/sample.mkit' });
#pod
#pod my $email = $kit->assemble({
#pod account => $new_signup,
#pod verification_code => $token,
#pod ... and any other template vars ...
#pod });
#pod
#pod $transport->send($email, { ... });
#pod
#pod =head1 DESCRIPTION
#pod
#pod Email::MIME::Kit is a templating system for email messages. Instead of trying
#pod to be yet another templating system for chunks of text, it makes it easy to
#pod build complete email messages.
#pod
#pod It handles the construction of multipart messages, text and HTML alternatives,
#pod attachments, interpart linking, string encoding, and parameter validation.
#pod
#pod Although nearly every part of Email::MIME::Kit is a replaceable component, the
#pod stock configuration is probably enough for most use. A message kit will be
#pod stored as a directory that might look like this:
#pod
#pod sample.mkit/
#pod manifest.json
#pod body.txt
#pod body.html
#pod logo.jpg
#pod
#pod The manifest file tells Email::MIME::Kit how to put it all together, and might
#pod look something like this:
#pod
#pod {
#pod "renderer": "TT",
#pod "header": [
#pod { "From": "WY Corp <noreplies@wy.example.com>" },
#pod { "Subject": "Welcome aboard, [% recruit.name %]!" }
#pod ],
#pod "alternatives": [
#pod { "type": "text/plain", "path": "body.txt" },
#pod {
#pod "type": "text/html",
#pod "path": "body.html",
#pod "container_type": "multipart/related",
#pod "attachments": [ { "type": "image/jpeg", "path": "logo.jpg" } ]
#pod }
#pod ]
#pod }
#pod
#pod B<Inline images> may be accessed with the function C<cid_for>, for example to include the above logo.jpg:
#pod
#pod <img style="margin: 0 auto" src="cid:[% cid_for("logo.jpg") %]">
#pod
#pod B<Please note:> the assembly of HTML documents as multipart/related bodies may
#pod be simplified with an alternate assembler in the future.
#pod
#pod The above manifest would build a multipart alternative message. GUI mail
#pod clients would see a rendered HTML document with the logo graphic visible from
#pod the attachment. Text mail clients would see the plaintext.
#pod
#pod Both the HTML and text parts would be rendered using the named renderer, which
#pod here is Template-Toolkit.
#pod
#pod The message would be assembled and returned as an Email::MIME object, just as
#pod easily as suggested in the L</SYNOPSIS> above.
#pod
#pod =head1 ENCODING ISSUES
#pod
#pod In general, "it should all just work" ... starting in version v3.
#pod
#pod Email::MIME::Kit assumes that any file read for the purpose of becoming a
#pod C<text/*>-type part is encoded in UTF-8. It will decode them and work with
#pod their contents as text strings. Renderers will be passed text strings to
#pod render, and so on. This, further, means that strings passed to the C<assemble>
#pod method for use in rendering should also be text strings.
#pod
#pod In older versions of Email::MIME::Kit, files read from disk were read in raw
#pod mode and then handled as octet strings. Meanwhile, the manifest's contents
#pod (and, thus, any templates stored as strings in the manifest) were decoded into
#pod text strings. This could lead to serious problems. For example: the
#pod F<manifest.json> file might contain:
#pod
#pod "header": [
#pod { "Subject": "Message for [% customer_name %]" },
#pod ...
#pod ]
#pod
#pod ...while a template on disk might contain:
#pod
#pod Dear [% customer_name %],
#pod ...
#pod
#pod If the customer's name isn't ASCII, there was no right way to pass it in. The
#pod template on disk would expect UTF-8, but the template in the manifest would
#pod expect Unicode text. Users prior to v3 may have taken strange steps to get
#pod around this problem, understanding that some templates were treated differently
#pod than others. This means that some review of kits is in order when upgrading
#pod from earlier versions of Email::MIME::Kit.
#pod
#pod =cut
has source => (is => 'ro', required => 1);
has manifest => (reader => 'manifest', writer => '_set_manifest');
my @auto_attrs = (
[ manifest_reader => ManifestReader => JSON => [ 'read_manifest' ] ],
[ kit_reader => KitReader => Dir => [ 'get_kit_entry',
'get_decoded_kit_entry' ] ],
);
for my $tuple (@auto_attrs) {
my ($attr, $role, $default, $handles) = @$tuple;
my $seed = "_${attr}_seed";
my $base_ns = "Email::MIME::Kit::$role";
my $role_pkg = "Email::MIME::Kit::Role::$role";
has $seed => (
is => 'ro',
init_arg => $attr,
default => "=Email::MIME::Kit::${role}::$default",
);
has $attr => (
reader => $attr,
writer => "_set_$attr",
isa => role_type($role_pkg),
init_arg => undef,
lazy => 1,
default => sub {
my ($self) = @_;
my $comp = $self->_build_component($base_ns, $self->$seed);
return $comp;
},
handles => $handles,
);
}
has validator => (
is => 'ro',
isa => maybe_type(role_type('Email::MIME::Kit::Role::Validator')),
lazy => 1, # is this really needed? -- rjbs, 2009-01-20
default => sub {
my ($self) = @_;
return $self->_build_component(
'Email::MIME::Kit::Validator',
$self->manifest->{validator},
);
},
);
sub _build_component {
my ($self, $base_namespace, $entry, $extra) = @_;
return unless $entry;
my ($class, $arg);
if (ref $entry) {
($class, $arg) = @$entry;
} else {
($class, $arg) = ($entry, {});
}
$class = String::RewritePrefix->rewrite(
{ '=' => '', '' => ($base_namespace . q{::}) },
$class,
);
Module::Runtime::require_module($class);
$class->new({ %$arg, %{ $extra || {} }, kit => $self });
}
sub BUILD {
my ($self) = @_;
my $manifest = $self->read_manifest;
$self->_set_manifest($manifest);
if ($manifest->{kit_reader}) {
my $kit_reader = $self->_build_component(
'Email::MIME::Kit::KitReader',
$manifest->{kit_reader},
);
$self->_set_kit_reader($kit_reader);
}
$self->_setup_default_renderer;
}
sub _setup_default_renderer {
my ($self) = @_;
return unless my $renderer = $self->_build_component(
'Email::MIME::Kit::Renderer',
$self->manifest->{renderer},
);
$self->_set_default_renderer($renderer);
}
sub assemble {
my ($self, $stash) = @_;
$self->validator->validate($stash) if $self->validator;
# Do I really need or want to do this? Anything that alters the stash should
# do so via localization. -- rjbs, 2009-01-20
my $copied_stash = { %{ $stash || {} } };
my $email = $self->assembler->assemble($copied_stash);
my $header = $email->header('Message-ID');
$email->header_set('Message-ID' => $self->_generate_content_id->in_brackets)
unless defined $header;
return $email;
}
sub kit { $_[0] }
sub _assembler_from_manifest {
my ($self, $manifest, $parent) = @_;
$self->_build_component(
'Email::MIME::Kit::Assembler',
$manifest->{assembler} || 'Standard',
{
manifest => $manifest,
parent => $parent,
},
);
}
has default_renderer => (
reader => 'default_renderer',
writer => '_set_default_renderer',
isa => role_type('Email::MIME::Kit::Role::Renderer'),
);
has assembler => (
reader => 'assembler',
isa => role_type('Email::MIME::Kit::Role::Assembler'),
required => 1,
lazy => 1,
default => sub {
my ($self) = @_;
return $self->_assembler_from_manifest($self->manifest);
}
);
sub _generate_content_id {
Email::MessageID->new;
}
#pod =head1 AUTHOR
#pod
#pod This code was written in 2009 by Ricardo SIGNES. It was based on a previous
#pod implementation by Hans Dieter Pearcey written in 2006.
#pod
#pod The development of this code was sponsored by Pobox.com. Thanks, Pobox!
#pod
#pod =cut
no Moose::Util::TypeConstraints;
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit - build messages from templates
=head1 VERSION
version 3.000006
=head1 SYNOPSIS
use Email::MIME::Kit;
my $kit = Email::MIME::Kit->new({ source => 'mkits/sample.mkit' });
my $email = $kit->assemble({
account => $new_signup,
verification_code => $token,
... and any other template vars ...
});
$transport->send($email, { ... });
=head1 DESCRIPTION
Email::MIME::Kit is a templating system for email messages. Instead of trying
to be yet another templating system for chunks of text, it makes it easy to
build complete email messages.
It handles the construction of multipart messages, text and HTML alternatives,
attachments, interpart linking, string encoding, and parameter validation.
Although nearly every part of Email::MIME::Kit is a replaceable component, the
stock configuration is probably enough for most use. A message kit will be
stored as a directory that might look like this:
sample.mkit/
manifest.json
body.txt
body.html
logo.jpg
The manifest file tells Email::MIME::Kit how to put it all together, and might
look something like this:
{
"renderer": "TT",
"header": [
{ "From": "WY Corp <noreplies@wy.example.com>" },
{ "Subject": "Welcome aboard, [% recruit.name %]!" }
],
"alternatives": [
{ "type": "text/plain", "path": "body.txt" },
{
"type": "text/html",
"path": "body.html",
"container_type": "multipart/related",
"attachments": [ { "type": "image/jpeg", "path": "logo.jpg" } ]
}
]
}
B<Inline images> may be accessed with the function C<cid_for>, for example to include the above logo.jpg:
<img style="margin: 0 auto" src="cid:[% cid_for("logo.jpg") %]">
B<Please note:> the assembly of HTML documents as multipart/related bodies may
be simplified with an alternate assembler in the future.
The above manifest would build a multipart alternative message. GUI mail
clients would see a rendered HTML document with the logo graphic visible from
the attachment. Text mail clients would see the plaintext.
Both the HTML and text parts would be rendered using the named renderer, which
here is Template-Toolkit.
The message would be assembled and returned as an Email::MIME object, just as
easily as suggested in the L</SYNOPSIS> above.
=head1 ENCODING ISSUES
In general, "it should all just work" ... starting in version v3.
Email::MIME::Kit assumes that any file read for the purpose of becoming a
C<text/*>-type part is encoded in UTF-8. It will decode them and work with
their contents as text strings. Renderers will be passed text strings to
render, and so on. This, further, means that strings passed to the C<assemble>
method for use in rendering should also be text strings.
In older versions of Email::MIME::Kit, files read from disk were read in raw
mode and then handled as octet strings. Meanwhile, the manifest's contents
(and, thus, any templates stored as strings in the manifest) were decoded into
text strings. This could lead to serious problems. For example: the
F<manifest.json> file might contain:
"header": [
{ "Subject": "Message for [% customer_name %]" },
...
]
...while a template on disk might contain:
Dear [% customer_name %],
...
If the customer's name isn't ASCII, there was no right way to pass it in. The
template on disk would expect UTF-8, but the template in the manifest would
expect Unicode text. Users prior to v3 may have taken strange steps to get
around this problem, understanding that some templates were treated differently
than others. This means that some review of kits is in order when upgrading
from earlier versions of Email::MIME::Kit.
=head1 AUTHOR
This code was written in 2009 by Ricardo SIGNES. It was based on a previous
implementation by Hans Dieter Pearcey written in 2006.
The development of this code was sponsored by Pobox.com. Thanks, Pobox!
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 CONTRIBUTORS
=for stopwords Charlie Garrison fREW Schmidt hdp Kaitlyn Parkhurst
=over 4
=item *
Charlie Garrison <garrison@zeta.org.au>
=item *
fREW Schmidt <frioux@gmail.com>
=item *
hdp <hdp@1bcdbe44-fcfd-0310-b51b-975661d93aa0>
=item *
Kaitlyn Parkhurst <symkat@symkat.com>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

391
database/perl/vendor/lib/Email/MIME/Kit/Assembler/Standard.pm vendored Normal file
View File

@@ -0,0 +1,391 @@
package Email::MIME::Kit::Assembler::Standard;
# ABSTRACT: the standard kit assembler
$Email::MIME::Kit::Assembler::Standard::VERSION = '3.000006';
use Moose;
use Moose::Util::TypeConstraints;
#pod =head1 WARNING
#pod
#pod Email::MIME::Kit::Assembler::Standard works well, but is poorly decomposed,
#pod internally. Its methods may change substantially in the future, so relying on
#pod it as a base class is a bad idea.
#pod
#pod Because I<being able to> rely on it would be so useful, its behaviors will in
#pod the future be more reliable or factored out into roles. Until then, be
#pod careful.
#pod
#pod =cut
with 'Email::MIME::Kit::Role::Assembler';
use Email::MIME::Creator;
use Encode ();
use File::Basename;
sub BUILD {
my ($self) = @_;
$self->_setup_content_ids;
$self->_pick_and_set_renderer;
$self->_build_subassemblies;
}
has parent => (
is => 'ro',
isa => maybe_type(role_type('Email::MIME::Kit::Role::Assembler')),
weak_ref => 1,
);
has renderer => (
reader => 'renderer',
writer => '_set_renderer',
clearer => '_unset_renderer',
isa => maybe_type(role_type('Email::MIME::Kit::Role::Renderer')),
init_arg => undef,
);
sub assemble {
my ($self, $stash) = @_;
my $manifest = $self->manifest;
my $has_body = defined $manifest->{body};
my $has_path = defined $manifest->{path};
my $has_alts = @{ $manifest->{alternatives} || [] };
my $has_att = @{ $manifest->{attachments} || [] };
Carp::croak("neither body, path, nor alternatives provided")
unless $has_body or $has_path or $has_alts;
Carp::croak("you must provide only one of body, path, or alternatives")
unless (grep {$_} $has_body, $has_path, $has_alts) == 1;
my $assembly_method = $has_body ? '_assemble_from_manifest_body'
: $has_path ? '_assemble_from_kit'
: $has_alts ? '_assemble_mp_alt'
: confess "unreachable code is a mistake";
$self->$assembly_method($stash);
}
sub _assemble_from_string {
my ($self, $body, $stash) = @_;
my %attr = %{ $self->manifest->{attributes} || {} };
$attr{content_type} ||= 'text/plain';
if ($attr{content_type} =~ m{^text/}) {
# I really shouldn't have to do this, but I'm not going to go screw around
# with @#$@#$ Email::Simple/MIME just to deal with it right now. -- rjbs,
# 2009-01-19
$body .= "\x0d\x0a" unless $body =~ /[\x0d|\x0a]\z/;
}
my $body_ref = $self->render(\$body, $stash);
my $email = $self->_contain_attachments({
attributes => \%attr,
header => $self->manifest->{header},
stash => $stash,
body => $$body_ref,
container_type => $self->manifest->{container_type},
});
}
sub _assemble_from_manifest_body {
my ($self, $stash) = @_;
$self->_assemble_from_string(
$self->manifest->{body},
$stash,
);
}
sub _assemble_from_kit {
my ($self, $stash) = @_;
my $type = $self->manifest->{attributes}{content_type} || 'text/plain';
my $method = $type =~ m{^text/} ? 'get_decoded_kit_entry' : 'get_kit_entry';
my $body_ref = $self->kit->$method($self->manifest->{path});
$self->_assemble_from_string($$body_ref, $stash);
}
sub _assemble_mp_alt {
my ($self, $stash) = @_;
my %attr = %{ $self->manifest->{attributes} || {} };
$attr{content_type} = $attr{content_type} || 'multipart/alternative';
if ($attr{content_type} !~ qr{\Amultipart/alternative\b}) {
confess "illegal content_type for mail with alts: $attr{content_type}";
}
my $parts = [ map { $_->assemble($stash) } @{ $self->_alternatives } ];
my $email = $self->_contain_attachments({
attributes => \%attr,
header => $self->manifest->{header},
stash => $stash,
parts => $parts,
});
}
sub _renderer_from_override {
my ($self, $override) = @_;
# Allow an explicit undef to mean "no rendering is to be done." -- rjbs,
# 2009-01-19
return undef unless defined $override;
return $self->kit->_build_component(
'Email::MIME::Kit::Renderer',
$override,
);
}
sub _pick_and_set_renderer {
my ($self) = @_;
# "renderer" entry at top-level sets the kit default_renderer, so trying to
# look at the "renderer" entry at top-level for an override is nonsensical
# -- rjbs, 2009-01-22
unless ($self->parent) {
$self->_set_renderer($self->kit->default_renderer);
return;
}
# If there's no override, we just use the parent. We don't need to worry
# about the "there is no parent" case, because that was handled above. --
# rjbs, 2009-01-22
unless (exists $self->manifest->{renderer}) {
$self->_set_renderer($self->parent->renderer);
return;
}
my $renderer = $self->_renderer_from_override($self->manifest->{renderer});
$self->_set_renderer($renderer);
}
has manifest => (
is => 'ro',
required => 1,
);
has [ qw(_attachments _alternatives) ] => (
is => 'ro',
isa => 'ArrayRef',
init_arg => undef,
default => sub { [] },
);
has _body => (
reader => 'body',
writer => '_set_body',
);
sub _build_subassemblies {
my ($self) = @_;
if (my $body = $self->manifest->{body}) {
$self->_set_body($body);
}
for my $attach (@{ $self->manifest->{attachments} || [] }) {
my $assembler = $self->kit->_assembler_from_manifest($attach, $self);
$assembler->_set_attachment_info($attach)
if $assembler->can('_set_attachment_info');
push @{ $self->_attachments }, $assembler;
}
for my $alt (@{ $self->manifest->{alternatives} || [] }) {
push @{ $self->_alternatives },
$self->kit->_assembler_from_manifest($alt, $self);
}
}
sub _set_attachment_info {
my ($self, $manifest) = @_;
my $attr = $manifest->{attributes} ||= {};
$attr->{encoding} = 'base64' unless exists $attr->{encoding};
$attr->{disposition} = 'attachment' unless exists $attr->{disposition};
unless (exists $attr->{filename}) {
my $filename;
($filename) = File::Basename::fileparse($manifest->{path})
if $manifest->{path};
# XXX: Steal the attachment-name-generator from Email::MIME::Modifier, or
# something. -- rjbs, 2009-01-20
$filename ||= "unknown-attachment";
$attr->{filename} = $filename;
}
}
sub render {
my ($self, $input_ref, $stash) = @_;
local $stash->{cid_for} = sub { $self->cid_for_path($_[0]) };
return $input_ref unless my $renderer = $self->renderer;
return $renderer->render($input_ref, $stash);
}
sub _prep_header {
my ($self, $header, $stash) = @_;
my @done_header;
for my $entry (@$header) {
confess "no field name candidates"
unless my (@hval) = grep { /^[^:]/ } keys %$entry;
confess "multiple field name candidates: @hval" if @hval > 1;
my $value = $entry->{ $hval[ 0 ] };
if (ref $value) {
my ($v, $p) = @$value;
$value = join q{; }, $v, map { "$_=$p->{$_}" } keys %$p;
} else {
# I don't think I need to bother with $self->render, which will set up
# the cid_for callback. Honestly, who is going to be referencing a
# content-id from a header? Let's hope I never find out... -- rjbs,
# 2009-01-22
my $renderer = exists $entry->{':renderer'}
? $self->_renderer_from_override($entry->{':renderer'})
: $self->renderer;
$value = ${ $renderer->render(\$value, $stash) } if defined $renderer;
}
push @done_header, $hval[0] => $value;
}
return \@done_header;
}
sub _contain_attachments {
my ($self, $arg) = @_;
my @attachments = @{ $self->_attachments };
my $header = $self->_prep_header($arg->{header}, $arg->{stash});
my $ct = $arg->{container_type};
my %attr = %{ $arg->{attributes} };
my $body_type = 'body';
if ($attr{content_type} =~ m{^text/}) {
$body_type = 'body_str';
$attr{encoding} ||= 'quoted-printable';
$attr{charset} ||= 'UTF-8'
} elsif (($arg->{body} || '') =~ /\P{ASCII}/) {
$attr{encoding} ||= 'base64';
}
unless (@attachments) {
confess "container_type given for single-part assembly" if $ct;
return Email::MIME->create(
attributes => \%attr,
header_str => $header,
$body_type => $arg->{body},
parts => $arg->{parts},
);
}
my $email = Email::MIME->create(
attributes => \%attr,
$body_type => $arg->{body},
parts => $arg->{parts},
);
my @att_parts = map { $_->assemble($arg->{stash}) } @attachments;
my $container = Email::MIME->create(
attributes => { content_type => ($ct || 'multipart/mixed') },
header_str => $header,
parts => [ $email, @att_parts ],
);
return $container;
}
has _cid_registry => (
is => 'ro',
init_arg => undef,
default => sub { { } },
);
sub cid_for_path {
my ($self, $path) = @_;
my $cid = $self->_cid_registry->{ $path };
confess "no content-id for path $path" unless $cid;
return $cid;
}
sub _setup_content_ids {
my ($self) = @_;
for my $att (@{ $self->manifest->{attachments} || [] }) {
next unless $att->{path};
for my $header (@{ $att->{header} }) {
my ($header) = grep { /^[^:]/ } keys %$header;
Carp::croak("attachments must not supply content-id")
if lc $header eq 'content-id';
}
my $cid = $self->kit->_generate_content_id;
push @{ $att->{header} }, {
'Content-Id' => $cid->in_brackets,
':renderer' => undef,
};
$self->_cid_registry->{ $att->{path} } = $cid->as_string;
}
}
no Moose::Util::TypeConstraints;
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Assembler::Standard - the standard kit assembler
=head1 VERSION
version 3.000006
=head1 WARNING
Email::MIME::Kit::Assembler::Standard works well, but is poorly decomposed,
internally. Its methods may change substantially in the future, so relying on
it as a base class is a bad idea.
Because I<being able to> rely on it would be so useful, its behaviors will in
the future be more reliable or factored out into roles. Until then, be
careful.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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/MIME/Kit/KitReader/Dir.pm vendored Normal file
View File

@@ -0,0 +1,51 @@
package Email::MIME::Kit::KitReader::Dir;
# ABSTRACT: read kit entries out of a directory
$Email::MIME::Kit::KitReader::Dir::VERSION = '3.000006';
use Moose;
with 'Email::MIME::Kit::Role::KitReader';
use File::Spec;
# cache sometimes
sub get_kit_entry {
my ($self, $path) = @_;
my $fullpath = File::Spec->catfile($self->kit->source, $path);
open my $fh, '<:raw', $fullpath
or die "can't open $fullpath for reading: $!";
my $content = do { local $/; <$fh> };
return \$content;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::KitReader::Dir - read kit entries out of a directory
=head1 VERSION
version 3.000006
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

48
database/perl/vendor/lib/Email/MIME/Kit/ManifestReader/JSON.pm vendored Normal file
View File

@@ -0,0 +1,48 @@
package Email::MIME::Kit::ManifestReader::JSON;
# ABSTRACT: read manifest.json files
$Email::MIME::Kit::ManifestReader::JSON::VERSION = '3.000006';
use Moose;
with 'Email::MIME::Kit::Role::ManifestReader';
with 'Email::MIME::Kit::Role::ManifestDesugarer';
use JSON 2;
sub read_manifest {
my ($self) = @_;
my $json_ref = $self->kit->kit_reader->get_kit_entry('manifest.json');
my $content = JSON->new->utf8->decode($$json_ref);
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::ManifestReader::JSON - read manifest.json files
=head1 VERSION
version 3.000006
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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/MIME/Kit/ManifestReader/YAML.pm vendored Normal file
View File

@@ -0,0 +1,51 @@
package Email::MIME::Kit::ManifestReader::YAML;
# ABSTRACT: read manifest.yaml files
$Email::MIME::Kit::ManifestReader::YAML::VERSION = '3.000006';
use Moose;
with 'Email::MIME::Kit::Role::ManifestReader';
with 'Email::MIME::Kit::Role::ManifestDesugarer';
use YAML::XS ();
sub read_manifest {
my ($self) = @_;
my $yaml_ref = $self->kit->kit_reader->get_kit_entry('manifest.yaml');
# YAML::XS is documented as expecting UTF-8 bytes, which we give it.
my ($content) = YAML::XS::Load($$yaml_ref);
return $content;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::ManifestReader::YAML - read manifest.yaml files
=head1 VERSION
version 3.000006
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

118
database/perl/vendor/lib/Email/MIME/Kit/Renderer/TestRenderer.pm vendored Normal file
View File

@@ -0,0 +1,118 @@
package Email::MIME::Kit::Renderer::TestRenderer;
# ABSTRACT: extremely simple renderer for testing purposes only
$Email::MIME::Kit::Renderer::TestRenderer::VERSION = '3.000006';
use Moose;
with 'Email::MIME::Kit::Role::Renderer';
#pod =head1 WARNING
#pod
#pod Seriously, this is horrible code. If you want, look at it. It's swell for
#pod testing simple things, but if you use this for real mkits, you're going to be
#pod upset by something horrible soon.
#pod
#pod =head1 DESCRIPTION
#pod
#pod The test renderer is like a version of Template Toolkit 2 that has had a crayon
#pod shoved up its nose and into its brain. It can only do a very few things, but
#pod it does them well enough to test simple kits.
#pod
#pod Given the following template:
#pod
#pod This will say "I love pie": [% actor %] [% m_obj.verb() %] [% z_by("me") %]
#pod
#pod ...and the following set of variables:
#pod
#pod {
#pod actor => 'I',
#pod m_obj => $object_whose_verb_method_returns_love,
#pod z_by => sub { 'me' },
#pod }
#pod
#pod ..then it will be a true statement.
#pod
#pod In method calls, the parens are B<not> optional. Anything between them (or
#pod between the parens in a coderef call) is evaluated like perl code. For
#pod example, this will actually get the OS:
#pod
#pod [% z_by($^O) %]
#pod
#pod =cut
sub render {
my ($self, $content_ref, $stash) = @_;
my $output = $$content_ref;
for my $key (sort %$stash) {
$output =~
s<\[%\s+\Q$key\E(?:(?:\.(\w+))?\((.*?)\))?\s+%\]>
[ defined $2
? ($1 ? $stash->{$key}->$1(eval $2) : $stash->{$key}->(eval $2))
: $stash->{$key}
]ge;
}
return \$output;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Renderer::TestRenderer - extremely simple renderer for testing purposes only
=head1 VERSION
version 3.000006
=head1 DESCRIPTION
The test renderer is like a version of Template Toolkit 2 that has had a crayon
shoved up its nose and into its brain. It can only do a very few things, but
it does them well enough to test simple kits.
Given the following template:
This will say "I love pie": [% actor %] [% m_obj.verb() %] [% z_by("me") %]
...and the following set of variables:
{
actor => 'I',
m_obj => $object_whose_verb_method_returns_love,
z_by => sub { 'me' },
}
..then it will be a true statement.
In method calls, the parens are B<not> optional. Anything between them (or
between the parens in a coderef call) is evaluated like perl code. For
example, this will actually get the OS:
[% z_by($^O) %]
=head1 WARNING
Seriously, this is horrible code. If you want, look at it. It's swell for
testing simple things, but if you use this for real mkits, you're going to be
upset by something horrible soon.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

55
database/perl/vendor/lib/Email/MIME/Kit/Role/Assembler.pm vendored Normal file
View File

@@ -0,0 +1,55 @@
package Email::MIME::Kit::Role::Assembler;
# ABSTRACT: things that assemble messages (or parts)
$Email::MIME::Kit::Role::Assembler::VERSION = '3.000006';
use Moose::Role;
with 'Email::MIME::Kit::Role::Component';
#pod =head1 IMPLEMENTING
#pod
#pod This role also performs L<Email::MIME::Kit::Role::Component>.
#pod
#pod Classes implementing this role must provide an C<assemble> method. This method
#pod will be passed a hashref of assembly parameters, and should return the fully
#pod assembled Email::MIME object.
#pod
#pod =cut
requires 'assemble';
no Moose::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Role::Assembler - things that assemble messages (or parts)
=head1 VERSION
version 3.000006
=head1 IMPLEMENTING
This role also performs L<Email::MIME::Kit::Role::Component>.
Classes implementing this role must provide an C<assemble> method. This method
will be passed a hashref of assembly parameters, and should return the fully
assembled Email::MIME object.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

55
database/perl/vendor/lib/Email/MIME/Kit/Role/Component.pm vendored Normal file
View File

@@ -0,0 +1,55 @@
package Email::MIME::Kit::Role::Component;
# ABSTRACT: things that are kit components
$Email::MIME::Kit::Role::Component::VERSION = '3.000006';
use Moose::Role;
#pod =head1 DESCRIPTION
#pod
#pod All (or most, anyway) components of an Email::MIME::Kit will perform this role.
#pod Its primary function is to provide a C<kit> attribute that refers back to the
#pod Email::MIME::Kit into which the component was installed.
#pod
#pod =cut
has kit => (
is => 'ro',
isa => 'Email::MIME::Kit',
required => 1,
weak_ref => 1,
);
no Moose::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Role::Component - things that are kit components
=head1 VERSION
version 3.000006
=head1 DESCRIPTION
All (or most, anyway) components of an Email::MIME::Kit will perform this role.
Its primary function is to provide a C<kit> attribute that refers back to the
Email::MIME::Kit into which the component was installed.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

74
database/perl/vendor/lib/Email/MIME/Kit/Role/KitReader.pm vendored Normal file
View File

@@ -0,0 +1,74 @@
package Email::MIME::Kit::Role::KitReader;
# ABSTRACT: things that can read kit contents
$Email::MIME::Kit::Role::KitReader::VERSION = '3.000006';
use Moose::Role;
with 'Email::MIME::Kit::Role::Component';
#pod =head1 IMPLEMENTING
#pod
#pod This role also performs L<Email::MIME::Kit::Role::Component>.
#pod
#pod Classes implementing this role must provide a C<get_kit_entry> method. It will
#pod be called with one parameter, the name of a path to an entry in the kit. It
#pod should return a reference to a scalar holding the contents (as octets) of the
#pod named entry. If no entry is found, it should raise an exception.
#pod
#pod A method called C<get_decoded_kit_entry> is provided. It behaves like
#pod C<get_kit_entry>, but assumes that the entry for that name is stored in UTF-8
#pod and will decode it to text before returning.
#pod
#pod =cut
requires 'get_kit_entry';
sub get_decoded_kit_entry {
my ($self, $name) = @_;
my $content_ref = $self->get_kit_entry($name);
require Encode;
my $decoded = Encode::decode('utf-8', $$content_ref);
return \$decoded;
}
no Moose::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Role::KitReader - things that can read kit contents
=head1 VERSION
version 3.000006
=head1 IMPLEMENTING
This role also performs L<Email::MIME::Kit::Role::Component>.
Classes implementing this role must provide a C<get_kit_entry> method. It will
be called with one parameter, the name of a path to an entry in the kit. It
should return a reference to a scalar holding the contents (as octets) of the
named entry. If no entry is found, it should raise an exception.
A method called C<get_decoded_kit_entry> is provided. It behaves like
C<get_kit_entry>, but assumes that the entry for that name is stored in UTF-8
and will decode it to text before returning.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

116
database/perl/vendor/lib/Email/MIME/Kit/Role/ManifestDesugarer.pm vendored Normal file
View File

@@ -0,0 +1,116 @@
package Email::MIME::Kit::Role::ManifestDesugarer;
# ABSTRACT: helper for desugaring manifests
$Email::MIME::Kit::Role::ManifestDesugarer::VERSION = '3.000006';
use Moose::Role;
#pod =head1 IMPLEMENTING
#pod
#pod This role also performs L<Email::MIME::Kit::Role::Component>.
#pod
#pod This is a role more likely to be consumed than implemented. It wraps C<around>
#pod the C<read_manifest> method in the consuming class, and "desugars" the contents
#pod of the loaded manifest before returning it.
#pod
#pod At present, desugaring is what allows the C<type> attribute in attachments and
#pod alternatives to be given instead of a C<content_type> entry in the
#pod C<attributes> entry. In other words, desugaring turns:
#pod
#pod {
#pod header => [ ... ],
#pod type => 'text/plain',
#pod }
#pod
#pod Into:
#pod
#pod {
#pod header => [ ... ],
#pod attributes => { content_type => 'text/plain' },
#pod }
#pod
#pod More behavior may be added to the desugarer later.
#pod
#pod =cut
my $ct_desugar;
$ct_desugar = sub {
my ($self, $content) = @_;
for my $thing (qw(alternatives attachments)) {
for my $part (@{ $content->{ $thing } }) {
my $headers = $part->{header} ||= [];
if (my $type = delete $part->{type}) {
confess "specified both type and content_type attribute"
if $part->{attributes}{content_type};
$part->{attributes}{content_type} = $type;
}
$self->$ct_desugar($part);
}
}
};
around read_manifest => sub {
my ($orig, $self, @args) = @_;
my $content = $self->$orig(@args);
$self->$ct_desugar($content);
return $content;
};
no Moose::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Role::ManifestDesugarer - helper for desugaring manifests
=head1 VERSION
version 3.000006
=head1 IMPLEMENTING
This role also performs L<Email::MIME::Kit::Role::Component>.
This is a role more likely to be consumed than implemented. It wraps C<around>
the C<read_manifest> method in the consuming class, and "desugars" the contents
of the loaded manifest before returning it.
At present, desugaring is what allows the C<type> attribute in attachments and
alternatives to be given instead of a C<content_type> entry in the
C<attributes> entry. In other words, desugaring turns:
{
header => [ ... ],
type => 'text/plain',
}
Into:
{
header => [ ... ],
attributes => { content_type => 'text/plain' },
}
More behavior may be added to the desugarer later.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

55
database/perl/vendor/lib/Email/MIME/Kit/Role/ManifestReader.pm vendored Normal file
View File

@@ -0,0 +1,55 @@
package Email::MIME::Kit::Role::ManifestReader;
# ABSTRACT: things that read kit manifests
$Email::MIME::Kit::Role::ManifestReader::VERSION = '3.000006';
use Moose::Role;
with 'Email::MIME::Kit::Role::Component';
#pod =head1 IMPLEMENTING
#pod
#pod This role also performs L<Email::MIME::Kit::Role::Component>.
#pod
#pod Classes implementing this role must provide a C<read_manifest> method, which is
#pod expected to locate and read a manifest for the kit. Classes implementing this
#pod role should probably include L<Email::MIME::Kit::Role::ManifestDesugarer>, too.
#pod
#pod =cut
requires 'read_manifest';
no Moose::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Role::ManifestReader - things that read kit manifests
=head1 VERSION
version 3.000006
=head1 IMPLEMENTING
This role also performs L<Email::MIME::Kit::Role::Component>.
Classes implementing this role must provide a C<read_manifest> method, which is
expected to locate and read a manifest for the kit. Classes implementing this
role should probably include L<Email::MIME::Kit::Role::ManifestDesugarer>, too.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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/MIME/Kit/Role/Renderer.pm vendored Normal file
View File

@@ -0,0 +1,59 @@
package Email::MIME::Kit::Role::Renderer;
# ABSTRACT: things that render templates into contents
$Email::MIME::Kit::Role::Renderer::VERSION = '3.000006';
use Moose::Role;
with 'Email::MIME::Kit::Role::Component';
#pod =head1 IMPLEMENTING
#pod
#pod This role also performs L<Email::MIME::Kit::Role::Component>.
#pod
#pod Classes implementing this role must provide a C<render> method, which is
#pod expected to turn a template and arguments into rendered output. The method is
#pod used like this:
#pod
#pod my $output_ref = $renderer->render($input_ref, \%arg);
#pod
#pod =cut
requires 'render';
no Moose::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Role::Renderer - things that render templates into contents
=head1 VERSION
version 3.000006
=head1 IMPLEMENTING
This role also performs L<Email::MIME::Kit::Role::Component>.
Classes implementing this role must provide a C<render> method, which is
expected to turn a template and arguments into rendered output. The method is
used like this:
my $output_ref = $renderer->render($input_ref, \%arg);
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

60
database/perl/vendor/lib/Email/MIME/Kit/Role/Validator.pm vendored Normal file
View File

@@ -0,0 +1,60 @@
package Email::MIME::Kit::Role::Validator;
# ABSTRACT: things that validate assembly parameters
$Email::MIME::Kit::Role::Validator::VERSION = '3.000006';
use Moose::Role;
#pod =head1 IMPLEMENTING
#pod
#pod This role also performs L<Email::MIME::Kit::Role::Component>.
#pod
#pod Classes implementing this role are used to validate that the arguments passed
#pod to C<< $mkit->assemble >> are valid. Classes must provide a C<validate> method
#pod which will be called with the hashref of values passed to the kit's C<assemble>
#pod method. If the arguments are not valid for the kit, the C<validate> method
#pod should raise an exception.
#pod
#pod =cut
with 'Email::MIME::Kit::Role::Component';
requires 'validate';
no Moose::Role;
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Kit::Role::Validator - things that validate assembly parameters
=head1 VERSION
version 3.000006
=head1 IMPLEMENTING
This role also performs L<Email::MIME::Kit::Role::Component>.
Classes implementing this role are used to validate that the arguments passed
to C<< $mkit->assemble >> are valid. Classes must provide a C<validate> method
which will be called with the hashref of values passed to the kit's C<assemble>
method. If the arguments are not valid for the kit, the C<validate> method
should raise an exception.
=head1 AUTHOR
Ricardo Signes <rjbs@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2018 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

47
database/perl/vendor/lib/Email/MIME/Modifier.pm vendored Normal file
View File

@@ -0,0 +1,47 @@
use strict;
use warnings;
package Email::MIME::Modifier;
# ABSTRACT: obsolete do-nothing library
$Email::MIME::Modifier::VERSION = '1.949';
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Email::MIME::Modifier - obsolete do-nothing library
=head1 VERSION
version 1.949
=head1 AUTHORS
=over 4
=item *
Ricardo SIGNES <rjbs@cpan.org>
=item *
Casey West <casey@geeknest.com>
=item *
Simon Cozens <simon@cpan.org>
=back
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2004 by Simon Cozens and Casey West.
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