package MIME::Parser::Reader;
=head1 NAME
MIME::Parser::Reader - a line-oriented reader for a MIME::Parser
=head1 SYNOPSIS
This module is used internally by MIME::Parser; you probably
don't need to be looking at it at all. But just in case...
### Create a top-level reader, where chunks end at EOF:
$rdr = MIME::Parser::Reader->new();
### Spawn a child reader, where chunks also end at a boundary:
$subrdr = $rdr->spawn->add_boundary($bound);
### Spawn a child reader, where chunks also end at a given string:
$subrdr = $rdr->spawn->add_terminator($string);
### Read until boundary or terminator:
$subrdr->read_chunk($in, $out);
=head1 DESCRIPTION
A line-oriented reader which can deal with virtual end-of-stream
defined by a collection of boundaries.
B<Warning:> this is a private class solely for use by MIME::Parser.
This class has no official public interface
=cut
use strict;
use IO::ScalarArray;
my @EOLs = ("", "\r", "\n", "\r\n", "\n\r");
my $LONGLINE = ' ' x 1000;
sub new {
my ($class) = @_;
my $eos;
return bless {
Bounds => [],
BH => {},
TH => {},
EOS => \$eos,
}, $class;
}
sub spawn {
my $self = shift;
my $dup = bless {}, ref($self);
$dup->{Bounds} = [ @{$self->{Bounds}} ]; $dup->{BH} = { %{$self->{BH}} }; $dup->{TH} = { %{$self->{TH}} }; $dup->{EOS} = $self->{EOS}; $dup;
}
sub add_boundary {
my ($self, $bound) = @_;
unshift @{$self->{Bounds}}, $bound; $self->{BH}{"--$bound"} = "DELIM $bound";
$self->{BH}{"--$bound--"} = "CLOSE $bound";
$self;
}
sub add_terminator {
my ($self, $line) = @_;
foreach (@EOLs) {
$self->{TH}{"$line$_"} = "DONE $line";
}
$self;
}
sub has_bounds {
scalar(@{shift->{Bounds}});
}
sub depth {
scalar(@{shift->{Bounds}});
}
sub eos {
my $self = shift;
${$self->{EOS}} = $_[0] if @_;
${$self->{EOS}};
}
sub eos_type {
my ($self, $eos) = @_;
$eos = $self->eos if (@_ == 1);
if ($eos =~ /^(DONE|EOF)/) {
return $1;
}
elsif ($eos =~ /^(DELIM|CLOSE) (.*)$/) {
return (($2 eq $self->{Bounds}[0]) ? $1 : 'EXT');
}
else {
die("internal error: unable to classify boundary token ($eos)");
}
}
sub native_handle {
my $fh = shift;
return $fh if $fh->isa('IO::File');
return $$fh if ($fh->isa('IO::Wrap') && (ref($$fh) eq 'GLOB'));
undef;
}
sub read_chunk {
my ($self, $in, $out) = @_;
my %bh = %{$self->{BH}};
my %th = %{$self->{TH}}; my $thx = keys %th;
local $_ = $LONGLINE;
my $maybe;
my $last = '';
my $eos = '';
my $n_in = native_handle($in);
my $n_out = native_handle($out);
if ($n_in) {
if ($n_out) { while (<$n_in>) {
if (substr($_, 0, 2) eq '--') {
($maybe = $_) =~ s/[ \t\r\n]+\Z//;
$bh{$maybe} and do { $eos = $bh{$maybe}; last };
}
$thx and $th{$_} and do { $eos = $th{$_}; last };
print $n_out $last; $last = $_;
}
}
else { while (<$n_in>) {
if (substr($_, 0, 2) eq '--') {
($maybe = $_) =~ s/[ \t\r\n]+\Z//;
$bh{$maybe} and do { $eos = $bh{$maybe}; last };
}
$thx and $th{$_} and do { $eos = $th{$_}; last };
$out->print($last); $last = $_;
}
}
}
else {
if ($n_out) { while (defined($_ = $in->getline)) {
if (substr($_, 0, 2) eq '--') {
($maybe = $_) =~ s/[ \t\r\n]+\Z//;
$bh{$maybe} and do { $eos = $bh{$maybe}; last };
}
$thx and $th{$_} and do { $eos = $th{$_}; last };
print $n_out $last; $last = $_;
}
}
else { while (defined($_ = $in->getline)) {
if (substr($_, 0, 2) eq '--') {
($maybe = $_) =~ s/[ \t\r\n]+\Z//;
$bh{$maybe} and do { $eos = $bh{$maybe}; last };
}
$thx and $th{$_} and do { $eos = $th{$_}; last };
$out->print($last); $last = $_;
}
}
}
$last =~ s/[\r\n]+\Z// if ($eos =~ /^(DELIM|CLOSE)/);
$out->print($last);
${$self->{EOS}} = ($eos || 'EOF');
1;
}
sub read_lines {
my ($self, $in, $outlines) = @_;
$self->read_chunk($in, IO::ScalarArray->new($outlines));
shift @$outlines if ($outlines->[0] eq ''); 1;
}
1;
__END__