use strict;
use warnings;

package Mail::Message::Body::Multipart;
our $VERSION = 2.019;  # Part of Mail::Box
use base 'Mail::Message::Body';

use Mail::Message::Body::Lines;
use Mail::Message::Part;

use Carp;
use IO::Lines;

sub init($)
{   my ($self, $args) = @_;
    $args->{mime_type} ||= 'multipart/mixed';

    $self->SUPER::init($args);

    my @parts;
    if($args->{parts})
    {   foreach my $raw (@{$args->{parts}})
        {   next unless defined $raw;
            my $cooked = Mail::Message::Part->coerce($raw, $self);

            croak 'Data not convertible to a message (type is ', ref $raw,")\n"
                unless defined $cooked;

            push @parts, $cooked;
        }
    }

    if(defined(my $based = $args->{based_on}))
    {   $self->boundary($args->{boundary} || $based->boundary);
        $self->{MMBM_preamble} = $args->{preamble} || $based->preamble;

        $self->{MMBM_parts}
            = @parts              ? \@parts
            : $based->isMultipart ? [ $based->parts('ACTIVE') ]
            : [];

        $self->{MMBM_epilogue} = $args->{epilogue} || $based->epilogue;
    }
    else
    {   $self->boundary($args->{boundary} ||$self->type->attribute('boundary'));
        $self->{MMBM_preamble} = $args->{preamble};
        $self->{MMBM_parts}    = \@parts;
        $self->{MMBM_epilogue} = $args->{epilogue};
    }

    $self;
}

sub isMultipart() {1}

# A multipart body is never binary itself.  The parts may be.
sub isBinary() {0}

sub clone()
{   my $self     = shift;
    my $preamble = $self->preamble;
    my $epilogue = $self->epilogue;

    my $body     = ref($self)->new
     ( $self->logSettings
     , based_on => $self
     , preamble => ($preamble ? $preamble->clone : undef)
     , epilogue => ($epilogue ? $epilogue->clone : undef)
     , parts    => [ map {$_->clone} $self->parts('ACTIVE') ]
     );

}

sub nrLines()
{   my $self   = shift;
    my $nr     = 1;     # trailing boundary

    if(my $preamble = $self->preamble) { $nr += $preamble->nrLines }
    $nr += 2 + $_->nrLines foreach $self->parts('ACTIVE');
    if(my $epilogue = $self->epilogue) { $nr += $epilogue->nrLines }
    $nr;
}

sub size()
{   my $self   = shift;
    my $bbytes = length($self->boundary) +3;
    $bbytes++ if $self->eol eq 'CRLF';

    my $bytes  = 0;
    if(my $preamble = $self->preamble) { $bytes += $preamble->size }
    $bytes     += $bbytes + 2;  # last boundary
    $bytes += $bbytes + 1 + $_->size foreach $self->parts('ACTIVE');
    if(my $epilogue = $self->epilogue) { $bytes += $epilogue->size }

    $bytes;
}

sub string() { join '', shift->lines }

sub lines()
{   my $self     = shift;

    my $boundary = $self->boundary;
    my @lines;

    my $preamble = $self->preamble;
    push @lines, $preamble->lines if $preamble;

    push @lines, "--$boundary\n", $_->body->lines
        foreach $self->parts('ACTIVE');

    push @lines, "\n--$boundary--\n";

    my $epilogue = $self->epilogue;
    push @lines, $epilogue->lines if $epilogue;

    wantarray ? @lines : \@lines;
}

sub file()                    # It may be possible to speed-improve the next
{   my $self   = shift;       # code, which first produces a full print of
    my @lines;                # the message in memory...
    my $dump   = IO::Lines->new(\@lines);
    $self->print($dump);
    $dump->seek(0,0);
    $dump;
}

sub print(;$)
{   my $self = shift;
    my $out  = shift || select;

    my $boundary = $self->boundary;
    if(my $preamble = $self->preamble) { $preamble->print($out) }

    foreach my $part ($self->parts('ACTIVE'))
    {   $out->print("--$boundary\n");
        $part->print($out);
        $out->print("\n");
    }

    $out->print("--$boundary--\n");
    if(my $epilogue = $self->epilogue) { $epilogue->print($out) }

    $self;
}

