File Coverage

blib/lib/Mail/Message/TransferEnc/EightBit.pm
Criterion Covered Total %
statement 30 30 100.0
branch 5 6 83.3
condition 1 3 33.3
subroutine 7 7 100.0
pod 3 3 100.0
total 46 49 93.8


line stmt bran cond sub pod time code
1             # This code is part of Perl distribution Mail-Message version 4.04.
2             # The POD got stripped from this file by OODoc version 3.06.
3             # For contributors see file ChangeLog.
4              
5             # This software is copyright (c) 2001-2026 by Mark Overmeer.
6              
7             # This is free software; you can redistribute it and/or modify it under
8             # the same terms as the Perl 5 programming language system itself.
9             # SPDX-License-Identifier: Artistic-1.0-Perl OR GPL-1.0-or-later
10              
11              
12             package Mail::Message::TransferEnc::EightBit;{
13             our $VERSION = '4.04';
14             }
15              
16 8     8   2104 use parent 'Mail::Message::TransferEnc';
  8         17  
  8         68  
17              
18 8     8   510 use strict;
  8         18  
  8         211  
19 8     8   37 use warnings;
  8         16  
  8         452  
20              
21 8     8   40 use Log::Report 'mail-message', import => [ qw// ];
  8         16  
  8         47  
22              
23             #--------------------
24              
25             sub name() { '8bit' }
26              
27             sub check($@)
28 1     1 1 4 { my ($self, $body, %args) = @_;
29 1         6 $body;
30             }
31              
32             sub decode($@)
33 7     7 1 32 { my ($self, $body, %args) = @_;
34 7         32 $body->transferEncoding('none');
35 7         28 $body;
36             }
37              
38             sub encode($@)
39 32     32 1 306 { my ($self, $body, %args) = @_;
40              
41 32         64 my @lines;
42 32         71 my $changes = 0;
43              
44 32         400 foreach ($body->lines)
45 111 100       358 { $changes++ if s/[\000\013]//g;
46              
47             # there shouldn't be any NL inside a line.
48 111 50       247 $changes++ if length > 997;
49 111         244 push @lines, substr($_, 0, 996, '')."\n"
50             while length > 997;
51              
52 111         238 push @lines, $_;
53             }
54              
55 32 100       106 unless($changes)
56 31         120 { $body->transferEncoding('8bit');
57 31         166 return $body;
58             }
59              
60 1   33     18 my $bodytype = $args{result_type} || ref $body;
61 1         7 $bodytype->new(based_on => $body, transfer_encoding => '8bit', data => \@lines);
62             }
63              
64             1;