File Coverage

blib/lib/JSON/Assert.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

## ----------------------------------------------------------------------------
# Copyright (C) 2014-2016 NZRS Ltd
## ----------------------------------------------------------------------------
package JSON::Assert;

use Moo;
use MooX::Types::MooseLike::Base 'Str';
use JSON::Path;
use Test::Deep::NoTest;

$JSON::Path::Safe = 0;

our $VERSION = '0.06';
our $VERBOSE = $ENV{JSON_ASSERT_VERBOSE} || 1;

has 'error' =>
    is => "rw",
    isa => Str,
    clearer => "_clear_error",
    ;

sub _self {
    my $args = shift;
    if ( ref $args->[0] eq __PACKAGE__ ) {
        return shift @$args;
    }
    elsif ( $args->[0] eq __PACKAGE__ ) {
        return do { shift @$args }->new();
    }
    return __PACKAGE__->new();
}

# assert_jpath_count
sub assert_jpath_count {
    my $self = _self(\@_);
    my ($doc, $jpath_str, $count) = @_;

    my $jpath = _parse_jpath($jpath_str);

    my @values = $jpath->values($doc);

    my $found = 0;
    if (scalar @values != 1) {
        $found = scalar @values;
    }
    elsif (ref $values[0] eq 'ARRAY') {
        $found = scalar @{$values[0]};
    }
    else {
        $found = 1;
    }

    print "assert_jpath_count: Found $found\n" if $VERBOSE;

    unless ( $found == $count ) {
        die "JPath '$jpath' has $found " . $self->_plural($found, 'value') . ", not $count as expected";
    }

    return 1;
}

sub is_jpath_count {
    my $self = _self(\@_);
    my ($doc, $jpath, $count) = @_;

    $self->_clear_error();
    eval { $self->assert_jpath_count($doc, $jpath, $count) };
    if ( $@ ) {
        $self->error($@);
        return;
    }
    return 1;
}

# assert_jpath_value_match
sub assert_jpath_value_match {
    my $self = _self(\@_);
    my ($doc, $jpath_str, $match) = @_;

    my $jpath = _parse_jpath($jpath_str);

    # firstly, check that the node actually exists
    my @values = $jpath->values($doc);

    my $found = 0;
    if (scalar @values != 1) {
        $found = scalar @values;
    }
    elsif (ref $values[0] eq 'ARRAY') {
        $found = scalar @{$values[0]};
    }
    else {
        $found = 1;
    }

    print "assert_jpath_value_match: Found $found\n" if $VERBOSE;
    unless ( $found == 1 ) {
        die "JPath '$jpath' matched $found values when we expected to match one";
    }

    # check the value is what we expect
    my $value = $values[0];
    print "assert_jpath_value_match: This value's value : " . $value . "\n" if $VERBOSE;
    return 1 if (ref($value) eq ref($match) && ref($value) eq 'HASH' && scalar(keys(%$value)) == 0 && scalar(keys(%$match)) == 0);
    unless ( $value =~ $match ) {
        die "JPath '$jpath' doesn't match '$match' as expected, instead it is '" . $value . "'";
    }

    return 1;
}

sub does_jpath_value_match {
    my $self = _self(\@_);
    my ($doc, $jpath_str, $match) = @_;

    $self->_clear_error();
    eval { $self->assert_jpath_value_match($doc, $jpath_str, $match) };
    if ( $@ ) {
        $self->error($@);
        return;
    }
    return 1;
}

# assert_jpath_values_match
sub assert_jpath_values_match {
    my $self = _self(\@_);
    my ($doc, $jpath_str, $match) = @_;

    my $jpath = _parse_jpath($jpath_str);

    # firstly, check that the node actually exists
    my @values = $jpath->values($doc);

    my $values;
    if (scalar @values != 1) {
        $values = \@values;
    }
    elsif (ref $values[0] eq 'ARRAY') {
        $values = $values[0];
    }
    else {
        $values = \@values;
    }

    print 'assert_jpath_values_match: Found ' . (scalar @$values) . "\n" if $VERBOSE;
    unless ( @$values ) {
        die "JPath '$jpath' matched no nodes when we expected to match at least one";
    }

    # check the values are what we expect
    my $i = 0;
    foreach my $value ( @$values ) {
	print "assert_jpath_value_match: This keys's value : " . $value . "\n" if $VERBOSE;
        if (ref($value) eq ref($match) && ref($value) eq 'HASH' && scalar(keys(%$value)) == 0 && scalar(keys(%$match)) == 0){
          $i++;
          next;
        }
        unless ( $value =~ $match ) {
            die "Item $i of JPath '$jpath' doesn't match '$match' as expected, instead it is '" . $value . "'";
        }
        $i++;
    }

    return 1;
}

sub do_jpath_values_match {
    my $self = _self(\@_);
    my ($doc, $jpath_str, $match) = @_;

    $self->_clear_error();
    eval { $self->assert_jpath_values_match($doc, $jpath_str, $match) };
    if ( $@ ) {
        $self->error($@);
        return;
    }
    return 1;
}

sub assert_json_contains {
    my $self = _self(\@_);
    my ($doc, $jpath_str, $match) = @_;

    my $jpath = _parse_jpath($jpath_str);
    my @values = $jpath->values($doc);

    if (ref $match eq 'HASH') {
        if (! eq_deeply($values[0], superhashof($match))) {
            use Data::Dumper;
            if ($VERBOSE)  {
                print "wanted: " . Dumper($match) . ", got: " . Dumper ($values[0]) . "\n";
            }

        }
    }
    elsif (ref $match eq 'ARRAY') {
        if (ref $match->[0] eq 'HASH') {
            my @new_wanted = map { superhashof($_) } @$match;

            die "JPath '$jpath_str' doesn't match wanted data structure"
                unless eq_deeply(@values, \@new_wanted);
        }

        die "JPath '$jpath_str' doesn't match wanted data structure"
            unless eq_deeply($values[0], $match);
    }
    else {
        die "JPath '$jpath_str' doesn't match wanted data structure"
            unless $values[0] eq $match;
    }

   return 1;
}

sub does_jpath_contains {
    my $self = _self(\@_);
    my ($doc, $jpath_str, $match) = @_;

    $self->_clear_error();
    eval { $self->assert_json_contains($doc, $jpath_str, $match) };
    if ( $@ ) {
        $self->error($@);
        return;
    }
    return 1;
}


# private functions
sub _plural {
    my ($class, $number, $single, $plural) = @_;

    return $number == 1 ? $single : defined $plural ? $plural : "${single}s";
}

sub _parse_jpath {
    my ($jpath_str) = @_;

    my $jpath = JSON::Path->new($jpath_str);
    if ($@) {
        die "Error evaluating json path ($jpath_str): $@";
    }

   return $jpath;
}


1;
__END__