Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add support for object representation of the header value #35

Closed
wants to merge 3 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 31 additions & 2 deletions lib/Email/MIME.pm
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ use warnings;
package Email::MIME;
# ABSTRACT: easy MIME message handling

use Email::Simple 2.206; # header_raw
use Email::Simple 2.212; # nth header value
use parent qw(Email::Simple);

use Carp ();
Expand Down Expand Up @@ -141,7 +141,11 @@ sub new {

This method creates a new MIME part. The C<header_str> parameter is a list of
headers pairs to include in the message. The value for each pair is expected to
be a text string that will be MIME-encoded as needed. A similar C<header>
be a text string that will be MIME-encoded as needed. Alternatively it can be
an object with C<as_mime_string> method which implements conversion of that
object to MIME-encoded string. That object method is called with two input
parameters: charset and length of header name and should return MIME-encoded
representation of the object. A similar C<header>
parameter can be provided in addition to or instead of C<header_str>. Its
values will be used verbatim.

Expand Down Expand Up @@ -448,6 +452,11 @@ sub header_str_pairs {
$self->header_obj->header_str_pairs(@_);
}

sub header_as_obj {
my $self = shift;
$self->header_obj->header_as_obj(@_);
}

=method content_type_set

$email->content_type_set( 'text/html' );
Expand Down Expand Up @@ -875,6 +884,9 @@ This behaves like C<header_raw_set>, but expects Unicode (character) strings as
the values to set, rather than pre-encoded byte strings. It will encode them
as MIME encoded-words if they contain any control or 8-bit characters.

Alternatively, values can be objects with C<as_mime_string> method. Same as in
method C<create>.

=method header_str_pairs

my @pairs = $email->header_str_pairs;
Expand All @@ -883,6 +895,23 @@ This method behaves like C<header_raw_pairs>, returning a list of field
name/value pairs, but the values have been decoded to character strings, when
possible.

=method header_as_obj

my $first_obj = $email->header_as_obj($field);
my $nth_obj = $email->header_as_obj($field, $index);
my @all_objs = $email->header_as_obj($field);

my $nth_obj_of_class = $email->header_as_obj($field, $index, $class);
my @all_objs_of_class = $email->header_as_obj($field, undef, $class);

This method returns an object representation of the header value. It instances
new object via method C<from_mime_string> of specified class. Input argument
for that class method is list of the raw MIME-encoded values. If class argument
is not specified then class name is taken from the hash
C<%Email::MIME::Header::header_to_class_map> via key field. Use function
C<Email::MIME::Header::set_class_for_header($class, $field)> for adding new
mapping.

=method parts

This returns a list of C<Email::MIME> objects reflecting the parts of the
Expand Down
5 changes: 5 additions & 0 deletions lib/Email/MIME/Encode.pm
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ package Email::MIME::Encode;
use Email::Address;
use Encode ();
use MIME::Base64();
use Scalar::Util;

my %address_list_headers = map { $_ => undef } qw(from sender reply-to to cc bcc);
my %no_mime_headers = map { $_ => undef } qw(date message-id in-reply-to references downgraded-message-id downgraded-in-reply-to downgraded-references);
Expand All @@ -16,6 +17,10 @@ sub maybe_mime_encode_header {
$header = lc $header;

my $header_length = length($header) + length(": ");

return $val->as_mime_string($charset, $header_length)
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

A look suggests that nothing should be passing anything to maybe_mime_encode_header other than the value UTF-8. If this is the case, I think we should eliminate the argument. Header objects that know how to encode their strings should be free to pick the appropriate encoding (which imho should either be ASCII or UTF-8 and nothing else), and shouldn't have to deal with someone asking for emoji to be encoded as KOI-8.

Any reason to keep this argument?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I still see email clients or email services which do not support UTF-8, only ISO-8859-1. IIRC RFC 2047 does not require implementation to really support UTF-8, but require some ISO-8859-1 encoding.

As we know that MIME encoder and decoder in core perl (via Encode package) was terrible broken for a long time I would rather have needed functions for other encodings available. Just in case somebody needs to deal with other encoding as UTF-8 (e.g. that ISO-8859-1).

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Okay, I'm sold. Let's reverse the argument order so that it's easier to give the header length and let the encoder pick an encoding, if the client doesn't care?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Probably $header and $header_length are misleading here. $header is field name (according to RFC2822) and $header_length length of field name + 2 (for colon and space).

Purpose of passing $header_length into encoder is ability to know how many octets are already print on first line before field body. Encoder can use this information and optimize whole header to fil into less lines. But it is just optional... Email::Simple can wrap correctly field body produced by encoder...

Parameter $header_length is optional for encoder, it does not have to use it. So I put it as second argument.

On the other hand, if $charset is passed, then encoder should use it and encode field body into that charset. Therefore I think $charset is more "required" as $header_length so I put $charset before $header_length.

If you have other opinion or better idea for naming variables just propose it...

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Alright. I'm not 💯 on either ordering, so I'll go with what you have and hope that nobody uses either one of those arguments. :-)

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I've changed the code to use named arguments and avoid the whole question of order.

if Scalar::Util::blessed($val) && $val->can("as_mime_string");

my $min_wrap_length = 78 - $header_length + 1;

return $val
Expand Down
34 changes: 34 additions & 0 deletions lib/Email/MIME/Header.pm
Original file line number Diff line number Diff line change
Expand Up @@ -5,16 +5,22 @@ package Email::MIME::Header;

use parent 'Email::Simple::Header';

use Carp ();
use Email::MIME::Encode;
use Encode 1.9801;

our @CARP_NOT;

our %header_to_class_map;

=head1 DESCRIPTION

This object behaves like a standard Email::Simple header, with the following
changes:

=for :list
* the C<header> method automatically decodes encoded headers if possible
* the C<header_as_obj> method returns an object representation of the header value
* the C<header_raw> method returns the raw header; (read only for now)
* stringification uses C<header_raw> rather than C<header>

Expand Down Expand Up @@ -74,10 +80,38 @@ sub header_str_pairs {
return @pairs;
}

sub header_as_obj {
my ($self, $name, $index, $class) = @_;

$class = $header_to_class_map{lc $name} unless defined $class;

{
local @CARP_NOT = qw(Email::MIME);
Carp::croak("No class for header '$name' was specified") unless defined $class;
Carp::croak("Cannot load package '$class' for header '$name': $@") unless eval "require $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 set_class_for_header {
my ($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;