File Coverage

blib/lib/TOON/XS.pm

Criterion	Covered	Total	%
statement	46	68	67.6
branch	13	38	34.2
condition	0	4	0.0
subroutine	16	22	72.7
pod	16	16	100.0
total	91	148	61.4

# ABSTRACT: Token-Oriented Object Notation for Perl in XS
package TOON::XS;
$TOON::XS::VERSION = '0.001';
use 5.010;
use strict;
use warnings;

use Carp qw(croak);
use Exporter 'import';
use XSLoader;

our @EXPORT_OK = qw(
    encode_toon decode_toon
    encode_line_toon decode_line_toon validate_line_toon
    encode_brace_toon decode_brace_toon validate_brace_toon
);

XSLoader::load(__PACKAGE__, $TOON::XS::{VERSION} ? ${ $TOON::XS::{VERSION} } : ());

sub encode_line_toon {
    my ($data, %opts) = @_;
    return _xs_encode_line($data, \%opts);
}

sub decode_line_toon {
    my ($text, %opts) = @_;
    return _xs_decode_line($text, \%opts);
}

sub validate_line_toon {
    my ($text, %opts) = @_;
    return _xs_validate_line($text, \%opts);
}

sub encode_brace_toon {
    my ($data, %opts) = @_;
    return _xs_encode_brace($data, \%opts);
}

sub decode_brace_toon {
    my ($text, %opts) = @_;
    return _xs_decode_brace($text);
}

sub validate_brace_toon {
    my ($text, %opts) = @_;
    my $ok = eval { _xs_decode_brace($text); 1 };
    return $ok ? 1 : 0;
}

sub encode_toon {
    my ($data, %opts) = @_;
    my $syntax = delete $opts{'syntax'} // q{};
    $syntax eq 'line'    ? return encode_line_toon($data, %opts)
    : $syntax eq 'brace' ? return encode_brace_toon($data, %opts)
    : croak q{encode_toon() requires 'syntax' => 'line'|'brace'};
}

sub decode_toon {
    my ($text, %opts) = @_;
    my $syntax = delete $opts{syntax} // q{};
    $syntax eq 'line'    ? return decode_line_toon($text, %opts)
    : $syntax eq 'brace' ?  return decode_brace_toon($text, %opts)
    : croak q{decode_toon() requires 'syntax' => 'line'|'brace'};
}

sub new {
    my ($class, %opts) = @_;
    defined $opts{'syntax'}
        or croak q{'syntax' => 'line'|'brace' is required};

    return bless {
        syntax    => $opts{syntax},
        pretty    => exists $opts{pretty}    ? $opts{pretty}    : 0,
        canonical => exists $opts{canonical} ? $opts{canonical} : 0,
        indent    => exists $opts{indent}    ? $opts{indent}    : 2,
    }, $class;
}

sub encode {
    my ($self, $data, %opts) = @_;
    my %all_opts = ( %{$self}, %opts );
    my $syntax = delete $all_opts{'syntax'};
    $syntax eq 'brace'  ? return encode_brace_toon($data, %all_opts)
    : $syntax eq 'line' ? return encode_line_toon($data, %all_opts)
    : croak "Unknown syntax '$syntax' for object encode()";
}

sub decode {
    my ($self, $text, %opts) = @_;
    my %all_opts = (%{$self}, %opts);
    my $syntax = delete $all_opts{syntax};
    $syntax eq 'brace'  ? return decode_brace_toon($text, %all_opts)
    : $syntax eq 'line' ? return decode_line_toon($text, %all_opts)
    : croak "Unknown syntax '$syntax' for object decode()";
}

sub validate {
    my ($self, $text, %opts) = @_;
    my %all_opts = (%{$self}, %opts);
    my $syntax = delete $all_opts{syntax};
    $syntax eq 'brace'  ? return validate_brace_toon($text, %all_opts)
    : $syntax eq 'line' ? return validate_line_toon($text, %all_opts)
    : croak "Unknown syntax '$syntax' for object validate()";
}

sub pretty {
    my ($self, $value) = @_;
    $self->{pretty} = @_ > 1 ? $value : 1;
    return $self;
}

sub canonical {
    my ($self, $value) = @_;
    $self->{canonical} = @_ > 1 ? $value : 1;
    return $self;
}

sub indent {
    my ($self, $value) = @_;
    defined $value and $self->{indent} = $value;
    return $self;
}

sub syntax {
    my ($self, $value) = @_;
    defined $value and $self->{syntax} = $value;
    return $self;
}

1;

__END__