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