1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
# This code is part of Perl distribution Mail-Message version 3.019.
# The POD got stripped from this file by OODoc version 3.05.
# For contributors see file ChangeLog.
# This software is copyright (c) 2001-2025 by Mark Overmeer.
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
# SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
package Mail::Message;{
our $VERSION = '3.019';
}
use strict;
use warnings;
use Mail::Box::Parser::Lines ();
use Scalar::Util qw/blessed/;
#--------------------
sub _scalar2lines($)
{ my $lines = [ split /^/, ${$_[0]} ];
# pop @$lines if @$lines && ! length $lines->[-1];
$lines;
}
sub read($@)
{ # try avoiding copy of large strings
my ($class, undef, %args) = @_;
my $trusted = exists $args{trusted} ? $args{trusted} : 1;
my $strip_status = exists $args{strip_status_fields} ? delete $args{strip_status_fields} : 1;
my $body_type = $args{body_type};
my $pclass = $args{parser_class};
my $parser;
my $ref = ref $_[1];
if($args{seekable})
{ $parser = ($pclass // 'Mail::Box::Parser::Perl')
->new(%args, filename => "file ($ref)", file => $_[1], trusted => $trusted);
}
else
{ my ($source, $lines);
if(!$ref)
{ $source = 'scalar';
$lines = _scalar2lines \$_[1];
}
elsif($ref eq 'SCALAR')
{ $source = 'ref scalar';
$lines = _scalar2lines $_[1];
}
elsif($ref eq 'ARRAY')
{ $source = 'array of lines';
$lines = $_[1];
}
elsif($ref eq 'GLOB' || (blessed $_[1] && $_[1]->isa('IO::Handle')))
{ $source = "file ($ref)";
local $/ = undef; # slurp
$lines = _scalar2lines \$_[1]->getline;
}
else
{ $class->log(ERROR => "Cannot read message from $_[1]/$ref");
return undef;
}
$parser = ($pclass // 'Mail::Box::Parser::Lines')
->new(%args, source => $source, lines => $lines, trusted => $trusted);
$body_type = 'Mail::Message::Body::Lines';
}
my $self = $class->new(%args);
$self->readFromParser($parser, $body_type);
$self->addReport($parser);
$parser->stop;
my $head = $self->head;
$head->get('Message-ID')
or $head->set('Message-ID' => '<'.$self->messageId.'>');
$head->delete('Status', 'X-Status')
if $strip_status;
$self;
}
1;
|
