File Coverage

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


line stmt bran cond sub pod time code
1             # Copyrights 2001-2021 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-Message. 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              
9             package Mail::Message::TransferEnc::EightBit;
10 8     8   1645 use vars '$VERSION';
  8         20  
  8         546  
11             $VERSION = '3.011';
12              
13 8     8   54 use base 'Mail::Message::TransferEnc';
  8         21  
  8         3622  
14              
15 8     8   57 use strict;
  8         18  
  8         156  
16 8     8   45 use warnings;
  8         19  
  8         2348  
17              
18              
19             sub name() { '8bit' }
20              
21             #------------------------------------------
22              
23             sub check($@)
24 0     0 1 0 { my ($self, $body, %args) = @_;
25 0         0 $body;
26             }
27              
28             #------------------------------------------
29              
30             sub decode($@)
31 6     6 1 23 { my ($self, $body, %args) = @_;
32 6         27 $body->transferEncoding('none');
33 6         19 $body;
34             }
35              
36             #------------------------------------------
37              
38             sub encode($@)
39 30     30 1 132 { my ($self, $body, %args) = @_;
40              
41 30         58 my @lines;
42 30         67 my $changes = 0;
43              
44 30         134 foreach ($body->lines)
45 102 100       287 { $changes++ if s/[\000\013]//g;
46              
47             # there shouldn't be any NL inside a line.
48 102 50       213 $changes++ if length > 997;
49 102         214 push @lines, substr($_, 0, 996, '')."\n"
50             while length > 997;
51              
52 102         235 push @lines, $_;
53             }
54              
55 30 100       92 unless($changes)
56 29         119 { $body->transferEncoding('8bit');
57 29         109 return $body;
58             }
59              
60 1   33     9 my $bodytype = $args{result_type} || ref $body;
61              
62 1         5 $bodytype->new
63             ( based_on => $body
64             , transfer_encoding => '8bit'
65             , data => \@lines
66             );
67             }
68              
69             #------------------------------------------
70              
71             1;