This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Be more clear. Use simple words.
[perl5.git] / ext / MIME / Base64 / Base64.pm
CommitLineData
6fba102d 1#
691d66bd 2# $Id: Base64.pm,v 2.37 2004/01/08 14:07:26 gisle Exp $
6fba102d
JH
3
4package MIME::Base64;
5
6=head1 NAME
7
8MIME::Base64 - Encoding and decoding of base64 strings
9
10=head1 SYNOPSIS
11
12 use MIME::Base64;
13
14 $encoded = encode_base64('Aladdin:open sesame');
15 $decoded = decode_base64($encoded);
16
17=head1 DESCRIPTION
18
691d66bd
RGS
19This module provides functions to encode and decode strings into and from the
20base64 encoding specified in RFC 2045 - I<MIME (Multipurpose Internet
21Mail Extensions)>. The base64 encoding is designed to represent
6fba102d
JH
22arbitrary sequences of octets in a form that need not be humanly
23readable. A 65-character subset ([A-Za-z0-9+/=]) of US-ASCII is used,
24enabling 6 bits to be represented per printable character.
25
26The following functions are provided:
27
28=over 4
29
6a63fb82
AMS
30=item encode_base64($str)
31
32=item encode_base64($str, $eol);
6fba102d
JH
33
34Encode data by calling the encode_base64() function. The first
691d66bd
RGS
35argument is the string to encode. The second argument is the
36line-ending sequence to use. It is optional and defaults to "\n". The
6fba102d
JH
37returned encoded string is broken into lines of no more than 76
38characters each and it will end with $eol unless it is empty. Pass an
39empty string as second argument if you do not want the encoded string
691d66bd 40to be broken into lines.
6fba102d
JH
41
42=item decode_base64($str)
43
44Decode a base64 string by calling the decode_base64() function. This
45function takes a single argument which is the string to decode and
46returns the decoded data.
47
691d66bd
RGS
48Any character not part of the 65-character base64 subset is
49silently ignored. Characters occurring after a '=' padding character
6fba102d
JH
50are never decoded.
51
8be5f608 52If the length of the string to decode, after ignoring
691d66bd 53non-base64 chars, is not a multiple of 4 or if padding occurs too early,
6fba102d
JH
54then a warning is generated if perl is running under C<-w>.
55
56=back
57
691d66bd 58If you prefer not to import these routines into your namespace, you can
6fba102d
JH
59call them as:
60
61 use MIME::Base64 ();
62 $encoded = MIME::Base64::encode($decoded);
63 $decoded = MIME::Base64::decode($encoded);
64
65=head1 DIAGNOSTICS
66
691d66bd 67The following warnings can be generated if perl is invoked with the
6fba102d
JH
68C<-w> switch:
69
70=over 4
71
72=item Premature end of base64 data
73
74The number of characters to decode is not a multiple of 4. Legal
75base64 data should be padded with one or two "=" characters to make
76its length a multiple of 4. The decoded result will anyway be as if
77the padding was there.
78
79=item Premature padding of base64 data
80
81The '=' padding character occurs as the first or second character
82in a base64 quartet.
83
84=back
85
86=head1 EXAMPLES
87
88If you want to encode a large file, you should encode it in chunks
89that are a multiple of 57 bytes. This ensures that the base64 lines
90line up and that you do not end up with padding in the middle. 57
91bytes of data fills one complete base64 line (76 == 57*4/3):
92
93 use MIME::Base64 qw(encode_base64);
94
95 open(FILE, "/var/log/wtmp") or die "$!";
96 while (read(FILE, $buf, 60*57)) {
97 print encode_base64($buf);
98 }
99
100or if you know you have enough memory
101
102 use MIME::Base64 qw(encode_base64);
103 local($/) = undef; # slurp
104 print encode_base64(<STDIN>);
105
106The same approach as a command line:
107
108 perl -MMIME::Base64 -0777 -ne 'print encode_base64($_)' <file
109
691d66bd
RGS
110Decoding does not need slurp mode if every line contains a multiple
111of four base64 chars:
6fba102d
JH
112
113 perl -MMIME::Base64 -ne 'print decode_base64($_)' <file
114
115=head1 COPYRIGHT
116
691d66bd 117Copyright 1995-1999, 2001-2004 Gisle Aas.
6fba102d
JH
118
119This library is free software; you can redistribute it and/or
120modify it under the same terms as Perl itself.
121
122Distantly based on LWP::Base64 written by Martijn Koster
123<m.koster@nexor.co.uk> and Joerg Reichelt <j.reichelt@nexor.co.uk> and
124code posted to comp.lang.perl <3pd2lp$6gf@wsinti07.win.tue.nl> by Hans
125Mulder <hansm@wsinti07.win.tue.nl>
126
691d66bd 127The XS implementation uses code from metamail. Copyright 1991 Bell
6fba102d
JH
128Communications Research, Inc. (Bellcore)
129
8be5f608
RGS
130=head1 SEE ALSO
131
132L<MIME::QuotedPrint>
133
6fba102d
JH
134=cut
135
136use strict;
137use vars qw(@ISA @EXPORT $VERSION $OLD_CODE);
138
139require Exporter;
140require DynaLoader;
141@ISA = qw(Exporter DynaLoader);
142@EXPORT = qw(encode_base64 decode_base64);
143
691d66bd 144$VERSION = '2.23';
6fba102d
JH
145
146eval { bootstrap MIME::Base64 $VERSION; };
147if ($@) {
148 # can't bootstrap XS implementation, use perl implementation
149 *encode_base64 = \&old_encode_base64;
150 *decode_base64 = \&old_decode_base64;
151
152 $OLD_CODE = $@;
153 #warn $@ if $^W;
154}
155
156# Historically this module has been implemented as pure perl code.
157# The XS implementation runs about 20 times faster, but the Perl
158# code might be more portable, so it is still here.
159
6fba102d
JH
160sub old_encode_base64 ($;$)
161{
8be5f608
RGS
162 if ($] >= 5.006) {
163 require bytes;
164 if (bytes::length($_[0]) > length($_[0]) ||
165 ($] >= 5.008 && $_[0] =~ /[^\0-\xFF]/))
166 {
167 require Carp;
168 Carp::croak("The Base64 encoding is only defined for bytes");
169 }
170 }
171
172 use integer;
173
6fba102d
JH
174 my $eol = $_[1];
175 $eol = "\n" unless defined $eol;
6fba102d 176
b9e0df4c
GA
177 my $res = pack("u", $_[0]);
178 # Remove first character of each line, remove newlines
179 $res =~ s/^.//mg;
180 $res =~ s/\n//g;
6fba102d
JH
181
182 $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs
183 # fix padding at the end
184 my $padding = (3 - length($_[0]) % 3) % 3;
185 $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
186 # break encoded string into lines of no more than 76 characters each
187 if (length $eol) {
188 $res =~ s/(.{1,76})/$1$eol/g;
189 }
190 return $res;
191}
192
193
194sub old_decode_base64 ($)
195{
196 local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
8be5f608 197 use integer;
6fba102d
JH
198
199 my $str = shift;
200 $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars
201 if (length($str) % 4) {
202 require Carp;
203 Carp::carp("Length of base64 data not a multiple of 4")
204 }
205 $str =~ s/=+$//; # remove padding
206 $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format
6a63fb82 207 return "" unless length $str;
6fba102d 208
b9e0df4c
GA
209 ## I guess this could be written as
210 #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
211 # $str =~ /(.{1,60})/gs) ) );
212 ## but I do not like that...
213 my $uustr = '';
214 my ($i, $l);
215 $l = length($str) - 60;
216 for ($i = 0; $i <= $l; $i += 60) {
217 $uustr .= "M" . substr($str, $i, 60);
218 }
219 $str = substr($str, $i);
220 # and any leftover chars
221 if ($str ne "") {
222 $uustr .= chr(32 + length($str)*3/4) . $str;
223 }
224 return unpack ("u", $uustr);
6fba102d
JH
225}
226
227# Set up aliases so that these functions also can be called as
228#
229# MIME::Base64::encode();
230# MIME::Base64::decode();
231
232*encode = \&encode_base64;
233*decode = \&decode_base64;
234
2351;