File Coverage

blib/lib/MarpaX/ESLIF/ECMA404.pm

Criterion	Covered	Total	%
statement	45	80	56.2
branch	14	42	33.3
condition	1	2	50.0
subroutine	9	10	90.0
pod	2	2	100.0
total	71	136	52.2

use strict;
use warnings FATAL => 'all';

package MarpaX::ESLIF::ECMA404;

# ABSTRACT: JSON Data Interchange Format following ECMA-404 specification

our $VERSION = '0.012'; # VERSION

our $AUTHORITY = 'cpan:JDDPAUSE'; # AUTHORITY


use Carp qw/croak/;
use MarpaX::ESLIF 3.0.12;
use MarpaX::ESLIF::ECMA404::RecognizerInterface;
use MarpaX::ESLIF::ECMA404::ValueInterface;
use Scalar::Util qw/looks_like_number/;

our $_BNF    = do { local $/;  };


sub new {
    my ($pkg, %options) = @_;

    my $bnf = $_BNF;

    if ($options{unlimited_commas}) {
        my $tag = quotemeta('# /* Unlimited commas */');
        $bnf =~ s/$tag//g;
        $bnf =~ s/\bseparator\s*=>\s*comma\b/separator => commas/g;
    }
    if ($options{trailing_separator}) {
        $bnf =~ s/\bproper\s*=>\s*1\b/proper => 0/g;
    }
    if ($options{perl_comment}) {
        my $tag = quotemeta('# /* Perl comment */');
        $bnf =~ s/$tag//g;
    }
    if ($options{cplusplus_comment}) {
        my $tag = quotemeta('# /* C++ comment */');
        $bnf =~ s/$tag//g;
    }
    if ($options{bignum}) {
        my $tag = quotemeta('# /* bignum */');
        $bnf =~ s/$tag//g;
    }
    if ($options{inf}) {
        my $tag = quotemeta('# /* inf */');
        $bnf =~ s/$tag//g;
    }
    if ($options{nan}) {
        my $tag = quotemeta('# /* nan */');
        $bnf =~ s/$tag//g;
    }
    if ($options{cntrl}) {
        my $tag = quotemeta('# /* cntrl */');
        $bnf =~ s/$tag//g;
    }
    #
    # Check that max_depth looks like a number
    #
    my $max_depth = $options{max_depth} //= 0;
    croak "max_depth option does not look like a number" unless looks_like_number $max_depth;
    #
    # And that it is an integer
    #
    $max_depth =~ s/\s//g;
    croak "max_depth option does not look an integer >= 0" unless $max_depth =~  /^\+?\d+/;
    $options{max_depth} = int($max_depth);
    if ($options{max_depth}) {
        my $tag = quotemeta('# /* max_depth */');
        $bnf =~ s/$tag//g;
    }

    bless {
           grammar => MarpaX::ESLIF::Grammar->new(MarpaX::ESLIF->new($options{logger}), $bnf),
           %options
          }, $pkg
}


sub decode {
  my ($self, $input, $encoding) = @_;

  # ----------------------------------
  # Instanciate a recognizer interface
  # ----------------------------------
  my $recognizerInterface = MarpaX::ESLIF::ECMA404::RecognizerInterface->new(data => $input, encoding => $encoding);

  # -----------------------------
  # Instanciate a value interface
  # -----------------------------
  my $valueInterface = MarpaX::ESLIF::ECMA404::ValueInterface->new(logger => $self->{logger}, disallow_dupkeys => $self->{disallow_dupkeys});

  # ---------------
  # Parse the input
  # ---------------
  my $max_depth = $self->{max_depth};
  if ($max_depth) {
    $self->{cur_depth} = 0;
    #
    # We need to use the recognizer loop to have access to the inc/dec events
    #
    my $eslifRecognizer = MarpaX::ESLIF::Recognizer->new($self->{grammar}, $recognizerInterface);
    $eslifRecognizer->scan() || croak "scan() failed";
    $self->_manage_events($eslifRecognizer);
    if ($eslifRecognizer->isCanContinue) {
        do {
            $eslifRecognizer->resume || croak 'resume() failed';
            $self->_manage_events($eslifRecognizer)
        } while ($eslifRecognizer->isCanContinue)
    }
    #
    # We configured value interface to not accept ambiguity not null parse.
    # So no need to loop on value()
    #
    MarpaX::ESLIF::Value->new($eslifRecognizer, $valueInterface)->value() || croak 'Valuation failed'
  } else {
    $self->{grammar}->parse($recognizerInterface, $valueInterface) || croak 'Parse failed'
  }

  # ------------------------
  # Return the value
  # ------------------------
  return $valueInterface->getResult
}

sub _manage_events {
  my ($self, $eslifRecognizer) = @_;

  foreach (@{$eslifRecognizer->events()}) {
    my $event = $_->{event};
    next unless $event;  # Can be undef for exhaustion
    if ($event eq 'inc[]') {
      croak "Maximum depth $self->{max_depth} reached" if ++$self->{cur_depth} > $self->{max_depth}
    } elsif ($event eq 'dec[]') {
       --$self->{cur_depth}
     }
  }
}


1;

=pod

=encoding UTF-8

=head1 NAME

MarpaX::ESLIF::ECMA404 - JSON Data Interchange Format following ECMA-404 specification

=head1 VERSION

version 0.012

=head1 SYNOPSIS

    use MarpaX::ESLIF::ECMA404;

    my $ecma404 = MarpaX::ESLIF::ECMA404->new();
    my $input   = '["JSON",{},[]]';
    my $json    = $ecma404->decode($input);

=head1 DESCRIPTION

This module decodes strict JSON input using L.

=for html

=head1 SUBROUTINES/METHODS

=head2 new($class, %options)

Instantiate a new object. Takes as parameter an optional hash of options that can be:

=over

=item logger

An optional logger object instance that must do methods compliant with L interface.

=back

and the following extensions:

=over

=item unlimited_commas

Allow unlimited number of commas between object pairs or array elements.

=item trailing_separator

Allow trailing separator (i.e. a comma, eventually an unlimited number of them (c.f. C option) after object pairs or array elements.

=item perl_comment

Allow perl style comments.

=item cplusplus_comment

Allow C++ style comments.

=item bignum

Use perl's bignum to store numbers. Default perl's bignum accuracy and precision will be in effect.

=item inf

Support of C or C, case insensitive, eventually preceded by a C<+> or a C<-> sign.

=item nan

Support of C, case insensitive, eventually preceded by a C<+> or a C<-> sign (even if this is meaningless).

=item cntrl

Support of Unicode's control characters (i.e. the range C<[\x00-\x1F]>).

=item disallow_dupkeys

Dot not allow duplicate key in an object.

=back

=head2 decode($self, $input, $encoding)

Parses JSON that is in C<$input> and returns a perl variable containing the corresponding structured representation (which can be C), or croaks in case of failure. C<$encoding> is an optional parameter: JSON parser is using L that will I about the encoding if not specified, this guess is not 100% reliable - so if you know the encoding of your data, in particular if it is not in UTF-8, you should give the information to the parser. Default is to guess.

=head1 SEE ALSO

L, L

=head1 AUTHOR

Jean-Damien Durand

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017 by Jean-Damien Durand.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut

__DATA__