Add support for object representation of the header value

lib/Email/MIME.pm

@@ -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 ();
@@ -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.
 
@@ -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' );
@@ -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;
@@ -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

lib/Email/MIME/Encode.pm

@@ -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);
@@ -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)
+        if Scalar::Util::blessed($val) && $val->can("as_mime_string");
+
     my $min_wrap_length = 78 - $header_length + 1;
 
     return $val

lib/Email/MIME/Header.pm

@@ -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>
 
@@ -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;