File Coverage

blib/lib/Mail/Message/Construct/Build.pm

Criterion	Covered	Total	%
statement	64	91	70.3
branch	28	76	36.8
condition	3	12	25.0
subroutine	11	11	100.0
pod	2	2	100.0
total	108	192	56.2

# Copyrights 2001-2022 by [Mark Overmeer ].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.03.
# This code is part of distribution Mail-Message.  Meta-POD processed with
# OODoc into POD and HTML manual-pages.  See README.md
# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.

package Mail::Message;
use vars '$VERSION';
$VERSION = '3.012';


use strict;
use warnings;

use Mail::Message::Head::Complete  ();
use Mail::Message::Body::Lines     ();
use Mail::Message::Body::Multipart ();
use Mail::Message::Body::Nested    ();
use Mail::Message::Field           ();

use Mail::Address  ();


sub build(@)
{   my $class = shift;

    if($class->isa('Mail::Box::Message'))
    {   $class->log(ERROR
           => "Only build() Mail::Message's; they are not in a folder yet");
         return undef;
    }

    my @parts
      = ! ref $_[0] ? ()
      : $_[0]->isa('Mail::Message')       ? shift
      : $_[0]->isa('Mail::Message::Body') ? shift
      :               ();

    my ($head, @headerlines);
    my ($type, $transfenc, $dispose, $descr, $cid);
    while(@_)
    {   my $key = shift;
        if(ref $key && $key->isa('Mail::Message::Field'))
        {   my $name = $key->name;
               if($name eq 'content-type')        { $type    = $key }
            elsif($name eq 'content-transfer-encoding') { $transfenc = $key }
            elsif($name eq 'content-disposition') { $dispose = $key }
            elsif($name eq 'content-description') { $descr   = $key }
            elsif($name eq 'content-id')          { $cid     = $key }
            else { push @headerlines, $key }
            next;
        }

        my $value = shift;
        next unless defined $value;

        my @data;

        if($key eq 'head')
        {   $head = $value }
        elsif($key eq 'data')
        {   @data = Mail::Message::Body->new(data => $value) }
        elsif($key eq 'file' || $key eq 'files')
        {   @data = map Mail::Message::Body->new(file => $_)
              , ref $value eq 'ARRAY' ? @$value : $value;
        }
        elsif($key eq 'attach')
        {   foreach my $c (ref $value eq 'ARRAY' ? @$value : $value)
            {   defined $c or next;
                push @data, ref $c && $c->isa('Mail::Message')
		          ? Mail::Message::Body::Nested->new(nested => $c)
                  : $c;
            }
        }
        elsif($key =~
           m/^content\-(type|transfer\-encoding|disposition|description|id)$/i )
        {   my $k     = lc $1;
            my $field = Mail::Message::Field->new($key, $value);
               if($k eq 'type')        { $type    = $field }
            elsif($k eq 'disposition') { $dispose = $field }
            elsif($k eq 'description') { $descr   = $field }
            elsif($k eq 'id')          { $cid     = $field }
            else                     { $transfenc = $field }
        }
        elsif($key =~ m/^[A-Z]/)
        {   push @headerlines, $key, $value }
        else
        {   $class->log(WARNING => "Skipped unknown key '$key' in build");
        }

        push @parts, grep defined, @data;
    }

    my $body
       = @parts==0 ? Mail::Message::Body::Lines->new()
       : @parts==1 ? $parts[0]
       : Mail::Message::Body::Multipart->new(parts => \@parts);

    # Setting the type explicitly, only after the body object is finalized
    $body->type($type)           if defined $type;
    $body->disposition($dispose) if defined $dispose;
    $body->description($descr)   if defined $descr;
    $body->contentId($cid)       if defined $cid;
    $body->transferEncoding($transfenc) if defined $transfenc;

    $class->buildFromBody($body, $head, @headerlines);
}

#------------------------------------------


sub buildFromBody(@)
{   my ($class, $body) = (shift, shift);
    my @log     = $body->logSettings;

    my $head;
    if(ref $_[0] && $_[0]->isa('Mail::Message::Head')) { $head = shift }
    else
    {   shift unless defined $_[0];   # undef as head
        $head = Mail::Message::Head::Complete->new(@log);
    }

    while(@_)
    {   if(ref $_[0]) {$head->add(shift)}
        else          {$head->add(shift, shift)}
    }

    my $message = $class->new
     ( head => $head
     , @log
     );

    $message->body($body);

    # be sure the message-id is actually stored in the header.
    $head->add('Message-Id' => '<'.$message->messageId.'>')
        unless defined $head->get('message-id');

    $head->add(Date => Mail::Message::Field->toDate)
        unless defined $head->get('Date');

    $head->add('MIME-Version' => '1.0')  # required by rfc2045
        unless defined $head->get('MIME-Version');

    $message;
}

#------------------------------------------


1;