Codec-CBOR

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN

## `encode($data)`

Encodes a Perl data structure into a CBOR byte string.

- Strings: Encoded as Major Type 3 (UTF-8) if they are not references.
- Byte strings: Encoded as Major Type 2 if provided as a scalar reference (e.g., `\$binary_data`).
- Tags: Registered class handlers can produce tagged values (Major Type 6).

## `decode($input)`

Decodes a single CBOR object from a byte string or a filehandle. Returns the decoded Perl data structure.

## `decode_sequence($input)`

Decodes a sequence of concatenated CBOR objects. Returns an array (in list context) or an arrayref.

## `add_tag_handler($tag, $callback)`

Registers a callback to handle a specific CBOR tag during decoding.

```perl

lib/Codec/CBOR.pm  view on Meta::CPAN

        if ( $major == 1 ) { return -1 - $self->_decode_value( $info, $fh ); }

        if ( $major == 2 ) {    # Byte string
            my $len = $self->_decode_value( $info, $fh );
            read( $fh, my $buf, $len );
            return $buf;
        }
        if ( $major == 3 ) {    # UTF-8 string
            my $len = $self->_decode_value( $info, $fh );
            read( $fh, my $buf, $len );
            my $decoded = $buf;
            return $decoded if utf8::decode($decoded);

            # Fallback for invalid UTF-8: return raw bytes
            return $buf;
        }
        if ( $major == 4 ) {    # Array
            my $len = $self->_decode_value( $info, $fh );
            my @arr;
            push @arr, $self->_decode_item($fh) for 1 .. $len;
            return \@arr;
        }

lib/Codec/CBOR.pod  view on Meta::CPAN

=item * Strings: Encoded as Major Type 3 (UTF-8) if they are not references.

=item * Byte strings: Encoded as Major Type 2 if provided as a scalar reference (e.g., C<\$binary_data>).

=item * Tags: Registered class handlers can produce tagged values (Major Type 6).

=back

=head2 C<decode($input)>

Decodes a single CBOR object from a byte string or a filehandle. Returns the decoded Perl data structure.

=head2 C<decode_sequence($input)>

Decodes a sequence of concatenated CBOR objects. Returns an array (in list context) or an arrayref.

=head2 C<add_tag_handler($tag, $callback)>

Registers a callback to handle a specific CBOR tag during decoding.

    $codec->add_tag_handler(42 => sub ($data) {

t/01_basic.t  view on Meta::CPAN

    my @cases = (
        undef, 0, 1, 23, 24, 255, 256, 65535, 65536, 4294967295, 4294967296, -1, -24, -255, -65536, 'hello',
        'world with spaces',
        "unicode \x{1f600}",
        [ 1, 2, 3 ],
        { a     => 1,              b => 2 },
        { inner => [ { x => 1 } ], y => 'z' }
    );
    for my $case (@cases) {
        my $encoded = $codec->encode($case);
        my $decoded = $codec->decode($encoded);
        is $decoded, $case, 'Roundtrip for ' . ( defined $case ? ( ref $case // $case ) : 'undef' );
    }
};
subtest 'DAG-CBOR Determinism' => sub {
    my $h1 = { a => 1, b => 2, c => 3 };
    my $h2 = { c => 3, a => 1, b => 2 };
    is $codec->encode($h1), $codec->encode($h2), 'Hash encoding is deterministic';
};
subtest 'Sequence Decoding' => sub {
    my $data  = $codec->encode( { a => 1 } ) . $codec->encode( { b => 2 } );
    my @items = $codec->decode_sequence($data);

t/01_basic.t  view on Meta::CPAN

};
subtest 'Tag 42 (CID)' => sub {
    {
        # Mock a CID object
        package Mock::CID;
        sub new { bless { raw => 'foobar' }, shift }
        sub raw { shift->{raw} }
    }
    my $cid     = Mock::CID->new();
    my $encoded = $codec->encode($cid);
    my $decoded = $codec->decode($encoded);
    is ref $decoded, 'HASH', 'Decoded Tag 42 into hash (default handler)';

    # Default handler strips the leading 00 if present
    is $decoded->{cid_raw}, 'foobar', 'Extracted cid_raw matches';
};
#
done_testing;

t/02_fixtures.t  view on Meta::CPAN

    { name => 'dagpb_1link',     hex => 'a1654c696e6b7381a16448617368d82a58230012207521fe19c374a97759226dc5c0c8e674e73950e81b211f7dd3b6b30883a08a51' }
);
my $garbage_00
    = '8679075f593b44722664215c2961322b62222ee298ba0955235125776c6c7d21402622493834676426343b2c33425f2e674274356d6c0a6d6f6d642c292e4a3b386b45425d4e627b5935744834452278787a6b793c747b7c243a553b656b5a74704a6f2d6f6c4d606a79494a35574e6e7d4c3d4022464b4c772...

# Garbage fixtures (Round-trip check)
subtest 'Garbage Round-trip' => sub {
    my @garbage = ( { name => 'garbage-00', hex => $garbage_00 } );
    for my $f (@garbage) {
        my $bin     = pack( 'H*', $f->{hex} );
        my $decoded = $codec->decode($bin);
        ok $decoded, 'Decoded ' . $f->{name};
    }
};

# Basic & Floats
subtest 'Basic and Float Fixtures' => sub {
    for my $f ( @basic_fixtures, @float_fixtures ) {
        my $encoded = $codec->encode( $f->{data} );
        is( unpack( 'H*', $encoded ), $f->{hex}, 'Encoding matches for ' . $f->{name} );
        my $decoded = $codec->decode( pack( 'H*', $f->{hex} ) );
        if ( builtin::blessed( $f->{data} ) && $f->{data}->isa('Codec::CBOR::Boolean') ) {
            ok $decoded->isa('Codec::CBOR::Boolean'), 'Decoded is a Boolean object';
            is $decoded, $f->{data}, 'Boolean value matches';
        }
        else {
            is normalize($decoded), ( $f->{name} =~ /float-[-\d]/ ? float( normalize( $f->{data} ), tolerance => 0.01 ) : normalize( $f->{data} ) ),
                'Decoding matches for ' . $f->{name};
        }
    }
};

# CIDs
subtest 'CID Fixtures' => sub {
    for my $f (@cid_fixtures) {
        my $bin     = pack( 'H*', $f->{hex} );
        my $decoded = $codec->decode($bin);
        is ref $decoded, 'HASH', "Decoded $f->{name} into hash";
        ok exists $decoded->{cid_raw}, 'Has cid_raw key';
    }
};

# DAG-PB
subtest 'DAG-PB Fixtures' => sub {
    for my $f (@dagpb_fixtures) {
        my $bin     = pack( 'H*', $f->{hex} );
        my $decoded = $codec->decode($bin);
        ok $decoded, 'Decoded ' . $f->{name};
        is normalize($decoded), normalize( $f->{data} ), 'Decoded data matches expected for ' . $f->{name} if defined $f->{data};
    }
};
#
done_testing;