File Coverage

blib/lib/Mail/Message/TransferEnc/Base64.pm
Criterion Covered Total %
statement 23 27 85.1
branch 1 2 50.0
condition 4 6 66.6
subroutine 7 8 87.5
pod 3 3 100.0
total 38 46 82.6


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::Base64;{
13             our $VERSION = '4.04';
14             }
15              
16 5     5   2801 use parent 'Mail::Message::TransferEnc';
  5         12  
  5         49  
17              
18 5     5   361 use strict;
  5         11  
  5         164  
19 5     5   28 use warnings;
  5         11  
  5         396  
20              
21 5     5   30 use Log::Report 'mail-message', import => [ qw/warning/ ];
  5         11  
  5         41  
22              
23 5     5   2032 use MIME::Base64 qw/decode_base64 encode_base64/;
  5         1708  
  5         2060  
24              
25             #--------------------
26              
27             sub name() { 'base64' }
28              
29             sub check($@)
30 0     0 1 0 { my ($self, $body, %args) = @_;
31 0         0 $body;
32             }
33              
34              
35             sub decode($@)
36 2     2 1 44 { my ($self, $body, %args) = @_;
37              
38 2         16 my $lines = decode_base64($body->string);
39 2 50       12 unless($lines)
40 0         0 { $body->transferEncoding('none');
41 0         0 return $body;
42             }
43              
44 2   66     28 my $bodytype = $args{result_type} || ($body->isBinary ? 'Mail::Message::Body::File' : ref $body);
45 2         44 $bodytype->new(based_on => $body, transfer_encoding => 'none', data => $lines);
46             }
47              
48             sub encode($@)
49 4     4 1 2441 { my ($self, $body, %args) = @_;
50 4   66     32 my $bodytype = $args{result_type} || ref $body;
51              
52 4         34 $bodytype->new(
53             based_on => $body,
54             checked => 1,
55             transfer_encoding => 'base64',
56             data => encode_base64($body->string),
57             );
58             }
59              
60             1;