Skip to content
Browse files

Initial commit

  • Loading branch information...
0 parents commit 4b3ec790fdde0f4a023177b67a9b1f8023b3ed36 @snarkyboojum snarkyboojum committed Jun 15, 2010
Showing with 114 additions and 0 deletions.
  1. +11 −0 README
  2. +27 −0 lib/MIME/Base64.pm6
  3. +40 −0 lib/MIME/Base64/Perl.pm6
  4. +18 −0 t/parrot.t
  5. +18 −0 t/perl.t
11 README
@@ -0,0 +1,11 @@
+Two libraries are available:
+
+ MIME::Base64
+
+ Implements encoding and decoding to and from base64 using underlying an
+ underlying parrot library
+
+ MIME::Base64::Perl
+
+ A horribly inefficient work in progress for doing the same thing as
+ MIME::Base64 in pure Perl 6 (what's currently available in Rakudo anyway)
27 lib/MIME/Base64.pm6
@@ -0,0 +1,27 @@
+class MIME::Base64 {
+
+ # load the MIME Base64 Parrot library to do all the hard work for us
+ pir::load_bytecode('MIME/Base64.pbc');
+
+ method encode_base64(Str $str) {
+ my $encoded-str = Q:PIR {
+ .local pmc encode
+ encode = get_root_global ['parrot'; 'MIME'], 'encode_base64'
+ $P0 = find_lex '$str'
+ %r = encode($P0)
+ };
+
+ return $encoded-str;
+ }
+
+ method decode_base64(Str $str) {
+ my $decoded-str = Q:PIR {
+ .local pmc decode
+ decode = get_root_global ['parrot'; 'MIME'], 'decode_base64'
+ $P0 = find_lex '$str'
+ %r = decode($P0)
+ };
+
+ return $decoded-str;
+ }
+}
40 lib/MIME/Base64/Perl.pm6
@@ -0,0 +1,40 @@
+class MIME::Base64::Perl {
+
+ method encode_base64(Str $str) {
+ return '' if $str eq '';
+
+ # this should be stored at the class level
+ my @table = 'A'..'Z','a'..'z',0..9,'+','/';
+
+ # 6 bit packs padded with 0s at the LSB
+ my $bit-string = $str.comb(/./)>>.ord>>.fmt('%08b').join();
+ my $bit-padding = 6 - $bit-string.chars % 6;
+ $bit-string ~= '0' x $bit-padding;
+
+ my @packs = $bit-string.comb(/....../);
+
+ # build corresponding base64 characters from 6 bit packs
+ my $output;
+ for @packs -> $p {
+ my @binary = $p.comb(/./);
+ my @bases = 2 X** ((^$p.chars).reverse);
+
+ my $index = ( [+] (@binary >>*<< @bases) );
+ $output ~= @table[$index];
+ }
+
+ # pad with = chars if needed
+ my $padding = 4 - $output.chars % 4;
+ $output ~= '=' x $padding;
+
+ return $output;
+ }
+
+ method decode_base64(Str $str) {
+ die "Not yet implemented";
+ }
+
+}
+
+my MIME::Base64::Perl $mime .= new;
+say $mime.encode_base64("Abc");
18 t/parrot.t
@@ -0,0 +1,18 @@
+use v6;
+
+use Test;
+use MIME::Base64;
+
+plan 9;
+
+my MIME::Base64 $mime .= new;
+
+is $mime.encode_base64(""), '', 'Encoding the empty string';
+is $mime.encode_base64("A"), 'QQ==', 'Encoding "A"';
+is $mime.encode_base64("Ab"), 'QWI=', 'Encoding "Ab"';
+is $mime.encode_base64("Abc"), 'QWJj', 'Encoding "Abc"';
+is $mime.encode_base64("Abcd"), 'QWJjZA==', 'Encoding "Abcd"';
+is $mime.encode_base64("Perl"), 'UGVybA==', 'Encoding "Perl"';
+is $mime.encode_base64("Perl6"), 'UGVybDY=', 'Encoding "Perl6"';
+is $mime.encode_base64("Another test!"), 'QW5vdGhlciB0ZXN0IQ==', '"Encoding "Another test!"';
+is $mime.encode_base64("username:thisisnotmypassword"), 'dXNlcm5hbWU6dGhpc2lzbm90bXlwYXNzd29yZA==', 'Encoding "username:thisisnotmypassword"';
18 t/perl.t
@@ -0,0 +1,18 @@
+use v6;
+
+use Test;
+use MIME::Base64::Perl;
+
+plan 9;
+
+my MIME::Base64::Perl $mime .= new;
+
+is $mime.encode_base64(""), '', 'Encoding the empty string';
+is $mime.encode_base64("A"), 'QQ==', 'Encoding "A"';
+is $mime.encode_base64("Ab"), 'QWI=', 'Encoding "Ab"';
+is $mime.encode_base64("Abc"), 'QWJj', 'Encoding "Abc"';
+is $mime.encode_base64("Abcd"), 'QWJjZA==', 'Encoding "Abcd"';
+is $mime.encode_base64("Perl"), 'UGVybA==', 'Encoding "Perl"';
+is $mime.encode_base64("Perl6"), 'UGVybDY=', 'Encoding "Perl6"';
+is $mime.encode_base64("Another test!"), 'QW5vdGhlciB0ZXN0IQ==', '"Encoding "Another test!"';
+is $mime.encode_base64("username:thisisnotmypassword"), 'dXNlcm5hbWU6dGhpc2lzbm90bXlwYXNzd29yZA==', 'Encoding "username:thisisnotmypassword"';

0 comments on commit 4b3ec79

Please sign in to comment.
Something went wrong with that request. Please try again.