1 |
davidg |
1758 |
# |
2 |
davidg |
1768 |
# 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 |
davidg |
1758 |
# |
6 |
|
|
|
7 |
|
|
package base64; |
8 |
|
|
|
9 |
davidg |
1768 |
my $use_MIMEBase64 = eval { require MIME::Base64; }; |
10 |
davidg |
1758 |
|
11 |
|
|
sub b64decode |
12 |
|
|
{ |
13 |
davidg |
1771 |
return &MIME::Base64::decode_base64 if $use_MIMEBase64; |
14 |
davidg |
1758 |
|
15 |
davidg |
1768 |
local($^W) = 0; |
16 |
|
|
use integer; # should be faster and more accurate |
17 |
davidg |
1758 |
|
18 |
davidg |
1768 |
( my $str = shift ) =~ tr|A-Za-z0-9+=/||cd; |
19 |
|
|
$str =~ s/=+$//; |
20 |
davidg |
1771 |
$str =~ s/[\n\s+]//s; |
21 |
davidg |
1768 |
$str =~ tr|A-Za-z0-9+/| -_|; # collapse base64 unto continuous set of chars |
22 |
|
|
# (by convention the uuencode set, for unpack) |
23 |
davidg |
1771 |
my $result; |
24 |
|
|
$result = "" unless $str; |
25 |
|
|
$result = unpack("u", join('', map( chr(32 + length($_)*3/4) . $_, |
26 |
|
|
$str =~ /(.{1,60})/gs) ) ); |
27 |
|
|
$result; |
28 |
davidg |
1758 |
} |
29 |
|
|
|
30 |
|
|
sub b64encode |
31 |
|
|
{ |
32 |
davidg |
1771 |
return &MIME::Base64::encode_base64 if $use_MIMEBase64; |
33 |
davidg |
1758 |
|
34 |
|
|
local ($_) = shift; |
35 |
davidg |
1768 |
local($^W) = 0; |
36 |
|
|
use integer; # should be faster and more accurate |
37 |
davidg |
1758 |
|
38 |
davidg |
1771 |
my $result = pack("u", $_); |
39 |
davidg |
1768 |
$result =~ s/^.//mg; |
40 |
|
|
$result =~ s/\n//g; |
41 |
davidg |
1758 |
|
42 |
davidg |
1771 |
$result =~ tr|\` -_|AA-Za-z0-9+/|; |
43 |
|
|
my $padding = (3 - length($_) % 3) % 3; |
44 |
davidg |
1758 |
|
45 |
davidg |
1768 |
$result =~ s/.{$padding}$/'=' x $padding/e if $padding; |
46 |
davidg |
1771 |
$result =~ s/(.{1,76})/$1\n/g; |
47 |
|
|
$result; |
48 |
davidg |
1758 |
} |
49 |
|
|
|
50 |
|
|
1; |