File Coverage

blib/lib/MIME/Decoder/Base64.pm
Criterion Covered Total %
statement 44 44 100.0
branch 4 6 66.6
condition n/a
subroutine 8 8 100.0
pod 2 2 100.0
total 58 60 96.6


line stmt bran cond sub pod time code
1             package MIME::Decoder::Base64;
2 8     8   30 use strict;
  8         9  
  8         212  
3 8     8   27 use warnings;
  8         8  
  8         285  
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 8     8   130 use vars qw(@ISA $VERSION);
  8         15  
  8         351  
56 8     8   28 use MIME::Decoder;
  8         20  
  8         161  
57 8     8   37 use MIME::Base64 2.04;
  8         166  
  8         404  
58 8     8   30 use MIME::Tools qw(debug);
  8         10  
  8         2586  
59              
60             @ISA = qw(MIME::Decoder);
61              
62             ### The package version, both in 1.23 style *and* usable by MakeMaker:
63             $VERSION = "5.508";
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 36     36 1 40 my ($self, $in, $out) = @_;
78 36         32 my $len_4xN;
79            
80             ### Create a suitable buffer:
81 36         510 my $buffer = ' ' x (120 + $DecodeChunkLength); $buffer = '';
  36         37  
82 36         132 debug "in = $in; out = $out";
83              
84             ### Get chunks until done:
85 36         339 local($_) = ' ' x $DecodeChunkLength;
86 36         103 while ($in->read($_, $DecodeChunkLength)) {
87 37         893 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 37         81 $buffer .= $_;
91 37 100       130 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         2 $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         120 $out->print(decode_base64(substr($buffer, 0, $len_4xN)));
100 1         23 $buffer = substr($buffer, $len_4xN);
101             }
102            
103             ### No more input remains. Dispose of anything left in buffer:
104 36 50       191 if (length($buffer)) {
105              
106             ### Pad to 4-byte multiple, and decode:
107 36         42 $buffer .= "==="; ### need no more than 3 pad chars
108 36         44 $len_4xN = length($buffer) & ~3;
109              
110             ### Decode it!
111 36         378 $out->print(decode_base64(substr($buffer, 0, $len_4xN)));
112             }
113 36         353 1;
114             }
115              
116             #------------------------------
117             #
118             # encode_it IN, OUT
119             #
120             sub encode_it {
121 8     8 1 14 my ($self, $in, $out) = @_;
122 8         10 my $encoded;
123              
124             my $nread;
125 8         12 my $buf = '';
126 8         31 while ($nread = $in->read($buf, $EncodeChunkLength)) {
127 545         3181 $encoded = encode_base64($buf);
128 545 50       1057 $encoded .= "\n" unless ($encoded =~ /\n\Z/); ### ensure newline!
129 545         702 $out->print($encoded);
130             }
131 8         102 1;
132             }
133              
134             #------------------------------
135             1;
136