File Coverage

blib/lib/JSON/SL/Tuba.pm

Criterion	Covered	Total	%
statement	50	56	89.2
branch	5	10	50.0
condition	2	6	33.3
subroutine	13	14	92.8
pod	2	4	50.0
total	72	90	80.0

package JSON::SL::Tuba;
use strict;
use warnings;
use JSON::SL;
use base qw(Exporter);
our @EXPORT;

my (%ActionMap,%TypeMap);
my $_cg_typehash;
my $_cg_modehash;

BEGIN {
    %ActionMap = (
    '+' => 'start',
    '-' => 'end',
    '>' => 'on'
    );
    %TypeMap = (
    '{' => 'object',
    '[' => 'list',
    'c' => 'data',
    'D' => 'json',
    '#' => 'key',
    '"' => 'string',
    '^' => 'special',
    '?' => 'boolean',
    '=' => 'number',
    '~' => 'null'
    );

    while (my ($sym,$name) = each %ActionMap) {
        $_cg_modehash->{uc($name)} = ord($sym);
    }
    while (my ($sym,$name) = each %TypeMap) {
        $_cg_typehash->{uc($name)} = ord($sym);
    }
}

use Constant::Generate $_cg_typehash, prefix => "TUBA_TYPE_", export => 1;
use Constant::Generate $_cg_modehash, prefix => "TUBA_MODE_", export =>1;

our %CloseTokens = (
    '{' => '}',
    '"' => '"',
    '[' => ']'
);

sub new {
    my ($cls,%options) = @_;
    my $o = $cls->_initialize();

    unless (exists $options{accum_kv} and
        not delete $options{accum_kv}) {
        $o->accum_kv(1);
    }
    unless (exists $options{accum_all}and
        not delete $options{accum_all}) {
        $o->accum_all(1);
    }
    while (my ($k,$v) = each %options) {
        $o->can($k)->($o,$v);
    }
    return $o;
}

# TODO: I can't think why I've hidden this?
{
    no warnings 'once';
    *parse = *_parse;
}

# set accumulator parameters:
sub accum {
    my ($tuba,%modes) = @_;
    while (my ($mode,$bool) = each %modes) {
        if ($mode !~ m{[\=\~\?\#"]}) {
            die("Invalid mode '$mode'. Mode must be one of [^#\"]");
        }
        $tuba->_ax_opt(ord("$mode"), $bool);
    }
}

sub accum_enabled_for {
    my ($tuba,$mode) = @_;
    if ($mode !~ m{[\=\~\?\#"]}) {
        die("Invalid type '$mode'. Mode must be one of [^#\"]");
    }
    return $tuba->_ax_opt(ord("$mode"))
}

sub accum_all {
    my ($tuba,$boolean) = @_;
    if (@_ != 2) {
        die("Must have boolean argument!");
    }
    my %opts = map {
        $_, $boolean
    } ('=','~','#','?','"');
    $tuba->accum(%opts);
}

#build convenience methods:
foreach (['key', '#'],
         ['string', '"'],
         ['number', '='],
         ['boolean', '?'],
         ['null', '~']
         ) {

    my ($mode,$sym) = @$_;
    no strict 'refs';
    *{"accum_$mode"} = sub {
        my ($tuba,$bool) = @_;
        $tuba->_ax_opt(ord($sym), $bool);
    }
}

1;

__END__