libtest-json-perl 0.11-1 / usr / share / perl5 / Test / JSON.pm

This file is indexed.

/usr/share/perl5/Test/JSON.pm is in libtest-json-perl 0.11-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below. 

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
package Test::JSON;

use strict;
use Carp;
use Test::Differences;
use JSON::Any;

use base 'Test::Builder::Module';
our @EXPORT = qw/is_json is_valid_json/;

=head1 NAME

Test::JSON - Test JSON data

=head1 VERSION

Version 0.11

=cut

our $VERSION = '0.11';

my $JSON = JSON::Any->new;

=head1 SYNOPSIS

 use Test::JSON;

 is_valid_json $json,                 '... json is well formed';
 is_json       $json, $expected_json, '... and it matches what we expected';

=head1 EXPORT

=over 4

=item * is_valid_json

=item * is_json

=back

=head1 DESCRIPTION

JavaScript Object Notation (JSON) is a lightweight data interchange format.
L<Test::JSON> makes it easy to verify that you have built valid JSON and that
it matches your expected output.

See L<http://www.json.org/> for more information.

=head1 TESTS

=head2 is_valid_json

 is_valid_json $json, '... json is well formed';

Test passes if the string passed is valid JSON.

=head2 is_json

 is_json $json, $expected_json, '... and it matches what we expected';

Test passes if the two JSON strings are valid JSON and evaluate to the same
data structure.

L<Test::Differences> is used to provide easy diagnostics of why the JSON
structures did not match.  For example:

   Failed test '... and identical JSON should match'
   in t/10testjson.t at line 14.
 +----+---------------------------+---------------------------+
 | Elt|Got                        |Expected                   |
 +----+---------------------------+---------------------------+
 |   0|{                          |{                          |
 |   1|  bool => '1',             |  bool => '1',             |
 |   2|  description => bless( {  |  description => bless( {  |
 |   3|    value => undef         |    value => undef         |
 |   4|  }, 'JSON::NotString' ),  |  }, 'JSON::NotString' ),  |
 |   5|  id => '1',               |  id => '1',               |
 *   6|  name => 'foo'            |  name => 'fo'             *
 |   7|}                          |}                          |
 +----+---------------------------+---------------------------+

=cut

sub is_valid_json ($;$) {
    my ( $input, $test_name ) = @_;
    croak "usage: is_valid_json(input,test_name)"
      unless defined $input;
    eval { $JSON->decode($input) };
    my $test = __PACKAGE__->builder;
    if ( my $error = $@ ) {
        $test->ok( 0, $test_name );
        $test->diag("Input was not valid JSON:\n\n\t$error");
        return;
    }
    else {
        $test->ok( 1, $test_name );
        return 1;
    }
}

sub is_json ($$;$) {
    my ( $input, $expected, $test_name ) = @_;
    croak "usage: is_json(input,expected,test_name)"
      unless defined $input && defined $expected;

    my %json_for;
    foreach my $item ( [ input => $input ], [ expected => $expected ] ) {
        my $json = eval { $JSON->decode( $item->[1] ) };
        my $test = __PACKAGE__->builder;
        if ( my $error = $@ ) {
            $test->ok( 0, $test_name );
            $test->diag("$item->[0] was not valid JSON: $error");
            return;
        }
        else {
            $json_for{ $item->[0] } = $json;
        }
    }
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    eq_or_diff( $json_for{input}, $json_for{expected}, $test_name );
}

=head1 AUTHOR

Curtis "Ovid" Poe, C<< <ovid@cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to
C<bug-test-json@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-JSON>.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 SEE ALSO

This test module uses L<JSON::Any> and L<Test::Differences>.

=head1 ACKNOWLEDGEMENTS

The development of this module was sponsored by Kineticode,
L<http://www.kineticode.com/>, the leading provider of services for the
Bricolage content management system, L<http://www.bricolage.cc/>.

Thanks to Makamaka Hannyaharamitu C<makamaka@cpan.org> for a patch to make
this work with JSON 2.0.

Thanks to Stevan Little for suggesting a switch to L<JSON::Any>.  This makes
it easier for this module to work with whatever JSON module you have
installed.

=head1 COPYRIGHT & LICENSE

Copyright 2005-2007 Curtis "Ovid" Poe, all rights reserved.

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

=cut

1;

APT Browse - Built by Thomas Orozco.