Absolute hinky bare-bones implementation of multiformats in Perl
1package
2 Multiformats::Multibase {
3 use strict;
4 use warnings;
5 use feature 'signatures';
6
7 use Exporter 'import';
8 our @EXPORT_OK = qw/multibase_encode multibase_decode/;
9
10 use Crypt::Misc qw/encode_b58b decode_b58b encode_b32r decode_b32r/;
11 use Math::Base36 qw/encode_base36 decode_base36/;
12
13 sub decode($self, $value) {
14 return multibase_decode($value);
15 }
16
17 sub encode($self, $as, $value) {
18 return multibase_encode($as, $value);
19 }
20
21 sub new($pkg) {
22 return bless({}, $pkg);
23 }
24
25 # this map holds the various encodings and decodings
26 use constant MB_MAP => [
27 [ 'none', "\0", sub { return shift }, sub { return shift } ],
28 [ 'base32', 'b', sub { return lc(encode_b32r(shift)) }, sub { return decode_b32r(uc(shift)) } ],
29 [ 'base32upper','B', sub { return encode_b32r(shift) }, sub { return decode_b32r(shift) } ],
30 [ 'base36', 'k', sub { return lc(encode_base36(shift)) }, sub { return decode_base36(shift) } ],
31 [ 'base58btc', 'z', sub { return encode_b58b(shift) }, sub { return decode_b58b(shift) } ],
32 ];
33
34 sub _map_by_tag($tag) {
35 foreach my $entry (@{__PACKAGE__->MB_MAP}) {
36 return $entry if($entry->[1] eq $tag);
37 }
38 return undef;
39 }
40
41 sub _map_by_name($name) {
42 if(length($name) == 1) {
43 return _map_by_tag($name);
44 } else {
45 foreach my $entry (@{__PACKAGE__->MB_MAP}) {
46 return $entry if($entry->[0] eq $name);
47 }
48 return undef;
49 }
50 }
51
52 sub multibase_decode($bytes) {
53 # make sure it's actual bytes
54 utf8::downgrade($bytes, 1);
55 my $t = substr($bytes, 0, 1);
56 if(my $e = _map_by_tag($t)) {
57 my $decoded = $e->[3]->(substr($bytes, 1));
58 return wantarray
59 ? ($t, $decoded)
60 : $decoded;
61 } else {
62 die 'unknown format ' . $t . ', ';
63 }
64 }
65
66 sub multibase_encode($as, $bytes) {
67 utf8::downgrade($bytes, 1);
68 if(my $e = _map_by_name($as)) {
69 my $encoded = $e->[1] . $e->[2]->($bytes);
70 return $encoded;
71 } else {
72 die 'unknown format ' . $as . ', ';
73 }
74 }
75}
76
77=pod
78
79=head1 NAME
80
81Multiformats::Multibase - Multibase decoding and encoding
82
83=head1 SYNOPSIS
84
85 use Multiformats::Multibase qw/multibase_encode multibase_decode/;
86
87 my $encoded = multibase_encode('base32', 'this will be base32 encoded');
88 my $decoded = multibase_decode($encoded_string);
89
90=head1 FUNCTIONS
91
92=head2 multibase_encode($base, $data_to_encode)
93
94Encodes the given data with the given base. See below for supported bases.
95
96=head2 multibase_decode($encoded_data);
97
98Decodes the given data. When called in scalar context returns the decoded data. When called in list context returns a list containing the multibase tag and the decoded data
99
100=head1 SUPPORTED BASES
101
102=over
103
104=item * base32
105
106=item * base32upper
107
108=item * base36
109
110=item * base58btc
111
112=back
113
114=cut
115
1161;