sub foreachComponent($)
{   my ($self, $code) = @_;
    my $changes  = 0;

    my $new_preamble;
    if(my $preamble = $self->preamble)
    {   $new_preamble = $code->($self, $preamble);
        $changes++ unless $preamble == $new_preamble;
    }

    my $new_epilogue;
    if(my $epilogue = $self->epilogue)
    {   $new_epilogue = $code->($self, $epilogue);
        $changes++ unless $epilogue == $new_epilogue;
    }

    my @new_bodies;
    foreach my $part ($self->parts('ACTIVE'))
    {   my $part_body = $part->body;
        my $new_body  = $code->($self, $part_body);

        $changes++ if $new_body != $part_body;
        push @new_bodies, [$part, $new_body];
    }

    return $self unless $changes;

    my @new_parts;
    foreach (@new_bodies)
    {   my ($part, $body) = @$_;
        my $new_part  = Mail::Message->new(head => $part->head->clone);
        $new_part->body($body);
        push @new_parts, $new_part;
    }

    (ref $self)->new
      ( preamble => $new_preamble
      , parts    => \@new_parts
      , epilogue => $new_epilogue
      , based_on => $self
      );
}

sub preamble() {shift->{MMBM_preamble}}

sub epilogue() {shift->{MMBM_epilogue}}

sub parts(;$)
{   my $self  = shift;
    return @{$self->{MMBM_parts}} unless $@;

    my $what  = shift;
    my @parts = @{$self->{MMBM_parts}};

      $what eq 'RECURSE' ? (map {$_->parts('RECURSE')} @parts)
    : $what eq 'ALL'     ? @parts
    : $what eq 'DELETED' ? (map {$_->deleted} @parts)
    : $what eq 'ACTIVE'  ? (map {not $_->deleted} @parts)
    : ref $what eq 'CODE'? (grep {$what->($_)} @parts)
    : confess "Select with what?";
}

sub part($) { shift->{MMBM_parts}[shift] }

my $unique_boundary = time;

sub boundary(;$)
{   my $self      = shift;
    my $mime      = $self->type;

    return $self->type->attribute(boundary => shift) if @_;

    my $boundary = $mime->attribute('boundary');
    return $boundary if defined $boundary;

    $self->type->attribute(boundary => "boundary-".$unique_boundary++);
}

sub check()
{   my $self = shift;
    $self->foreachComponent( sub {$_[1]->check} );
}

sub encode(@)
{   my ($self, %args) = @_;
    $self->foreachComponent( sub {$_[1]->encode(%args)} );
}

sub encoded()
{   my $self = shift;
    $self->foreachComponent( sub {$_[1]->encoded} );
}

sub attach(@)
{   my $self  = shift;
    my $new   = ref($self)->new
      ( based_on => $self
      , parts    => [$self->parts, @_]
      );
}

sub stripSignature(@)
{   my $self  = shift;

    my @allparts = $self->parts;
    my @parts    = grep {$_->body->mimeType->isSignature} @allparts;

    @allparts==@parts ? $self
    : (ref $self)->new(based_on => $self, parts => \@parts);
}

sub read($$$$)
{   my ($self, $parser, $head, $bodytype) = @_;

    my $boundary = $self->boundary;

    $parser->pushSeparator("--$boundary");
    my @msgopts  =
     ( $self->logSettings
     , head_wrap => $head->wrapLength
     );

    my @sloppyopts =
      ( mime_type         => 'text/plain'
      , transfer_encoding => ($head->get('Content-Transfer-Encoding') || undef)
      );

    # Get preamble.
    my $headtype = ref $head;

    my $begin    = $parser->filePosition;
    my $preamble = Mail::Message::Body::Lines->new(@msgopts, @sloppyopts)
       ->read($parser, $head);

    $self->{MMBM_preamble} = $preamble if defined $preamble;

    # Get the parts.

    while(my $sep = $parser->readSeparator)
    {   last if $sep eq "--$boundary--\n";

        my $part = Mail::Message::Part->new
         ( @msgopts
         , parent => $self->message
         );

        last unless $part->readFromParser($parser, $bodytype);
        push @{$self->{MMBM_parts}}, $part;
    }

    # Get epilogue

    $parser->popSeparator;
    my $epilogue = Mail::Message::Body::Lines->new(@msgopts, @sloppyopts)
      ->read($parser, $head);

    $self->{MMBM_epilogue} = $epilogue if defined $epilogue;
    $self->fileLocation($begin, $parser->filePosition);

    $self;
}

1;
