# Copyrights 2001-2025 by [Mark Overmeer <markov@cpan.org>].
#  For other contributors see ChangeLog.
# See the manual pages for details on the licensing terms.
# Pod stripped from pm file by OODoc 2.02.
# 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::Box::Parser::Lines;
use vars '$VERSION';
$VERSION = '3.018_001';

use base 'Mail::Box::Parser';

use strict;
use warnings;

use Mail::Message::Field;


sub init(@)
{   my ($self, $args) = @_;
    $self->SUPER::init($args) or return;

	$self->{MBPL_lines}  = $args->{lines}  or die "No lines";
	$self->{MBPL_source} = $args->{source} or die "No source";
    $self;
}

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

sub lines()  { $_[0]->{MBPL_lines} }
sub source() { $_[0]->{MBPL_source} }

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

my $is_empty_line = qr/^\015?\012?$/;

sub readHeader()
{   my $self  = shift;
    my $lines = $self->lines;
	my @ret;

  LINE:
    while(@$lines)
    {   my $line = shift @$lines;
        last if $line =~ $is_empty_line;

        my ($name, $body) = split /\s*\:\s*/, $line, 2;

        unless(defined $body)
        {   $self->log(WARNING => "Unexpected end of header in ".$self->source.":\n $line");

            if(@ret && $self->fixHeaderErrors)
            {   $ret[-1][1] .= ' '.$line;  # glue err line to previous field
                next LINE;
            }

            unshift @$lines, $line;
            last LINE;
        }

        # Collect folded lines
        $body .= shift @$lines
            while @$lines && $lines->[0] =~ m!^[ \t]!;

        push @ret, [ $name, $body ];
    }

    (undef, undef, @ret);
}

sub _is_good_end()
{   my $self  = shift;

    # No seps, then when have to trust it.
    my $sep = $self->activeSeparator // return 1;

    # Find first non-empty line on specified location.
	my $lines = $self->lines;
    my $skip  = 0;
    while($skip < @$lines && $lines->[$skip] =~ $is_empty_line) { $skip++ }
	$skip < @$lines or return 1;

	my $line = $lines->[$skip];

        substr($line, 0, length $sep) eq $sep
    && ($sep ne 'From ' || $line =~ m/ (?:19[6-9]|20[0-3])[0-9]\b/ );
}

sub readSeparator()
{   my $self  = shift;
    my $sep   = $self->activeSeparator // return ();
	my $lines = $self->lines;

    my $skip  = 0;
    while($skip < @$lines && $lines->[$skip] =~ $is_empty_line) { $skip++ }

	$skip < @$lines
        or return ();

    my $line  = $lines->[$skip];
    substr($line, 0, length $sep) eq $sep
        or return ();

	splice @$lines, 0, $skip+1;
    (undef, $line);
}

sub _read_stripped_lines(;$$)
{   my ($self, $exp_chars, $exp_lines) = @_;
    my $seps    = $self->separators;
	my $lines   = $self->lines;
    my $take    = [];

    if(@$seps)
    {   
      LINE:
        while(1)
        {   my $line  = shift @$lines or last LINE;

            foreach my $sep (@$seps)
            {   substr($line, 0, length $sep) eq $sep or next;

                # Some apps fail to escape take starting with From
                next if $sep eq 'From ' && $line !~ m/ 19[789][0-9]| 20[0-9][0-9]/;

				unshift @$lines, $line;   # keep separator
                last LINE;
            }

            push @$take, $line;
        }

        if(@$take && $take->[-1] =~ s/\015?\012\z//)
        {   # Keep an empty line to signal the existence of a preamble, but
            # remove a second.
            pop @$take if @$seps==1 && @$take > 1 && length($take->[-1])==0;
        }
    }
    else # File without separators.
    {   $take = $lines;
    }

    if($self->stripGt)
    {   s/^\>(\>*From\s)/$1/ for @$take;
    }

    unless($self->trusted)
    {   s/\015// for @$take;
    }

    $take;
}

sub bodyAsString(;$$)
{   my ($self, $exp_chars, $exp_lines) = @_;
    my $take = $self->_read_stripped_lines($exp_chars, $exp_lines);
    return (undef, undef, join('', @$take));
}

sub bodyAsList(;$$)
{   my ($self, $exp_chars, $exp_lines) = @_;
    my $take = $self->_read_stripped_lines($exp_chars, $exp_lines);
    (undef, undef, $take);
}

sub bodyAsFile($;$$)
{   my ($self, $out, $exp_chars, $exp_lines) = @_;
    my $take = $self->_read_stripped_lines($exp_chars, $exp_lines);
    $out->print($_) for @$take;
    (undef, undef, scalar @$take);
}

1;
