#oodist: *** DO NOT USE THIS VERSION FOR PRODUCTION ***
#oodist: This file contains OODoc-style documentation which will get stripped
#oodist: during its release in the distribution.  You can use this file for
#oodist: testing, however the code of this development version may be broken!

package Mail::Box::Parser::Lines;
use parent 'Mail::Box::Parser';

use strict;
use warnings;

use Log::Report   'mail-message', import => [ qw/__x panic warning/ ];

use Mail::Message::Field   ();

#--------------------
=chapter NAME

Mail::Box::Parser::Lines - reading messages from file using Perl

=chapter SYNOPSIS

=chapter DESCRIPTION

This C<Mail::Box::Parser::Lines> implements parsing of messages
in Perl, with an ARRAY as source.

B<Hint:>
Useful when the message is already in memory.  When you plan to use this
yourself, you probably need to use Mail::Message::Construct::Read.

=chapter METHODS

=c_method new %options
=requires lines \@lines
=requires source $name
=cut

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

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

#--------------------
=section Attributes

=method lines
Returns an ARRAY with the remaining lines.

=method source
The name of the source.
=cut

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

#--------------------
=section Parsing

=method readHeader
=warning unexpected end of header in $source:\n $line
=cut

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)
		{	warning __x"unexpected end of header in {source}:\n {line}", source => $self->source, line => $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;   # remove \r, keep \n
	}

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