module MIME::Base64;
# See http://www.ietf.org/rfc/rfc3548.txt
# Value Encoding Value Encoding Value Encoding Value Encoding
# 0 A 17 R 34 i 51 z
# 1 B 18 S 35 j 52 0
# 2 C 19 T 36 k 53 1
# 3 D 20 U 37 l 54 2
# 4 E 21 V 38 m 55 3
# 5 F 22 W 39 n 56 4
# 6 G 23 X 40 o 57 5
# 7 H 24 Y 41 p 58 6
# 8 I 25 Z 42 q 59 7
# 9 J 26 a 43 r 60 8
# 10 K 27 b 44 s 61 9
# 11 L 28 c 45 t 62 +
# 12 M 29 d 46 u 63 /
# 13 N 30 e 47 v
# 14 O 31 f 48 w (pad) =
# 15 P 32 g 49 x
# 16 Q 33 h 50 y
# 1716151413121110 F E D C B A 9 8 7 6 5 4 3 2 1 0
# +--0 octet--+-1 octet--+--2 octet--+
# |7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|
# +-----------+---+-------+-------+---+-----------+
# |5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|
# +--0.index--+--1.index--+--2.index--+--3.index--+
#######################################################################
multi encode (Int $value) returns Str {
# say "Int";
("A".."Z","a".."z",0..9,"+","/")[$value];
}
multi encode (Str $string) {
my @oct = split('',$string);
[~] encode(@oct);
}
multi encode (*@string is copy) returns Array {
# say "Array";
gather {
while (@string>=3) {
my Int @octect = map { ord $_}, splice @string,0,3;
take encode(index(0 ,0,@octect[0],2,0x3F)); # 0.index
take encode(index(@octect[0],4,@octect[1],4,0x3F)); # 1.index
take encode(index(@octect[1],2,@octect[2],6,0x3F)); # 2.index
take encode(index(@octect[2],0, 0,0,0x3F)); # 3.index
}
if (@string == 2) {
my Int @octect = map { ord $_}, splice @string,0,3;
take encode(index(0 ,0,@octect[0],2,0x3F)); # 0.index
take encode(index(@octect[0],4,@octect[1],4,0x3F)); # 1.index
take encode(index(@octect[1],2, 0,0,0x3F)); # 2.index
take "=";
} elsif (@string == 1) {
my Int @octect = map { ord $_}, splice @string,0,3;
take encode(index(0 ,0,@octect[0],2,0x3F)); # 0.index
take encode(index(@octect[0],4, 0,0,0x3F)); # 1.index
take "=";
take "=";
}
}
}
sub index (Int $a, Int $ashift, Int $b, Int $bshift, Int $mask) returns Int {
(($a +& ($mask +>$ashift)) +< $ashift) +| ($b +> $bshift);
}
sub decode (Str $didget) {
# say "decode Str ->" ~ $didget ~ "<-";
given $didget {
when /^<[A..Z]>$/ { ord($didget)-ord("A")}
when /^<[a..z]>$/ {26 + ord($didget)-ord("a")}
when /^<[0..9]>$/ {52 + $didget}
when /^ \+ $/ {62}
when /^ \/ $/ {63}
when /^ \= $/ {-1}
when /^<-[A..Za..z0..9+\/=]>$/ {fail "This should never happen"}
default {
my @index = split('',$didget);
@index = grep {$_ ~~ /^<[A..Za..z0..9+\/=]>+$/},@index;
[~] map {chr ($_)}, decode(@index)}
}
}
# 1716151413121110 F E D C B A 9 8 7 6 5 4 3 2 1 0
# +--0 octet--+-1 octet--+--2 octet--+
# |7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|7 6 5 4 3 2 1 0|
# +-----------+---+-------+-------+---+-----------+
# |5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|5 4 3 2 1 0|
# +--0.index--+--1.index--+--2.index--+--3.index--+
#######################################################################
sub decode (*@string is copy) {
# say "decode Array ->" ~ @index.perl ~ "<-";
@string = map { decode($_) }, @string;
gather {
while (@string>0 and all(@string[0..3])>0) {
my Int @index = splice @string,0,4;
take index(@index[0],2,@index[1],4,0xFF); # 0.octet
take index(@index[1],4,@index[2],2,0xFF); # 1.octet
take index(@index[2],6,@index[3],0,0xFF); # 2.octet
}
if (all(@string[0..2])>0) {
my Int @index = splice @string,0,4;
take index(@index[0],2,@index[1],4,0xFF); # 0.octet
take index(@index[1],4,@index[2],2,0xFF); # 1.octet
# take index(@index[2],6,@index[3],0,0xFF); # 2.octet
} elsif (all(@string[0..1])>0) {
my Int @index = splice @string,0,4;
take index(@index[0],2,@index[1],4,0xFF); # 0.octet
# take index(@index[1],4,@index[2],2,0xFF); # 1.octet
# take index(@index[2],6,@index[3],0,0xFF); # 2.octet
} elsif (@string[0]>0) {
my Int @index = splice @string,0,4;
take index(@index[0],2,@index[1],4,0xFF); # 0.octet
# take index(@index[1],4,@index[2],2,0xFF); # 1.octet
# take index(@index[2],6,@index[3],0,0xFF); # 2.octet
}
}
}
=head1 NAME
MIME::Base64 - base64 encoding and decoding for Pugs
=head1 SYNOPSIS
use MIME::Base64;
my $encode = MIME::Base64::encode("A string");
my $decode = MIME::Base64::decode("QSBzdHJpbmc=");
=head1 DESCRIPTION
C<MIME::Base64> is a base64 encoder/decoder for pugs it is I<not> a port
of Perl5's MIME::Base64.
=head1 FUNCTIONS
XXX
=cut