File Coverage

blib/lib/MIME/Decoder/Base64.pm
Criterion Covered Total %
statement 45 45 100.0
branch 4 6 66.6
condition 2 2 100.0
subroutine 8 8 100.0
pod 2 2 100.0
total 61 63 96.8


line stmt bran cond sub pod time code
1             package MIME::Decoder::Base64;
2 10     10   151 use strict;
  10         11  
  10         280  
3 10     10   35 use warnings;
  10         12  
  10         401  
4              
5              
6             =head1 NAME
7              
8             MIME::Decoder::Base64 - encode/decode a "base64" stream
9              
10              
11             =head1 SYNOPSIS
12              
13             A generic decoder object; see L for usage.
14              
15              
16             =head1 DESCRIPTION
17              
18             A L subclass for the C<"base64"> encoding.
19             The name was chosen to jibe with the pre-existing MIME::Base64
20             utility package, which this class actually uses to translate each chunk.
21              
22             =over 4
23              
24             =item *
25              
26             When B, the input is read one line at a time.
27             The input accumulates in an internal buffer, which is decoded in
28             multiple-of-4-sized chunks (plus a possible "leftover" input chunk,
29             of course).
30              
31             =item *
32              
33             When B, the input is read 45 bytes at a time: this ensures
34             that the output lines are not too long. We chose 45 since it is
35             a multiple of 3 and produces lines under 76 characters, as RFC 2045
36             specifies:
37             The encoded output stream must be represented in lines of no more
38             than 76 characters each.
39              
40             =back
41              
42             =head1 SEE ALSO
43              
44             L
45              
46             =head1 AUTHOR
47              
48             Eryq (F), ZeeGee Software Inc (F).
49              
50             All rights reserved. This program is free software; you can redistribute
51             it and/or modify it under the same terms as Perl itself.
52              
53             =cut
54              
55 10     10   163 use vars qw(@ISA $VERSION);
  10         12  
  10         466  
56 10     10   39 use MIME::Decoder;
  10         13  
  10         252  
57 10     10   37 use MIME::Base64 2.04;
  10         282  
  10         581  
58 10     10   41 use MIME::Tools qw(debug);
  10         12  
  10         3450  
59              
60             @ISA = qw(MIME::Decoder);
61              
62             ### The package version, both in 1.23 style *and* usable by MakeMaker:
63             $VERSION = "5.509";
64              
65             ### How many bytes to encode at a time (must be a multiple of 3, and
66             ### less than (76 * 0.75)!
67             my $EncodeChunkLength = 45;
68              
69             ### How many bytes to decode at a time?
70             my $DecodeChunkLength = 32 * 1024;
71              
72             #------------------------------
73             #
74             # decode_it IN, OUT
75             #
76             sub decode_it {
77 37     37 1 822 my ($self, $in, $out) = @_;
78 37         33 my $len_4xN;
79            
80             ### Create a suitable buffer:
81 37         578 my $buffer = ' ' x (120 + $DecodeChunkLength); $buffer = '';
  37         45  
82 37         167 debug "in = $in; out = $out";
83              
84             ### Get chunks until done:
85 37         373 local($_) = ' ' x $DecodeChunkLength;
86 37         120 while ($in->read($_, $DecodeChunkLength)) {
87 38         652 tr{A-Za-z0-9+/}{}cd; ### get rid of non-base64 chars
88              
89             ### Concat any new input onto any leftover from the last round:
90 38         77 $buffer .= $_;
91 38 100       110 length($buffer) >= $DecodeChunkLength or next;
92            
93             ### Extract substring with highest multiple of 4 bytes:
94             ### 0 means not enough to work with... get more data!
95 1         3 $len_4xN = length($buffer) & ~3;
96              
97             ### Partition into largest-multiple-of-4 (which we decode),
98             ### and the remainder (which gets handled next time around):
99 1         116 $out->print(decode_base64(substr($buffer, 0, $len_4xN)));
100 1         27 $buffer = substr($buffer, $len_4xN);
101             }
102            
103             ### No more input remains. Dispose of anything left in buffer:
104 37 50       192 if (length($buffer)) {
105              
106             ### Pad to 4-byte multiple, and decode:
107 37         38 $buffer .= "==="; ### need no more than 3 pad chars
108 37         53 $len_4xN = length($buffer) & ~3;
109              
110             ### Decode it!
111 37         474 $out->print(decode_base64(substr($buffer, 0, $len_4xN)));
112             }
113 37         424 1;
114             }
115              
116             #------------------------------
117             #
118             # encode_it IN, OUT
119             #
120             sub encode_it {
121 10     10 1 20 my ($self, $in, $out) = @_;
122 10         11 my $encoded;
123              
124             my $nread;
125 10         16 my $buf = '';
126 10   100     42 my $nl = $MIME::Entity::BOUNDARY_DELIMITER || "\n";
127 10         47 while ($nread = $in->read($buf, $EncodeChunkLength)) {
128 568         3590 $encoded = encode_base64($buf, $nl);
129 568 50       1689 $encoded .= $nl unless ($encoded =~ /$nl\Z/); ### ensure newline!
130 568         908 $out->print($encoded);
131             }
132 10         140 1;
133             }
134              
135             #------------------------------
136             1;
137