Server IP : 85.214.239.14 / Your IP : 3.145.80.247 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /proc/3/root/proc/2/cwd/usr/share/perl5/Email/MIME/Header/ |
Upload File : |
# Copyright (c) 2016-2017 by Pali <pali@cpan.org> package Email::MIME::Header::AddressList 1.953; # ABSTRACT: MIME support for list of Email::Address::XS objects use v5.12.0; use warnings; use Carp (); use Email::Address::XS; use Email::MIME::Encode; #pod =encoding utf8 #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 - MIME support for list of Email::Address::XS objects =head1 VERSION version 1.953 =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 PERL VERSION This library should run on perls released even a long time ago. It should work on any version of perl released in the last five years. Although it may work on older versions of perl, no guarantee is made that the minimum required version will not be increased. The version may be increased for any reason, and there is no promise that patches will be accepted to lower the minimum required perl. =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 <cpan@semiotic.systems> =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