Initial Commit
This commit is contained in:
Riley Schneider
507
database/perl/vendor/lib/Email/MIME/Header/AddressList.pm
vendored
Normal file
507
database/perl/vendor/lib/Email/MIME/Header/AddressList.pm
vendored
Normal 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
|
||||
Reference in New Issue
Block a user