1# 2# $Id: Base64.pm,v 1.1.1.1 2003/08/02 23:39:56 takezoe Exp $ 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 19This module provides functions to encode and decode strings into the 20Base64 encoding specified in RFC 2045 - I<MIME (Multipurpose Internet 21Mail Extensions)>. The Base64 encoding is designed to represent 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 30=item encode_base64($str) 31 32=item encode_base64($str, $eol); 33 34Encode data by calling the encode_base64() function. The first 35argument is the string to encode. The second argument is the line 36ending sequence to use (it is optional and defaults to C<"\n">). The 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 40broken into lines. 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 48Any character not part of the 65-character base64 subset set is 49silently ignored. Characters occuring after a '=' padding character 50are never decoded. 51 52If the length of the string to decode (after ignoring 53non-base64 chars) is not a multiple of 4 or padding occurs too early, 54then a warning is generated if perl is running under C<-w>. 55 56=back 57 58If you prefer not to import these routines into your namespace you can 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 67The following warnings might be generated if perl is invoked with the 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 110Decoding does not need slurp mode if all the lines contains a multiple 111of 4 base64 chars: 112 113 perl -MMIME::Base64 -ne 'print decode_base64($_)' <file 114 115=head1 COPYRIGHT 116 117Copyright 1995-1999, 2001-2003 Gisle Aas. 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 127The XS implementation use code from metamail. Copyright 1991 Bell 128Communications Research, Inc. (Bellcore) 129 130=cut 131 132use strict; 133use vars qw(@ISA @EXPORT $VERSION $OLD_CODE); 134 135require Exporter; 136require DynaLoader; 137@ISA = qw(Exporter DynaLoader); 138@EXPORT = qw(encode_base64 decode_base64); 139 140$VERSION = '2.20'; 141 142eval { bootstrap MIME::Base64 $VERSION; }; 143if ($@) { 144 # can't bootstrap XS implementation, use perl implementation 145 *encode_base64 = \&old_encode_base64; 146 *decode_base64 = \&old_decode_base64; 147 148 $OLD_CODE = $@; 149 #warn $@ if $^W; 150} 151 152# Historically this module has been implemented as pure perl code. 153# The XS implementation runs about 20 times faster, but the Perl 154# code might be more portable, so it is still here. 155 156use integer; 157 158sub old_encode_base64 ($;$) 159{ 160 my $eol = $_[1]; 161 $eol = "\n" unless defined $eol; 162 163 my $res = pack("u", $_[0]); 164 # Remove first character of each line, remove newlines 165 $res =~ s/^.//mg; 166 $res =~ s/\n//g; 167 168 $res =~ tr|` -_|AA-Za-z0-9+/|; # `# help emacs 169 # fix padding at the end 170 my $padding = (3 - length($_[0]) % 3) % 3; 171 $res =~ s/.{$padding}$/'=' x $padding/e if $padding; 172 # break encoded string into lines of no more than 76 characters each 173 if (length $eol) { 174 $res =~ s/(.{1,76})/$1$eol/g; 175 } 176 return $res; 177} 178 179 180sub old_decode_base64 ($) 181{ 182 local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123] 183 184 my $str = shift; 185 $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars 186 if (length($str) % 4) { 187 require Carp; 188 Carp::carp("Length of base64 data not a multiple of 4") 189 } 190 $str =~ s/=+$//; # remove padding 191 $str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format 192 return "" unless length $str; 193 194 ## I guess this could be written as 195 #return unpack("u", join('', map( chr(32 + length($_)*3/4) . $_, 196 # $str =~ /(.{1,60})/gs) ) ); 197 ## but I do not like that... 198 my $uustr = ''; 199 my ($i, $l); 200 $l = length($str) - 60; 201 for ($i = 0; $i <= $l; $i += 60) { 202 $uustr .= "M" . substr($str, $i, 60); 203 } 204 $str = substr($str, $i); 205 # and any leftover chars 206 if ($str ne "") { 207 $uustr .= chr(32 + length($str)*3/4) . $str; 208 } 209 return unpack ("u", $uustr); 210} 211 212# Set up aliases so that these functions also can be called as 213# 214# MIME::Base64::encode(); 215# MIME::Base64::decode(); 216 217*encode = \&encode_base64; 218*decode = \&decode_base64; 219 2201; 221