trunk/fetchcrl/base64.pm

#
# Library inspired by the Perl 4 code from base64.pl by A. P. Barrett 
# <barrett@ee.und.ac.za>, October 1993, and subsequent changes by 
# Earl Hood <earl@earlhood.com> to use MIME::Base64 if available.
#

package base64;

my $use_MIMEBase64 = eval { require MIME::Base64; };

sub b64decode
{
    return &MIME::Base64::decode_base64 if $use_MIMEBase64;

    local($^W) = 0;
    use integer; # should be faster and more accurate

    ( my $str = shift ) =~ tr|A-Za-z0-9+=/||cd;
    $str =~ s/=+$//;
    $str =~ s/[\n\s+]//s;
    $str =~ tr|A-Za-z0-9+/| -_|; # collapse base64 unto continuous set of chars
                                 # (by convention the uuencode set, for unpack)
    my $result;
    $result = "" unless $str;
    $result = unpack("u", join('', map( chr(32 + length($_)*3/4) . $_,
                                   $str =~ /(.{1,60})/gs) ) );
    $result;
}

sub b64encode
{
    return &MIME::Base64::encode_base64 if $use_MIMEBase64;

    local ($_) = shift;
    local($^W) = 0;
    use integer; # should be faster and more accurate
    
    my $result = pack("u", $_);
    $result =~ s/^.//mg;
    $result =~ s/\n//g;

    $result =~ tr|\` -_|AA-Za-z0-9+/|;
    my $padding = (3 - length($_) % 3) % 3;

    $result =~ s/.{$padding}$/'=' x $padding/e if $padding;
    $result =~ s/(.{1,76})/$1\n/g;
    $result;
}

1;
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;
grid.support@nikhef.nl	ViewVC Help
Powered by ViewVC 1.1.28