1# Copyrights 2001-2020 by [Mark Overmeer].
2#  For other contributors see ChangeLog.
3# See the manual pages for details on the licensing terms.
4# Pod stripped from pm file by OODoc 2.02.
5# This code is part of distribution Mail-Box.  Meta-POD processed with
6# OODoc into POD and HTML manual-pages.  See README.md
7# Copyright Mark Overmeer.  Licensed under the same terms as Perl itself.
8
9package Mail::Message::Wrapper::SpamAssassin;
10use vars '$VERSION';
11$VERSION = '3.009';
12
13use base 'Mail::SpamAssassin::Message';
14
15use strict;
16use warnings;
17
18use Carp;
19use Mail::Message::Body;
20
21BEGIN
22{   my $v = $Mail::SpamAssassin::VERSION;
23    die "ERROR: spam-assassin version $v is not supported (only versions 2.x)\n"
24       if $v >= 3.0;
25}
26
27#------------------------------------------
28
29
30sub new(@)    # fix missing infra-structure of base element
31{   my ($class, $message, %args) = @_;
32
33    $_->delete for $message->head->spamGroups('SpamAssassin');
34
35    $class->SUPER::new( {message => $message} )->init(\%args);
36}
37
38sub init($) { shift }
39
40sub create_new() {croak "Should not be used"}
41
42sub get($) { $_[0]->get_header($_[1]) }
43
44sub get_header($)
45{   my ($self, $name) = @_;
46    my $head = $self->get_mail_object->head;
47
48    # Return all fields unfolded in list context
49    return map { $_->unfoldedBody } $head->get($name)
50        if wantarray;
51
52    # Only one field is expected
53    my $field = $head->get($name);
54    defined $field ? $field->unfoldedBody : undef;
55}
56
57sub get_pristine_header($)
58{   my ($self, $name) = @_;
59    my $field = $self->get_mail_object->head->get($name);
60    defined $field ? $field->foldedBody : undef;
61}
62
63sub put_header($$)
64{   my ($self, $name, $value) = @_;
65    my $head = $self->get_mail_object->head;
66    $value =~ s/\s{2,}/ /g;
67    $value =~ s/\s*$//;      # will cause a refold as well
68    return () unless length $value;
69
70    $head->add($name => $value);
71}
72
73sub get_all_headers($)
74{   my $head = shift->get_mail_object->head;
75    "$head";
76}
77
78sub replace_header($$)
79{   my $head = shift->get_mail_object->head;
80    my ($name, $value) = @_;
81    $head->set($name, $value);
82}
83
84sub delete_header($)
85{   my $head = shift->get_mail_object->head;
86    my $name = shift;
87    $head->delete($name);
88}
89
90sub get_body() {shift->get_mail_object->body->lines }
91
92sub get_pristine() { shift->get_mail_object->head->string }
93
94sub replace_body($)
95{   my ($self, $data) = @_;
96    my $body = Mail::Message::Body->new(data => $data);
97    $self->get_mail_object->storeBody($body);
98}
99
100sub replace_original_message($)
101{   my ($self, $lines) = @_;
102    die "We will not replace the message.  Use report_safe = 0\n";
103}
104
1051;
106