| 1 |
# |
| 2 |
# Library inspired by the Perl 4 code from base64.pl by A. P. Barrett |
| 3 |
# <barrett@ee.und.ac.za>, October 1993, and subsequent changes by |
| 4 |
# Earl Hood <earl@earlhood.com> to use MIME::Base64 if available. |
| 5 |
# |
| 6 |
|
| 7 |
package base64; |
| 8 |
|
| 9 |
my $use_MIMEBase64 = eval { require MIME::Base64; }; |
| 10 |
|
| 11 |
sub b64decode |
| 12 |
{ |
| 13 |
return &MIME::Base64::decode_base64 if $use_MIMEBase64; |
| 14 |
|
| 15 |
local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123] |
| 16 |
use integer; |
| 17 |
|
| 18 |
my $str = shift; |
| 19 |
$str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars |
| 20 |
length($str) % 4 and |
| 21 |
die "Internal error in state: length of base64 data not a multiple of 4"; |
| 22 |
$str =~ s/=+$//; # remove padding |
| 23 |
$str =~ tr|A-Za-z0-9+/| -_|; # convert to uuencoded format |
| 24 |
return "" unless length $str; |
| 25 |
|
| 26 |
unpack("u", join('', map( chr(32 + length($_)*3/4) . $_, |
| 27 |
$str =~ /(.{1,60})/gs) ) ); |
| 28 |
} |
| 29 |
|
| 30 |
sub b64encode |
| 31 |
{ |
| 32 |
return &MIME::Base64::encode_base64 if $use_MIMEBase64; |
| 33 |
|
| 34 |
local ($_) = shift; |
| 35 |
local($^W) = 0; |
| 36 |
use integer; # should be faster and more accurate |
| 37 |
|
| 38 |
my $result = pack("u", $_); |
| 39 |
$result =~ s/^.//mg; |
| 40 |
$result =~ s/\n//g; |
| 41 |
|
| 42 |
$result =~ tr|\` -_|AA-Za-z0-9+/|; |
| 43 |
my $padding = (3 - length($_) % 3) % 3; |
| 44 |
|
| 45 |
$result =~ s/.{$padding}$/'=' x $padding/e if $padding; |
| 46 |
$result =~ s/(.{1,76})/$1\n/g; |
| 47 |
$result; |
| 48 |
} |
| 49 |
|
| 50 |
1; |
Parent Directory
| 
Revision Log