view release on metacpan or  search on metacpan

lib/CBOR/PP/Decode.pm  view on Meta::CPAN

package CBOR::PP::Decode;

use strict;
use warnings;

=encoding utf-8

=head1 NAME

CBOR::PP::Decode

=head1 SYNOPSIS

    my $perlvar = CBOR::PP::Decode::decode($binary);

=head1 DESCRIPTION

This implements a basic CBOR decoder in pure Perl.

=head1 MAPPING CBOR TO PERL

=over

=item * All tags are ignored. (This could be iterated on later.)

=item * Indefinite-length objects are supported, but streamed parsing
is not; the data structure must be complete to be decoded.

=item * CBOR text strings are decoded to UTF8-flagged strings, while
binary strings are decoded to non-UTF8-flagged strings. In practical
terms, this means that a decoded CBOR binary string will have no code point
above 255, while a decoded CBOR text string can contain any valid Unicode
code point.

=item * null, undefined, true, and false become undef, undef,
Types::Serialiser::true(), and Types::Serialiser::false(), respectively.
(NB: undefined is deserialized as an error object in L<CBOR::XS>,
which doesn’t seem to make sense.)

=back

=head1 TODO

=over

=item * Add tag decode support via callbacks.

=item * Make it faster by removing some of the internal buffer copying.

=back

=head1 AUTHOR

L<Gasper Software Consulting|http://gaspersoftware.com> (FELIPE)

=head1 LICENSE

This code is licensed under the same license as Perl itself.

=cut

#----------------------------------------------------------------------

=head1 METHODS

=head2 $value = decode( $CBOR_BYTESTRING )

Returns a Perl value that represents the serialized CBOR string.

=cut

my ($byte1, $offset, $lead3bits);

my $len;

# This ensures that pieces of indefinite-length strings
# are all of the same type.
our $_lead3_must_be;

use constant {
    _LEAD3_UINT => 0,
    _LEAD3_NEGINT => 1 << 5,
    _LEAD3_BINSTR => 2 << 5,
    _LEAD3_UTF8STR => 3 << 5,
    _LEAD3_ARRAY => 4 << 5,
    _LEAD3_HASH => 5 << 5,
    _LEAD3_TAG => 6 << 5,
};

# CBOR is much simpler to create than it is to parse!

# TODO: Optimize by removing the buffer duplication.

sub decode {
    $offset = 0;

    for ($_[0]) {
        $byte1 = ord( substr( $_, $offset, 1 ) );
        $lead3bits = 0xe0 & $byte1;

        die "Improper lead3 ($lead3bits) within streamed $_lead3_must_be!" if $_lead3_must_be && $lead3bits != $_lead3_must_be;

        #use Text::Control;
        #print Text::Control::to_hex($_) . $/;

        if ($lead3bits == _LEAD3_UINT()) {