File Coverage

blib/lib/Mail/Message/TransferEnc/Binary.pm
Criterion Covered Total %
statement 12 28 42.8
branch 0 4 0.0
condition 0 3 0.0
subroutine 4 7 57.1
pod 3 3 100.0
total 19 45 42.2


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::Binary;{
13             our $VERSION = '4.04';
14             }
15              
16 1     1   1443 use parent 'Mail::Message::TransferEnc';
  1         2  
  1         9  
17              
18 1     1   121 use strict;
  1         4  
  1         30  
19 1     1   5 use warnings;
  1         3  
  1         65  
20              
21 1     1   7 use Log::Report 'mail-message', import => [ qw// ];
  1         2  
  1         10  
22              
23             #--------------------
24              
25             sub name() { 'binary' }
26              
27             sub check($@)
28 0     0 1   { my ($self, $body, %args) = @_;
29 0           $body;
30             }
31              
32             sub decode($@)
33 0     0 1   { my ($self, $body, %args) = @_;
34 0           $body->transferEncoding('none');
35 0           $body;
36             }
37              
38             sub encode($@)
39 0     0 1   { my ($self, $body, %args) = @_;
40 0           my @lines;
41              
42 0           my $changes = 0;
43 0           foreach ($body->lines)
44 0 0         { $changes++ if s/[\000\013]//g;
45 0           push @lines, $_;
46             }
47              
48 0 0         unless($changes)
49 0           { $body->transferEncoding('none');
50 0           return $body;
51             }
52              
53 0   0       my $bodytype = $args{result_type} || ref($self->load);
54 0           $bodytype->new(based_on => $body, transfer_encoding => 'none', data => \@lines);
55             }
56              
57             1;