File Coverage

blib/lib/YAML/PP/Schema/Binary.pm

Criterion	Covered	Total	%
statement	31	31	100.0
branch	4	4	100.0
condition			n/a
subroutine	7	7	100.0
pod	1	1	100.0
total	43	43	100.0

use strict;
use warnings;
package YAML::PP::Schema::Binary;

our $VERSION = '0.036_002'; # TRIAL VERSION

use MIME::Base64 qw/ decode_base64 encode_base64 /;
use YAML::PP::Common qw/ YAML_ANY_SCALAR_STYLE /;

sub register {
    my ($self, %args) = @_;
    my $schema = $args{schema};

    $schema->add_resolver(
        tag => 'tag:yaml.org,2002:binary',
        match => [ all => sub {
            my ($constructor, $event) = @_;
            my $base64 = $event->{value};
            my $binary = decode_base64($base64);
            return $binary;
        }],
        implicit => 0,
    );

    $schema->add_representer(
        regex => qr{.*},
        code => sub {
            my ($rep, $node) = @_;
            my $binary = $node->{value};
            unless ($binary =~ m/[\x{7F}-\x{10FFFF}]/) {
                # ASCII
                return;
            }
            if (utf8::is_utf8($binary)) {
                # utf8
                return;
            }
            # everything else must be base64 encoded
            my $base64 = encode_base64($binary);
            $node->{style} = YAML_ANY_SCALAR_STYLE;
            $node->{data} = $base64;
            $node->{tag} = "tag:yaml.org,2002:binary";
            return 1;
        },
    );
}

1;

__END__