JSON-DWIW-0.33/ 0000755 0000764 0000764 00000000000 11216640546 011117 5 ustar don don JSON-DWIW-0.33/t/ 0000755 0000764 0000764 00000000000 11216640546 011362 5 ustar don don JSON-DWIW-0.33/t/deser01.t 0000755 0000764 0000764 00000007245 11173264050 013017 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-02-20 21:54:09
# Authors: don
use strict;
use warnings;
use Test;
# main
{
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 13;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $json_str = '{"var1":"val1","var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}],"var3":"val3"}';
my $data = JSON::DWIW::deserialize($json_str);
# complex value
my $pass = 1;
if ($data->{var1} eq 'val1' and $data->{var3} eq 'val3') {
if ($data->{var2}) {
my $array = $data->{var2};
if (ref($array) eq 'ARRAY') {
if ($array->[0] eq 'first_element') {
my $hash = $array->[1];
if (ref($hash) eq 'HASH') {
unless ($hash->{sub_element} eq 'sub_val'
and $hash->{sub_element2} eq 'sub_val2') {
$pass = 0;
}
}
else {
$pass = 0;
}
}
else {
$pass = 0;
}
}
else {
$pass = 0;
}
}
else {
$pass = 0;
}
}
ok($pass);
# string
$json_str = '"val1"';
$data = JSON::DWIW::deserialize($json_str);
ok($data eq 'val1');
# numbers
$json_str = '567';
$data = JSON::DWIW::deserialize($json_str);
ok($data == 567);
$json_str = "5e1";
$data = JSON::DWIW::deserialize($json_str);
ok($data == 50);
$json_str = "5e3";
$data = JSON::DWIW::deserialize($json_str);
ok($data == 5000);
$json_str = "5e+1";
$data = JSON::DWIW::deserialize($json_str);
ok($data == 50);
$json_str = "5e-1";
$data = JSON::DWIW::deserialize($json_str);
ok($data == 0.5);
# empty array
$json_str = '[]';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'ARRAY' and scalar(@$data) == 0);
# empty hash
$json_str = '{}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 0);
# empty array as value in hash
$json_str = '{"test_empty":[]}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1 and ref($data->{test_empty}) eq 'ARRAY'
and scalar(@{$data->{test_empty}}) == 0);
# empty hash as value in a hash
$json_str = '{"test_empty":{}}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1 and ref($data->{test_empty}) eq 'HASH'
and scalar(keys %{$data->{test_empty}}) == 0);
$json_str = '{"test_empty_hash":{},"test_empty_array":[]}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 2
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0
and ref($data->{test_empty_array}) eq 'ARRAY'
and scalar(@{$data->{test_empty_array}}) == 0
);
# comment
$json_str = '{"test_empty_hash":{} /*,"test_empty_array":[] */}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/deser04_exceptions.t 0000755 0000764 0000764 00000001232 11173264050 015251 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-04-04 21:57:58
# Authors: don
use strict;
use Test;
# main
{
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 1;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
local $SIG{__DIE__};
my $bad_str = '{"stuff":blah}';
eval { my $data = JSON::DWIW::deserialize($bad_str, { use_exceptions => 1 }); };
ok($@);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/deser02_constants.t 0000755 0000764 0000764 00000001531 11173264050 015104 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-03-20 18:01:54
# Authors: don
use strict;
use warnings;
use Test;
# main
{
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 4;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $json_str = '{"var1":true,"var2":false,"var3":null}';
my $data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH');
ok(ref($data) eq 'HASH' and $data->{var1});
ok(ref($data) eq 'HASH' and not $data->{var2});
ok(ref($data) eq 'HASH' and exists($data->{var3}) and not defined($data->{var3}));
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/deser11_file.t 0000755 0000764 0000764 00000007164 11173264050 014017 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-09-12 19:27:49
# Authors: don
use strict;
use warnings;
use Test;
# main
{
use JSON::DWIW;
if (JSON::DWIW::skip_deserialize_file()) {
plan tests => 1;
skip("Not ready for production", 0);
exit 0;
}
else {
plan tests => 22;
}
my $data = JSON::DWIW::deserialize_file("t/parse_file/pass0.json");
ok($data and $data->{var1} eq 'val1');
$data = JSON::DWIW::deserialize_file("t/parse_file/pass0.json");
ok($data and $data->{var1} eq 'val1');
my $error = JSON::DWIW->get_error_string;
$data = JSON::DWIW::deserialize_file("t/parse_file/pass0.json");
$error = JSON::DWIW->get_error_string;
ok(not $error and $data and $data->{var1} eq 'val1');
$data = JSON::DWIW::deserialize_file("t/non_existent_file.json");
$error = JSON::DWIW->get_error_string;
ok($error and $error =~ /couldn't open input file/);
$data = JSON::DWIW::deserialize_file("t/parse_file/pass1.json");
$error = JSON::DWIW->get_error_string;
ok($data and not $error);
$data = JSON::DWIW::deserialize_file("t/parse_file/pass2.json");
$error = JSON::DWIW->get_error_string;
ok($data and not $error);
$data = JSON::DWIW::deserialize_file("t/parse_file/pass3.json");
$error = JSON::DWIW->get_error_string;
ok($data and not $error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail2.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail2.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail2.json");
$error = JSON::DWIW->get_error_string;
ok($error);
# $data = JSON::DWIW::deserialize_file("t/parse_file/fail7.json");
# $error = JSON::DWIW->get_error_string;
# ok($error);
# $data = JSON::DWIW::deserialize_file("t/parse_file/fail8.json");
# $error = JSON::DWIW->get_error_string;
# ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail10.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail11.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail12.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail14.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail16.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail19.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail20.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail21.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail22.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail31.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail32.json");
$error = JSON::DWIW->get_error_string;
ok($error);
$data = JSON::DWIW::deserialize_file("t/parse_file/fail33.json");
$error = JSON::DWIW->get_error_string;
ok($error);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/01encode.t 0000755 0000764 0000764 00000006243 11173264050 013147 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-02-20 19:51:06
# Authors: don
use strict;
use Test;
# main
{
BEGIN { plan tests => 14 }
use JSON::DWIW;
my $data;
# my $expected_str = '{"var1":"val1","var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}],"var3":"val3"}';
my $expected_str1 = '{"var1":"val1","var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}]}';
my $expected_str2 = '{"var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}],"var1":"val1"}';
my $expected_str3 = '{"var2":["first_element",{"sub_element2":"sub_val2","sub_element":"sub_val"}],"var1":"val1"}';
my $expected_str4 = '{"var1":"val1","var2":["first_element",{"sub_element2":"sub_val2","sub_element":"sub_val"}]}';
my $json_obj = JSON::DWIW->new;
my $json_str;
# print STDERR "\n" . $json_str . "\n\n";
my $expected_str;
$data = 'stuff';
$json_str = $json_obj->to_json($data);
ok($json_str eq '"stuff"');
$data = "stu\nff";
$json_str = $json_obj->to_json($data);
ok($json_str eq '"stu\nff"');
$data = [ 1, 2, 3 ];
$expected_str = '[1,2,3]';
$json_str = $json_obj->to_json($data);
ok($json_str eq $expected_str);
$data = { var1 => 'val1', var2 => 'val2' };
$json_str = $json_obj->to_json($data);
ok($json_str eq '{"var1":"val1","var2":"val2"}'
or $json_str eq '{"var2":"val2","var1":"val1"}');
$data = { var1 => 'val1',
var2 => [ 'first_element',
{ sub_element => 'sub_val', sub_element2 => 'sub_val2' },
],
# var3 => 'val3',
};
$json_str = $json_obj->to_json($data);
ok($json_str eq $expected_str1 or $json_str eq $expected_str2
or $json_str eq $expected_str3 or $json_str eq $expected_str4);
$data = '';
$json_str = $json_obj->to_json($data);
ok($json_str eq '""');
$data = { str => '' };
$json_str = $json_obj->to_json($data);
ok($json_str eq '{"str":""}');
$data = [ "1", "" ];
$json_str = $json_obj->to_json($data);
ok($json_str eq '["1",""]');
$data = undef;
$json_str = $json_obj->to_json($data);
ok($json_str eq 'null');
$data = [undef];
$json_str = $json_obj->to_json($data);
ok($json_str eq '[null]');
$data = { var => undef };
$json_str = $json_obj->to_json($data);
ok($json_str eq '{"var":null}');
$data = {
body => 'foo blarg adfasdf',
};
$json_str = $json_obj->to_json($data);
ok($json_str eq '{"body":"foo blarg adfasdf<\/a>"}');
$data = { stuff => "Don's test string" };
$json_str = $json_obj->to_json($data);
ok($json_str eq q{{"stuff":"Don's test string"}});
$data = { stuff => "http://example.com/" };
$json_str = $json_obj->to_json($data);
$json_str = $json_obj->to_json({ test => $json_str });
ok($json_str eq '{"test":"{\\"stuff\\":\\"http:\\\\\\/\\\\\\/example.com\\\\\\/\\"}"}');
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/05exceptions.t 0000755 0000764 0000764 00000002116 11174234461 014076 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-04-04 21:57:58
# Authors: don
use strict;
use Test;
# main
{
BEGIN { plan tests => 4 };
use JSON::DWIW;
my $converter = JSON::DWIW->new({ use_exceptions => 1 });
local $SIG{__DIE__};
my $bad_str = '{"stuff":}';
eval { my $data = $converter->from_json($bad_str); };
ok($@);
eval { my $data = JSON::DWIW->from_json($bad_str, { use_exceptions => 1 }); };
ok($@);
eval { my $data = JSON::DWIW::from_json($bad_str, { use_exceptions => 1 }); };
ok($@);
my $bad_data = { stuff => "\xf5blah" };
# {
# local $SIG{__WARN__} = sub {
# my $msg = shift;
# if ($msg =~ /malformed\s+utf-8/i) {
# # don't print the message
# return;
# }
# else {
# warn $msg;
# return;
# }
# };
eval { my $str = $converter->to_json($bad_data); };
# }
ok($@);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/tickets.t 0000755 0000764 0000764 00000001713 11173264050 013214 0 ustar don don #!/usr/bin/env perl
# Creation date: 2008-03-26 07:19:22
# Authors: don
use strict;
use warnings;
use Test;
BEGIN { plan tests => 4 }
use JSON::DWIW;
my $json_str;
my $data;
# rt.cpan.org #33121 -- "Escaped quotes cause JSON::DWIW::deserialize to crash Perl"
JSON::DWIW::deserialize( q([{'aaaaaa':"bbbbbbbbbbbbbbb\\"ccccc\\"dd"}]) );
ok(1); # used to abort here on Linux
# rt.cpan.org #34285 -- accept hex escape sequences
$json_str = '{"key":"\x76al"}';
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq 'val');
# rt.cpan.org #34320 -- accept $ in bare keys
$json_str = '{$var1:true,var2:false,var3:null}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and $data->{'$var1'} and not $data->{var2}
and exists($data->{var3}) and not defined($data->{var3}));
# rt.cpan.org #37541 - parsing -1.555555 returns a "not a digit error"
$json_str = "[-1.555555, 5]";
$data = JSON::DWIW->from_json($json_str);
ok($data);
JSON-DWIW-0.33/t/04extras.t 0000755 0000764 0000764 00000007365 11173264050 013231 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-03-20 18:01:54
# Authors: don
use strict;
use warnings;
use Test;
# main
{
BEGIN { plan tests => 24 }
use JSON::DWIW;
# bare keys (called as class method)
my $json_str = '{var1:true,var2:false,var3:null}';
my $data = JSON::DWIW->from_json($json_str);
ok(ref($data) eq 'HASH');
ok(ref($data) eq 'HASH' and $data->{var1});
ok(ref($data) eq 'HASH' and not $data->{var2});
ok(ref($data) eq 'HASH' and exists($data->{var3}) and not defined($data->{var3}));
$json_str = '{$var1:true,var2:false,var3:null}';
$data = JSON::DWIW->from_json($json_str);
ok(ref($data) eq 'HASH' and $data->{'$var1'} and not $data->{var2}
and exists($data->{var3}) and not defined($data->{var3}));
$json_str = '{_var1_:true,var2:false,var3:null}';
$data = JSON::DWIW->from_json($json_str);
ok(ref($data) eq 'HASH' and $data->{'_var1_'} and not $data->{var2}
and exists($data->{var3}) and not defined($data->{var3}));
# call as subroutine (possible imported)
$json_str = '{var1:true,var2:false,var3:null}';
$data = JSON::DWIW::from_json($json_str);
ok(ref($data) eq 'HASH');
ok(ref($data) eq 'HASH' and $data->{var1});
ok(ref($data) eq 'HASH' and not $data->{var2});
ok(ref($data) eq 'HASH' and exists($data->{var3}) and not defined($data->{var3}));
# call as instance method
my $json_obj = JSON::DWIW->new;
$json_str = '{var1:true,var2:false,var3:null}';
$data = $json_obj->from_json($json_str);
ok(ref($data) eq 'HASH');
ok(ref($data) eq 'HASH' and $data->{var1});
ok(ref($data) eq 'HASH' and not $data->{var2});
ok(ref($data) eq 'HASH' and exists($data->{var3}) and not defined($data->{var3}));
# extra commas
$json_str = '{,"var1":true,,"var2":false,"var3":null,, ,}';
$data = JSON::DWIW->from_json($json_str);
ok(ref($data) eq 'HASH');
ok(ref($data) eq 'HASH' and $data->{var1});
ok(ref($data) eq 'HASH' and not $data->{var2});
ok(ref($data) eq 'HASH' and exists($data->{var3}) and not defined($data->{var3}));
# C++ style comments
$json_str = '{"test_empty_hash":{} ' . "\n" . '//,"test_empty_array":[] ' . "\n" . '}';
$data = JSON::DWIW->from_json($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0);
# encoding bare keys
$json_obj = JSON::DWIW->new({ bare_keys => 1 });
$data = { var1 => "val2" };
$json_str = $json_obj->to_json($data);
ok($json_str eq '{var1:"val2"}');
$json_str = JSON::DWIW->to_json($data, { bare_keys => 1 });
ok($json_str eq '{var1:"val2"}');
$json_str = JSON::DWIW::to_json($data, { bare_keys => 1 });
ok($json_str eq '{var1:"val2"}');
$data = { var => "stuff\xe9stuff" };
undef $json_str;
{
local $SIG{__WARN__} = sub { };
$json_str = JSON::DWIW->to_json($data, { bad_char_policy => 'convert',
escape_multi_byte => 1,
});
}
ok($json_str eq '{"var":"stuff\u00e9stuff"}');
# make sure no elements are left out when pretty-printing
# (bug in version 0.12)
$data = { var1 => 'val1', var2 => { stuff1 => 'content2', stuff2 => 1 }, var3 => 'val3',
var4 => [ 'test1', 'test2', 'test3' ]};
$json_str = JSON::DWIW->to_json($data, { pretty => 1 });
$data = JSON::DWIW->from_json($json_str);
ok(scalar(@{ $data->{var4} }) == 3 and $data->{var2}{stuff1} and $data->{var2}{stuff2}
and scalar(keys(%$data)) == 4);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/encode01.t 0000755 0000764 0000764 00000001212 11173264050 013136 0 ustar don don #!/usr/bin/env perl
# Creation date: 2008-06-21T02:18:22Z
# Authors: don
use strict;
use warnings;
use Test;
BEGIN { plan tests => 4 }
use JSON::DWIW;
my $json_obj = JSON::DWIW->new({ detect_circular_refs => 1 });
my $data = { blah => 1 };
my $data2 = { foo => 'bar', data => $data };
$data->{data2} = $data2;
my $str = $json_obj->to_json($data);
ok(defined($str) and not $json_obj->get_error_string);
$str = JSON::DWIW->to_json($data, { detect_circular_refs => 1 });
ok(defined($str) and not JSON::DWIW->get_error_string);
ok(defined($str));
my $r_data = JSON::DWIW::deserialize($str);
ok(not defined(JSON::DWIW->get_error_string));
JSON-DWIW-0.33/t/deser08_stats.t 0000644 0000764 0000764 00000002620 11173264050 014231 0 ustar don don #!/usr/bin/env perl
use Test;
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 24;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $str = '{"key":"val","num":4}';
my $data = JSON::DWIW::deserialize($str);
my $stats = JSON::DWIW->get_stats;
ok($stats->{hashes} == 1);
ok($stats->{arrays} == 0);
ok($stats->{strings} == 3);
ok($stats->{numbers} == 1);
ok($stats->{bools} == 0);
ok($stats->{nulls} == 0);
$str = '{"array":[ 4, 3, 2]}';
$data = JSON::DWIW::deserialize($str);
$stats = JSON::DWIW->get_stats;
ok($stats->{hashes} == 1);
ok($stats->{arrays} == 1);
ok($stats->{strings} == 1);
ok($stats->{numbers} == 3);
ok($stats->{bools} == 0);
ok($stats->{nulls} == 0);
$str = '{"var1":null,"test":true,"test2":false}';
$data = JSON::DWIW::deserialize($str);
$stats = JSON::DWIW->get_stats;
ok($stats->{hashes} == 1);
ok($stats->{arrays} == 0);
ok($stats->{strings} == 3);
ok($stats->{numbers} == 0);
ok($stats->{bools} == 2);
ok($stats->{nulls} == 1);
$str = '{"var1":null,"test":true,"test2":false,"hash":{"key1":"val1"}}';
$data = JSON::DWIW::deserialize($str);
$stats = JSON::DWIW->get_stats;
ok($stats->{hashes} == 2);
ok($stats->{arrays} == 0);
ok($stats->{strings} == 6);
ok($stats->{numbers} == 0);
ok($stats->{bools} == 2);
ok($stats->{nulls} == 1);
JSON-DWIW-0.33/t/06big_numbers.t 0000755 0000764 0000764 00000004051 11173264050 014206 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-04-07 17:08:45
# Authors: don
use strict;
use Test;
# main
{
use JSON::DWIW;
my $converter = JSON::DWIW->new;
local $SIG{__DIE__};
my $have_big_int = JSON::DWIW->have_big_int;
my $have_big_float = JSON::DWIW->have_big_float;
my $num_tests = 1;
if ($have_big_int) {
$num_tests += 3;
}
else {
$num_tests += 1;
}
if ($have_big_float) {
$num_tests += 1;
}
else {
$num_tests += 1;
}
plan tests => $num_tests;
my $str = '{"stuff":42949672954294967295}';
my $data = $converter->from_json($str);
ok($data->{stuff} =~ /\A\+?42949672954294967295\Z/);
if ($have_big_int) {
my $big_int = Math::BigInt->new('42949672954294967295');
$str = $converter->to_json($big_int);
ok($str eq '42949672954294967295');
ok(($data->{stuff} + 500) . '' =~ /\A\+?42949672954294967795\Z/);
$data = { stuff => Math::BigInt->new('340282366920938463463374607431768211456') }; # 2^128
$str = $converter->to_json($data);
ok($str eq '{"stuff":340282366920938463463374607431768211456}');
}
else {
skip("don't have Math::BigInt", 0);
}
if ($have_big_float) {
$data = { stuff => Math::BigFloat->new('115792089237316195423570985008687907853269984665640564039457584007913129639936') }; # 2^256
$str = $converter->to_json($data);
ok($str eq '{"stuff":115792089237316195423570985008687907853269984665640564039457584007913129639936}');
# my $val = Math::BigFloat->new('2');
# $data = { stuff => $val ** 512 };
# $str = $converter->to_json($data);
# ok($str eq '{"stuff":13407807929942597099574024998205846127479365820592393377723561443721764030073546976801874298166903427690031858186486050853753882811946569946433649006084096}');
}
else {
skip("don't have Math::BigFloat", 0);
}
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/13stats.t 0000644 0000764 0000764 00000003415 11173264050 013046 0 ustar don don #!/usr/bin/env perl
use Test;
BEGIN { plan tests => 27 }
use JSON::DWIW;
my $str = '{"key":"val","num":4}';
my $data = JSON::DWIW->from_json($str);
my $stats = JSON::DWIW->get_stats;
ok($stats->{hashes} == 1);
ok($stats->{arrays} == 0);
ok($stats->{strings} == 3);
ok($stats->{numbers} == 1);
ok($stats->{bools} == 0);
ok($stats->{nulls} == 0);
$str = '{"array":[ 4, 3, 2]}';
$data = JSON::DWIW->from_json($str);
$stats = JSON::DWIW->get_stats;
ok($stats->{hashes} == 1);
ok($stats->{arrays} == 1);
ok($stats->{strings} == 1);
ok($stats->{numbers} == 3);
ok($stats->{bools} == 0);
ok($stats->{nulls} == 0);
$str = '{"var1":null,"test":true,"test2":false}';
$data = JSON::DWIW->from_json($str);
$stats = JSON::DWIW->get_stats;
ok($stats->{hashes} == 1);
ok($stats->{arrays} == 0);
ok($stats->{strings} == 3);
ok($stats->{numbers} == 0);
ok($stats->{bools} == 2);
ok($stats->{nulls} == 1);
$str = '{"var1":null,"test":true,"test2":false,"hash":{"key1":"val1"}}';
$data = JSON::DWIW->from_json($str);
$stats = JSON::DWIW->get_stats;
ok($stats->{hashes} == 2);
ok($stats->{arrays} == 0);
ok($stats->{strings} == 6);
ok($stats->{numbers} == 0);
ok($stats->{bools} == 2);
ok($stats->{nulls} == 1);
$str = '[{"key_2":[[{"key_5":{"key_6":[[{"key_9":[[{"key_12":{"key_13":[{"key_15":[{"key_17":{"key_18":{"key_19":[{"key_21":{"key_22":[[{"key_25":{"key_26":{"key_27":[{"key_29":{"key_30":[[{"key_33":{"key_34":{"key_35":{"key_36":{"key_37":[{"key_39":{"key_40":[{"key_42":[{"key_44":[{"key_46":[[{"key_49":[[[{"key_53":[[{"key_56":[[[[[{"key_62":[{"key_64":{"key_65":[[[[{}]]]]}}]}]]]]]}]]}]]]}]]}]}]}]}}]}}}}}]]}}]}}}]]}}]}}}]}]}}]]}]]}}]]}]';
$data = JSON::DWIW->from_json($str);
$stats = JSON::DWIW->get_stats;
ok($stats->{max_depth} == 70);
ok($stats->{arrays} == 36);
ok($stats->{hashes} == 34);
JSON-DWIW-0.33/t/02decode.t 0000755 0000764 0000764 00000010135 11173264050 013131 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-02-20 21:54:09
# Authors: don
use strict;
use warnings;
use Test;
# main
{
BEGIN { plan tests => 15 }
use JSON::DWIW;
my $json_str = '{"var1":"val1","var2":["first_element",{"sub_element":"sub_val","sub_element2":"sub_val2"}],"var3":"val3"}';
my $json_obj = JSON::DWIW->new;
my $data = $json_obj->from_json($json_str);
# complex value
my $pass = 1;
if ($data->{var1} eq 'val1' and $data->{var3} eq 'val3') {
if ($data->{var2}) {
my $array = $data->{var2};
if (ref($array) eq 'ARRAY') {
if ($array->[0] eq 'first_element') {
my $hash = $array->[1];
if (ref($hash) eq 'HASH') {
unless ($hash->{sub_element} eq 'sub_val'
and $hash->{sub_element2} eq 'sub_val2') {
$pass = 0;
}
}
else {
$pass = 0;
}
}
else {
$pass = 0;
}
}
else {
$pass = 0;
}
}
else {
$pass = 0;
}
}
ok($pass);
# string
$json_str = '"val1"';
$data = $json_obj->from_json($json_str);
ok($data eq 'val1');
# numbers
$json_str = '567';
$data = $json_obj->from_json($json_str);
ok($data == 567);
$json_str = "5e1";
$data = $json_obj->from_json($json_str);
ok($data == 50);
$json_str = "5e3";
$data = $json_obj->from_json($json_str);
ok($data == 5000);
$json_str = "5e+1";
$data = $json_obj->from_json($json_str);
ok($data == 50);
$json_str = "5e-1";
$data = $json_obj->from_json($json_str);
ok($data == 0.5);
# empty array
$json_str = '[]';
$data = $json_obj->from_json($json_str);
ok(ref($data) eq 'ARRAY' and scalar(@$data) == 0);
# empty hash
$json_str = '{}';
$data = $json_obj->from_json($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 0);
# empty array as value in hash
$json_str = '{"test_empty":[]}';
$data = $json_obj->from_json($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1 and ref($data->{test_empty}) eq 'ARRAY'
and scalar(@{$data->{test_empty}}) == 0);
# empty hash as value in a hash
$json_str = '{"test_empty":{}}';
$data = $json_obj->from_json($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1 and ref($data->{test_empty}) eq 'HASH'
and scalar(keys %{$data->{test_empty}}) == 0);
$json_str = '{"test_empty_hash":{},"test_empty_array":[]}';
$data = $json_obj->from_json($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 2
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0
and ref($data->{test_empty_array}) eq 'ARRAY'
and scalar(@{$data->{test_empty_array}}) == 0
);
# C style comment
$json_str = '{"test_empty_hash":{} /*,"test_empty_array":[] */}';
$data = $json_obj->from_json($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0);
# C++ style comments
$json_str = '{"test_empty_hash":{} ' . "\n" . '//,"test_empty_array":[] ' . "\n" . '}';
$data = JSON::DWIW->from_json($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0);
# Perl, shell, etc., style comments
$json_str = '{"test_empty_hash":{} ' . "\n" . '#,"test_empty_array":[] ' . "\n" . '}';
$data = JSON::DWIW->from_json($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/14nonoo.t 0000755 0000764 0000764 00000001461 11173264050 013043 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-11-08 19:36:33
# Authors: don
use strict;
use warnings;
use Test;
BEGIN { plan tests => 5 };
use JSON::DWIW qw/deserialize_json from_json/;
my $json = '{"var1":"val1"}';
my $data = { var1 => 'val1' };
my $stats;
my $deser_skip = JSON::DWIW->has_deserialize ? '' : 'Skip -- deserialize not available';
unless ($deser_skip) {
$data = JSON::DWIW::deserialize($json);
$stats = JSON::DWIW::get_stats();
}
skip($deser_skip, ($data and $data->{var1} eq 'val1'));
skip($deser_skip, ($stats and $stats->{strings} == 2 and $stats->{hashes} == 1));
my $str = JSON::DWIW::serialize($data);
ok($str and $str eq '{"var1":"val1"}');
$data = deserialize_json($json);
ok($data and $data->{var1} eq 'val1');
$data = from_json($json);
ok($data and $data->{var1} eq 'val1');
JSON-DWIW-0.33/t/from_json01_escapes.t 0000755 0000764 0000764 00000005051 11173264050 015405 0 ustar don don #!/usr/bin/env perl
# Creation date: 2008-03-22 18:24:04
# Authors: don
use strict;
use warnings;
use Test;
BEGIN { plan tests => 26 }
use JSON::DWIW;
my $json_str = '{"key":"\x76al"}';
ok($json_str =~ /x/); # make sure no programmer error -- want the string to have \x76 in it
my $data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq 'val');
$json_str = '{"key":"\u0076al"}';
ok($json_str =~ /u/); # make sure no programmer error -- want the string to have \u0076 in it
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq 'val');
# \u706b should convert to the octet sequence \xe7\x81\xab
$json_str = '{"key":"val\u706b4_1"}';
ok($json_str =~ /u/); # make sure no programmer error -- want the string to have \u706b in it
$data = JSON::DWIW->from_json($json_str);
{
# be sure to compare byte by byte
use bytes;
ok($data and $data->{key} eq "val\xe7\x81\xab4_1");
}
# backspace
$json_str = '{"key":"val\b"}';
ok($json_str =~ /b/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x08");
# line feed
$json_str = '{"key":"val\n"}';
ok($json_str =~ /n/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x0a");
# vertical tab
$json_str = '{"key":"bal\v"}';
ok($json_str =~ /v/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "bal\x0b");
# form feed
$json_str = '{"key":"val\f"}';
ok($json_str =~ /f/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x0c");
# carriage return
$json_str = '{"key":"val\r"}';
ok($json_str =~ /r/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x0d");
# tab
$json_str = '{"key":"val\t"}';
ok($json_str =~ /t/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x09");
# backslash
$json_str = '{"key":"val\\\\"}';
ok($json_str =~ /\x5c\x5c/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x5c");
# slash/solidus
$json_str = '{"key":"val\\/"}';
ok($json_str =~ /\x5c\x2f/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x2f");
# double quote
$json_str = '{"key":"val\""}';
ok($json_str =~ /\x5c\x22/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x22");
# single quote
$json_str = '{"key":"val\\\'"}';
ok($json_str =~ /\x5c\x27/); # dummy check
$data = JSON::DWIW->from_json($json_str);
ok($data and $data->{key} eq "val\x27");
JSON-DWIW-0.33/t/08pvxv.t 0000755 0000764 0000764 00000001542 11173264050 012721 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-04-17 20:39:26
# Authors: don
# Test scalars that have types indicating they can be either a string or another type
use strict;
# main
{
use Test;
plan tests => 3;
use JSON::DWIW;
# SVt_PVIV
my $data = {};
$data->{test_var} = 0;
$data->{test_var} = 'blah';
my $str = JSON::DWIW->to_json($data);
ok($str eq '{"test_var":"blah"}');
my $data2 = {};
my $test_val = 0;
$test_val = 'blah';
$data2->{test_var} = $test_val;
$str = JSON::DWIW->to_json($data2);
ok($str eq '{"test_var":"blah"}');
# SVt_PVNV
$data2 = { test_var => 0.5 };
$data2->{test_var} = 'blah';
$str = JSON::DWIW->to_json($data2);
ok($str eq '{"test_var":"blah"}');
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/09bool.t 0000755 0000764 0000764 00000002606 11173264050 012654 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-05-10 21:02:13
# Authors: don
use strict;
use Test;
# main
{
plan tests => 8;
use JSON::DWIW;
my $data;
my $str;
$data = { var1 => JSON::DWIW::Boolean->true, };
$str = JSON::DWIW->to_json($data);
ok($str eq '{"var1":true}');
$data = { var1 => JSON::DWIW::Boolean->false, };
$str = JSON::DWIW->to_json($data);
ok($str eq '{"var1":false}');
$data = { var1 => JSON::DWIW->true, };
$str = JSON::DWIW->to_json($data);
ok($str eq '{"var1":true}');
$data = { var1 => JSON::DWIW->false, };
$str = JSON::DWIW->to_json($data);
ok($str eq '{"var1":false}');
my $json_obj = JSON::DWIW->new;
$data = { var1 => JSON::DWIW::Boolean->true, };
$str = $json_obj->to_json($data);
ok($str eq '{"var1":true}');
$data = { var1 => JSON::DWIW::Boolean->false, };
$str = $json_obj->to_json($data);
ok($str eq '{"var1":false}');
$str = '{"var1":false}';
$data = JSON::DWIW->from_json($str, { convert_bool => 1 });
my $bool = $data->{var1};
ok(ref($bool) eq 'JSON::DWIW::Boolean' and not $bool);
$str = '{"var1":true}';
$data = JSON::DWIW->from_json($str, { convert_bool => 1 });
$bool = $data->{var1};
ok(ref($bool) eq 'JSON::DWIW::Boolean' and $bool);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/10unicode.t 0000755 0000764 0000764 00000003676 11173264050 013347 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-05-11 07:43:10
# Authors: don
use strict;
use Test;
# main
{
use JSON::DWIW;
my $tests = [ [ 0xe9, "\xc3\xa9" ], # LATIN SMALL LETTER E WITH ACUTE
[ 0xe8, "\xc3\xa8" ], # LATIN SMALL LETTER E WITH GRAVE
[ 0x1ec7, "\xe1\xbb\x87" ], # LATIN SMALL LETTER E WITH CIRCUMFLEX AND DOT BELOW
[ 0x4e2d, "\xe4\xb8\xad" ], # ZHONG1 (Chinese zhong1)
];
plan tests => 10 + scalar(@$tests);
ok(JSON::DWIW->is_valid_utf8("\x{706b}"));
ok(not JSON::DWIW->is_valid_utf8("\xe9s"));
my $str = "";
ok(not JSON::DWIW->flagged_as_utf8($str));
JSON::DWIW->flag_as_utf8($str);
ok(JSON::DWIW->flagged_as_utf8($str));
JSON::DWIW->unflag_as_utf8($str);
ok(not JSON::DWIW->flagged_as_utf8($str));
my $str1 = "blah";
my $str2 = "caf\xe9";
ok(JSON::DWIW->is_valid_utf8($str1));
ok(not JSON::DWIW->is_valid_utf8($str2));
JSON::DWIW->upgrade_to_utf8($str2);
ok(JSON::DWIW->is_valid_utf8($str2));
ok(JSON::DWIW->flagged_as_utf8($str2));
# JSON::DWIW->upgrade_to_utf8($str1);
# ok(JSON::DWIW->flagged_as_utf8($str1));
# ok(JSON::DWIW->is_valid_utf8($str1));
# Test utf8 sequences in hash keys. In Perl 5.8, a utf8 key
# that can be represented in latin1 will get converted to
# latin1 at the C layer, breaking things if it is not checked
# explicitly
my $utf8_str = "\xc3\xa4";
JSON::DWIW->flag_as_utf8($str);
my %hash;
$hash{$utf8_str} = 'blah';
my ($json_str, $error) = JSON::DWIW->to_json(\%hash);
ok(not $error);
foreach my $test (@$tests) {
$str = JSON::DWIW->code_point_to_utf8_str($test->[0]); # should be "\xc3\xa9"
{
use bytes;
ok($str eq $test->[1]);
}
}
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/deser13_escapes.t 0000755 0000764 0000764 00000005426 11173264050 014524 0 ustar don don #!/usr/bin/env perl
# Creation date: 2008-03-22 14:33:38
# Authors: don
use strict;
use warnings;
use Test;
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 26;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $json_str = '{"key":"\x76al"}';
ok($json_str =~ /x/); # make sure no programmer error -- want the string to have \x76 in it
my $data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq 'val');
$json_str = '{"key":"\u0076al"}';
ok($json_str =~ /u/); # make sure no programmer error -- want the string to have \u0076 in it
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq 'val');
# \u706b should convert to the octet sequence \xe7\x81\xab
$json_str = '{"key":"val\u706b4_1"}';
ok($json_str =~ /u/); # make sure no programmer error -- want the string to have \u706b in it
$data = JSON::DWIW::deserialize($json_str);
{
# be sure to compare byte by byte
use bytes;
ok($data and $data->{key} eq "val\xe7\x81\xab4_1");
}
# backspace
$json_str = '{"key":"val\b"}';
ok($json_str =~ /b/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x08");
# line feed
$json_str = '{"key":"val\n"}';
ok($json_str =~ /n/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x0a");
# vertical tab
$json_str = '{"key":"bal\v"}';
ok($json_str =~ /v/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "bal\x0b");
# form feed
$json_str = '{"key":"val\f"}';
ok($json_str =~ /f/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x0c");
# carriage return
$json_str = '{"key":"val\r"}';
ok($json_str =~ /r/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x0d");
# tab
$json_str = '{"key":"val\t"}';
ok($json_str =~ /t/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x09");
# backslash
$json_str = '{"key":"val\\\\"}';
ok($json_str =~ /\x5c\x5c/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x5c");
# slash/solidus
$json_str = '{"key":"val\\/"}';
ok($json_str =~ /\x5c\x2f/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x2f");
# double quote
$json_str = '{"key":"val\""}';
ok($json_str =~ /\x5c\x22/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x22");
# single quote
$json_str = '{"key":"val\\\'"}';
ok($json_str =~ /\x5c\x27/); # dummy check
$data = JSON::DWIW::deserialize($json_str);
ok($data and $data->{key} eq "val\x27");
JSON-DWIW-0.33/t/deser12_unicode.t 0000755 0000764 0000764 00000000722 11173264050 014520 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-12-27 20:51:49
# Authors: don
use strict;
use warnings;
use Test;
BEGIN { plan tests => 2 }
use JSON::DWIW;
my $str;
my $data;
# normal case
$str = qq{{"var":"\xc3\xa9"}};
$data = JSON::DWIW::deserialize($str);
ok($data and $data->{var} and JSON::DWIW->flagged_as_utf8($data->{var}));
$str = qq{{"var":"\xe9"}};
$data = JSON::DWIW::deserialize($str);
ok(not $data and JSON::DWIW->get_error_string =~ /bad utf-8/);
JSON-DWIW-0.33/t/deser05_big_numbers.t 0000755 0000764 0000764 00000004302 11173264050 015366 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-04-07 17:08:45
# Authors: don
use strict;
use Test;
# main
{
use JSON::DWIW;
unless (JSON::DWIW->has_deserialize) {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
local $SIG{__DIE__};
my $converter = JSON::DWIW->new;
my $have_big_int = JSON::DWIW->have_big_int;
my $have_big_float = JSON::DWIW->have_big_float;
my $num_tests = 1;
if ($have_big_int) {
# print STDERR "# have big int\n";
$num_tests += 1;
}
else {
$num_tests += 1;
}
if ($have_big_float) {
# print STDERR "# have big float\n";
$num_tests += 1;
}
else {
$num_tests += 1;
}
plan tests => $num_tests;
my $str = '{"stuff":42949672954294967295}';
my $data = JSON::DWIW::deserialize($str);
ok($data->{stuff} =~ /\A\+?42949672954294967295\Z/);
if ($have_big_int) {
my $num_str = '115792089237316195423570985008687907853269984665640564039457584007913129639936';
# my $big_int = Math::BigInt->new($num_str);
$str = qq{{"stuff":$num_str}};
$data = JSON::DWIW::deserialize($str);
ok($data->{stuff} =~ /\A\+?$num_str\Z/);
}
else {
skip("don't have Math::BigInt", 0);
}
if ($have_big_float) {
$data = { stuff => Math::BigFloat->new('115792089237316195423570985008687907853269984665640564039457584007913129639936') }; # 2^256
$str = $converter->to_json($data);
ok($str eq '{"stuff":115792089237316195423570985008687907853269984665640564039457584007913129639936}');
# my $val = Math::BigFloat->new('2');
# $data = { stuff => $val ** 512 };
# $str = $converter->to_json($data);
# ok($str eq '{"stuff":13407807929942597099574024998205846127479365820592393377723561443721764030073546976801874298166903427690031858186486050853753882811946569946433649006084096}');
}
else {
skip("don't have Math::BigFloat", 0);
}
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/deser06_bool.t 0000755 0000764 0000764 00000002217 11173264050 014031 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-05-10 21:02:13
# Authors: don
use strict;
use Test;
# main
{
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 4;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $data;
my $str;
$str = '{"var1":false}';
$data = JSON::DWIW::deserialize($str, { convert_bool => 1 });
my $bool = $data->{var1};
ok(ref($bool) eq 'JSON::DWIW::Boolean' and not $bool);
$str = '{"var1":true}';
$data = JSON::DWIW::deserialize($str, { convert_bool => 1 });
$bool = $data->{var1};
ok(ref($bool) eq 'JSON::DWIW::Boolean' and $bool);
# non conversions
$str = '{"var1":false}';
$data = JSON::DWIW::deserialize($str);
$bool = $data->{var1};
ok(not ref($bool));
$str = '{"var1":true}';
$data = JSON::DWIW::deserialize($str);
$bool = $data->{var1};
ok(not ref($bool));
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/11parse_file.t 0000755 0000764 0000764 00000005310 11173264050 014016 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-09-12 19:27:49
# Authors: don
use strict;
use warnings;
use Test;
# main
{
plan tests => 22;
use JSON::DWIW;
my $json_obj = JSON::DWIW->new;
my $data = $json_obj->from_json_file("t/parse_file/pass0.json");
ok($data and $data->{var1} eq 'val1');
$data = JSON::DWIW->from_json_file("t/parse_file/pass0.json");
ok($data and $data->{var1} eq 'val1');
my $error;
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/pass0.json");
ok(not $error and $data and $data->{var1} eq 'val1');
($data, $error) = JSON::DWIW->from_json_file("t/non_existent_file.json");
ok($error and $error =~ /couldn't open input file/);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/pass1.json");
ok($data and not $error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/pass2.json");
ok($data and not $error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/pass3.json");
ok($data and not $error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail2.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail2.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail2.json");
ok($error);
# ($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail7.json");
# ok($error);
# ($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail8.json");
# ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail10.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail11.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail12.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail14.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail16.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail19.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail20.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail21.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail22.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail31.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail32.json");
ok($error);
($data, $error) = JSON::DWIW->from_json_file("t/parse_file/fail33.json");
ok($error);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/03parse_constants.t 0000755 0000764 0000764 00000001147 11173264050 015120 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-03-20 18:01:54
# Authors: don
use strict;
use warnings;
use Test;
# main
{
BEGIN { plan tests => 4 }
use JSON::DWIW;
my $json_str = '{"var1":true,"var2":false,"var3":null}';
my $data = JSON::DWIW->from_json($json_str);
ok(ref($data) eq 'HASH');
ok(ref($data) eq 'HASH' and $data->{var1});
ok(ref($data) eq 'HASH' and not $data->{var2});
ok(ref($data) eq 'HASH' and exists($data->{var3}) and not defined($data->{var3}));
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/15bom.t 0000755 0000764 0000764 00000001602 11173264050 012466 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-11-30 21:41:48
# Authors: don
use strict;
use warnings;
use Test;
BEGIN { plan tests => 6 }
use JSON::DWIW;
my $str;
my $data;
$str = qq{\xEF\xBB\xBF{"stuff":"blah"}};
$data = JSON::DWIW->from_json($str);
ok($data and $data->{stuff} eq 'blah' and not JSON::DWIW->get_error_string);
$str = qq{\xFE\xFF{"stuff":"blah"}};
$data = JSON::DWIW->from_json($str);
ok(not defined($data) and JSON::DWIW->get_error_string);
$str = qq{\xFF\xFE{"stuff":"blah"}};
$data = JSON::DWIW->from_json($str);
ok(not defined($data) and JSON::DWIW->get_error_string);
$str = qq{\xFF\xFE\x00\x00{"stuff":"blah"}};
$data = JSON::DWIW->from_json($str);
ok(1); # still alive
ok(not defined($data) and JSON::DWIW->get_error_string);
$str = qq{\x00\x00\xFE\xFF{"stuff":"blah"}};
$data = JSON::DWIW->from_json($str);
ok(not defined($data) and JSON::DWIW->get_error_string);
JSON-DWIW-0.33/t/deser07_error.t 0000755 0000764 0000764 00000004222 11173264050 014226 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-10-02 18:51:38
# Authors: don
use strict;
use warnings;
# main
{
use Test;
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 19;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $str = qq{{"test":"\xc3\xa4","funky":"\\u70":"key":"val"}};
my ($data, $error);
$data = JSON::DWIW::deserialize($str);
$error = JSON::DWIW::get_error_string();
ok($error);
ok(defined $error and $error =~ /bad unicode character specification/);
ok(defined $error and $error =~ /char 25/);
ok(defined $error and $error =~ /byte 26/);
ok(defined $error and $error =~ /line 1/);
ok(defined $error and $error =~ /, col 25/);
ok(defined $error and $error =~ /byte col 26/);
ok(defined JSON::DWIW->get_error_string);
ok(defined $error and $error =~ /JSON::DWIW/);
$data = JSON::DWIW::deserialize($str);
$error = JSON::DWIW->get_error_string;
$str = qq{{"test":"\xc3\xa4",\n"funky":"\\u70":"key":"val"}};
$data = JSON::DWIW::deserialize($str);
$error = JSON::DWIW->get_error_string;
ok(defined $error and $error =~ /char 26/);
ok(defined $error and $error =~ /byte 27/);
ok(defined $error and $error =~ /line 2/);
ok(defined $error and $error =~ /, col 13/);
ok(defined $error and $error =~ /byte col 13/);
$str = qq{{"test":"\xc3\xa4","test2":"}};
$data = JSON::DWIW::deserialize($str);
$error = JSON::DWIW->get_error_string;
ok(defined $error and $error =~ /unterminated string/);
ok(defined $error and $error =~ /byte 22/);
ok(defined $error and $error =~ /char 21/);
ok(defined $error and $error =~ /byte col 22/);
$str = qq|{"var1":1,"var2":"val2","var3":[1,2,3,4,5], "test":true, "check":null}\n{"var4":"val4"}|;
$data = JSON::DWIW::deserialize($str);
$error = JSON::DWIW->get_error_string;
ok(defined $error);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/deser03_extras.t 0000755 0000764 0000764 00000010471 11173264050 014402 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-03-20 18:01:54
# Authors: don
use strict;
use warnings;
use Test;
# main
{
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 21;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $json_str;
my $data;
# bare keys
$json_str = '{var1:true,var2:false,var3:null}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH');
ok(ref($data) eq 'HASH' and $data->{var1});
ok(ref($data) eq 'HASH' and not $data->{var2});
ok(ref($data) eq 'HASH' and exists($data->{var3}) and not defined($data->{var3}));
$json_str = '{$var1:true,var2:false,var3:null}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and $data->{'$var1'} and not $data->{var2}
and exists($data->{var3}) and not defined($data->{var3}));
$json_str = '{_var1_:true,var2:false,var3:null}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and $data->{'_var1_'} and not $data->{var2}
and exists($data->{var3}) and not defined($data->{var3}));
# extra commas
$json_str = '{,"var1":true,,"var2":false,"var3":null,, ,}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH');
ok(ref($data) eq 'HASH' and $data->{var1});
ok(ref($data) eq 'HASH' and not $data->{var2});
ok(ref($data) eq 'HASH' and exists($data->{var3}) and not defined($data->{var3}));
# C style comments
$json_str = '{"test_empty_hash":{} /*,"test_empty_array":[] */}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0);
# C++ style comments
$json_str = '{"test_empty_hash":{} ' . "\n" . '//,"test_empty_array":[] ' . "\n" . '}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0);
# Perl, shell, etc., style comments
$json_str = '{"test_empty_hash":{} ' . "\n" . '#,"test_empty_array":[] ' . "\n" . '}';
$data = JSON::DWIW::deserialize($json_str);
ok(ref($data) eq 'HASH' and scalar(keys(%$data)) == 1
and ref($data->{test_empty_hash}) eq 'HASH'
and scalar(keys %{$data->{test_empty_hash}}) == 0);
# make sure no elements are left out when pretty-printing
# (bug in version 0.12)
$data = { var1 => 'val1', var2 => { stuff1 => 'content2', stuff2 => 1 }, var3 => 'val3',
var4 => [ 'test1', 'test2', 'test3' ]};
$json_str = JSON::DWIW->to_json($data, { pretty => 1 });
$data = JSON::DWIW::deserialize($json_str);
ok(scalar(@{ $data->{var4} }) == 3 and $data->{var2}{stuff1} and $data->{var2}{stuff2}
and scalar(keys(%$data)) == 4);
$json_str = 'true';
$data = JSON::DWIW::deserialize($json_str);
ok(not ref($data) and $data);
$json_str = 'false';
$data = JSON::DWIW::deserialize($json_str);
ok(not ref($data) and not $data);
$json_str = 'null';
$data = JSON::DWIW::deserialize($json_str);
ok(not defined($data) and not defined(JSON::DWIW->get_error_string));
$json_str = '567';
$data = JSON::DWIW::deserialize($json_str);
ok($data == 567);
# normal case
$json_str = qq{{"var":"\xc3\xa9"}};
$data = JSON::DWIW::deserialize($json_str);
printf "# ord = %#02x\n", ord($data->{var});
ok($data and ord($data->{var}) == 0xe9);
# needs converting case
$json_str = qq{{"var":"\xe9"}};
{
local $SIG{__WARN__} = sub { };
$data = JSON::DWIW::deserialize($json_str);
}
ok(not $data and defined(JSON::DWIW->get_error_string));
# needs converting case -- do the conversion
$json_str = qq{{"var":"\xe9"}};
{
local $SIG{__WARN__} = sub { };
$data = JSON::DWIW::deserialize($json_str, { bad_char_policy => 'convert' });
}
ok($data and ord($data->{var}) == 0xe9);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/07magic.t 0000755 0000764 0000764 00000005770 11173264050 013004 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-04-08 20:50:44
# Authors: don
use strict;
use Test;
# main
{
plan tests => 6;
use JSON::DWIW;
my $magic_scalar;
tie $magic_scalar, 'DummyTiedScalar';
my %magic_hash;
tie %magic_hash, 'DummyTiedHash';
my @magic_array;
tie @magic_array, 'DummyTiedArray';
my $data;
my $str;
$str = JSON::DWIW->to_json($magic_scalar);
ok($str eq '"fetched_val"');
$data = { var2 => $magic_scalar };
$str = JSON::DWIW->to_json($data);
ok($str eq '{"var2":"fetched_val"}');
$str = JSON::DWIW->to_json(\%magic_hash);
ok($str eq '{"var1":"val1"}');
$data = { magic_hash => \%magic_hash };
$str = JSON::DWIW->to_json($data);
ok($str eq '{"magic_hash":{"var1":"val1"}}');
$str = JSON::DWIW->to_json(\@magic_array);
ok($str eq '[1,2,3,4]' or $str eq '["1","2","3","4"]');
$data = { magic_array => \@magic_array };
$str = JSON::DWIW->to_json($data);
ok($str eq '{"magic_array":[1,2,3,4]}' or $str eq '{"magic_array":["1","2","3","4"]}');
}
exit 0;
###############################################################################
# Subroutines
{ package DummyTiedScalar;
sub new {
my $proto = shift;
my $scalar;
return bless \$scalar, ref($proto) || $proto;
}
sub TIESCALAR {
my $proto = shift;
return $proto->new(@_);
}
sub FETCH {
my $self = shift;
return 'fetched_val';
}
sub STORE {
return;
}
}
{ package DummyTiedHash;
sub new {
my $proto = shift;
return bless { data => { var1 => 'val1' } }, ref($proto) || $proto;
}
sub TIEHASH {
my $proto = shift;
return $proto->new(@_);
}
sub FETCH {
my $self = shift;
my $key = shift;
return $self->{data}{$key};
}
sub STORE {
my ($self, $key, $value) = @_;
$self->{data}{$key} = $value;
return $value;
}
sub DELETE {
my $self = shift;
my $key = shift;
delete $self->{data}{$key};
}
sub FIRSTKEY {
my $self = shift;
my $a = keys %{$self->{data}};
return each %{$self->{data}};
}
sub NEXTKEY {
my $self = shift;
my $last_key = shift;
return each %{$self->{data}};
}
}
{ package DummyTiedArray;
sub new {
my $proto = shift;
return bless { data => [ 1, 2, 3, 4 ] }, ref($proto) || $proto;
}
sub TIEARRAY {
my $proto = shift;
return $proto->new(@_);
}
sub FETCH {
my $self = shift;
my $index = shift;
return $self->{data}[$index];
}
sub STORE {
my ($self, $index, $value) = @_;
$self->{data}[$index] = $value;
}
sub FETCHSIZE {
my $self = shift;
return scalar @{$self->{data}};
}
sub STORESIZE {
my $self = shift;
my $count = shift;
return $count;
}
sub UNTIE {
}
}
JSON-DWIW-0.33/t/compat01.t 0000755 0000764 0000764 00000001611 11173264050 013167 0 ustar don don #!/usr/bin/env perl
# Authors: don
use strict;
use warnings;
use Test;
BEGIN { plan tests => 2 }
use JSON::DWIW;
local $SIG{__DIE__};
my $bad_str = '{"stuff":}';
my $data;
eval { $data = JSON::DWIW->from_json($bad_str, { use_exceptions => 1 }); };
my $first_eval = $@ ? 1 : 0;
eval { $data = JSON::DWIW::deserialize($bad_str, { use_exceptions => 1 }); };
my $second_eval = $@ ? 1 : 0;
ok($first_eval and $second_eval);
# needs converting case -- do the conversion
my $json_str = qq{{"var":"\xe9"}};
{
$data = JSON::DWIW::deserialize($json_str, { bad_char_policy => 'convert' });
}
ok($data and ord($data->{var}) == 0xe9);
# The old version doesn't respect bad_char_policy when parsing
# {
# local $SIG{__WARN__} = sub { };
# $data = JSON::DWIW->from_json($json_str, { bad_char_policy => 'convert' });
# }
# print "var: $data->{var}\n";
# ok($data and ord($data->{var}) == 0xe9);
JSON-DWIW-0.33/t/deser09_edge.t 0000755 0000764 0000764 00000003213 11173264050 014002 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-11-30 08:55:13
# Authors: don
use strict;
use warnings;
use Test;
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 10;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $str;
my $data;
my $stats;
$str = '{"stuff":}';
$data = JSON::DWIW::deserialize($str);
ok(JSON::DWIW->get_error_string and not defined($data));
ok(JSON::DWIW::get_error_string);
$str = '{3stuff:"blah"}';
$data = JSON::DWIW::deserialize($str);
ok(JSON::DWIW->get_error_string and not defined($data));
$str = '356';
$data = JSON::DWIW::deserialize($str);
ok($data == 356);
$str = '[]';
$data = JSON::DWIW::deserialize($str);
ok(not JSON::DWIW::get_error_string and ref($data) eq 'ARRAY' and scalar(@$data) == 0);
$str = '[ ]';
$data = JSON::DWIW::deserialize($str);
ok(not JSON::DWIW->get_error_string and ref($data) eq 'ARRAY' and scalar(@$data) == 0);
$str = '[{"key_2":[[{"key_5":{"key_6":[[{"key_9":[[{"key_12":{"key_13":[{"key_15":[{"key_17":{"key_18":{"key_19":[{"key_21":{"key_22":[[{"key_25":{"key_26":{"key_27":[{"key_29":{"key_30":[[{"key_33":{"key_34":{"key_35":{"key_36":{"key_37":[{"key_39":{"key_40":[{"key_42":[{"key_44":[{"key_46":[[{"key_49":[[[{"key_53":[[{"key_56":[[[[[{"key_62":[{"key_64":{"key_65":[[[[{}]]]]}}]}]]]]]}]]}]]]}]]}]}]}]}}]}}}}}]]}}]}}}]]}}]}}}]}]}}]]}]]}}]]}]';
$data = JSON::DWIW::deserialize($str);
ok(not JSON::DWIW->get_error_string);
$stats = JSON::DWIW::get_stats();
ok($stats->{max_depth} == 70);
ok($stats->{arrays} == 36);
ok($stats->{hashes} == 34);
JSON-DWIW-0.33/t/deser10_bom.t 0000755 0000764 0000764 00000002112 11173264050 013640 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-11-30 21:41:48
# Authors: don
use strict;
use warnings;
use Test;
use JSON::DWIW;
if (JSON::DWIW->has_deserialize) {
plan tests => 5;
}
else {
plan tests => 1;
print "# deserialize not implemented on this platform\n";
skip("Skipping on this platform", 0); # skipping on this platform
exit 0;
}
my $str;
my $data;
$str = qq{\xEF\xBB\xBF{"stuff":"blah"}};
$data = JSON::DWIW::deserialize($str);
ok($data and $data->{stuff} eq 'blah' and not JSON::DWIW->get_error_string);
$str = qq{\xFE\xFF{"stuff":"blah"}};
$data = JSON::DWIW::deserialize($str);
ok(not defined($data) and JSON::DWIW->get_error_string);
$str = qq{\xFF\xFE{"stuff":"blah"}};
$data = JSON::DWIW::deserialize($str);
ok(not defined($data) and JSON::DWIW->get_error_string);
$str = qq{\xFF\xFE\x00\x00{"stuff":"blah"}};
$data = JSON::DWIW::deserialize($str);
ok(not defined($data) and JSON::DWIW->get_error_string);
$str = qq{\x00\x00\xFE\xFF{"stuff":"blah"}};
$data = JSON::DWIW::deserialize($str);
ok(not defined($data) and JSON::DWIW->get_error_string);
JSON-DWIW-0.33/t/parse_file/ 0000755 0000764 0000764 00000000000 11216640546 013473 5 ustar don don JSON-DWIW-0.33/t/parse_file/fail7.json 0000644 0000764 0000764 00000000032 11173264050 015355 0 ustar don don ["Comma after the close"], JSON-DWIW-0.33/t/parse_file/fail11.json 0000644 0000764 0000764 00000000035 11173264050 015433 0 ustar don don {"Illegal expression": 1 + 2} JSON-DWIW-0.33/t/parse_file/fail33.json 0000644 0000764 0000764 00000000014 11173264050 015434 0 ustar don don ["mismatch"} JSON-DWIW-0.33/t/parse_file/fail16.json 0000644 0000764 0000764 00000000010 11173264050 015431 0 ustar don don [\naked] JSON-DWIW-0.33/t/parse_file/pass1.json 0000644 0000764 0000764 00000002647 11173264050 015420 0 ustar don don [
"JSON Test Pattern pass1",
{"object with 1 member":["array with 1 element"]},
{},
[],
-42,
true,
false,
null,
{
"integer": 1234567890,
"real": -9876.543210,
"e": 0.123456789e-12,
"E": 1.234567890E+34,
"": 23456789012E66,
"zero": 0,
"one": 1,
"space": " ",
"quote": "\"",
"backslash": "\\",
"controls": "\b\f\n\r\t",
"slash": "/ & \/",
"alpha": "abcdefghijklmnopqrstuvwyz",
"ALPHA": "ABCDEFGHIJKLMNOPQRSTUVWYZ",
"digit": "0123456789",
"0123456789": "digit",
"special": "`1~!@#$%^&*()_+-={':[,]}|;.?",
"hex": "\u0123\u4567\u89AB\uCDEF\uabcd\uef4A",
"true": true,
"false": false,
"null": null,
"array":[ ],
"object":{ },
"address": "50 St. James Street",
"url": "http://www.JSON.org/",
"comment": "// /* */": " ",
" s p a c e d " :[1,2 , 3
,
4 , 5 , 6 ,7 ],"compact":[1,2,3,4,5,6,7],
"jsontext": "{\"object with 1 member\":[\"array with 1 element\"]}",
"quotes": "" \u0022 %22 0x22 034 "",
"\/\\\"\uCAFE\uBABE\uAB98\uFCDE\ubcda\uef4A\b\f\n\r\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?"
: "A key can be any string"
},
0.5 ,98.6
,
99.44
,
1066,
1e1,
0.1e1,
0.e2,
1e-1,
1e00,2e+00,2e-00
,"rosebud"] JSON-DWIW-0.33/t/parse_file/fail14.json 0000644 0000764 0000764 00000000037 11173264050 015440 0 ustar don don {"Numbers cannot be hex": 0x14} JSON-DWIW-0.33/t/parse_file/fail2.json 0000644 0000764 0000764 00000000021 11173264050 015346 0 ustar don don ["Unclosed array" JSON-DWIW-0.33/t/parse_file/fail10.json 0000644 0000764 0000764 00000000072 11173264050 015433 0 ustar don don {"Extra value after close": true} "misplaced quoted value" JSON-DWIW-0.33/t/parse_file/pass10.json 0000644 0000764 0000764 00000000114 11173264050 015463 0 ustar don don {
"jsontext": "{\"object with 1 member\":[\"array with 1 element\"]}"
}
JSON-DWIW-0.33/t/parse_file/fail8.json 0000644 0000764 0000764 00000000020 11173264050 015353 0 ustar don don ["Extra close"]] JSON-DWIW-0.33/t/parse_file/fail32.json 0000644 0000764 0000764 00000000050 11173264050 015433 0 ustar don don {"Comma instead if closing brace": true, JSON-DWIW-0.33/t/parse_file/fail12.json 0000644 0000764 0000764 00000000037 11173264050 015436 0 ustar don don {"Illegal invocation": alert()} JSON-DWIW-0.33/t/parse_file/fail19.json 0000644 0000764 0000764 00000000026 11173264050 015443 0 ustar don don {"Missing colon" null} JSON-DWIW-0.33/t/parse_file/fail31.json 0000644 0000764 0000764 00000000007 11173264050 015434 0 ustar don don [0e+-1] JSON-DWIW-0.33/t/parse_file/pass2.json 0000644 0000764 0000764 00000000064 11173264050 015410 0 ustar don don [[[[[[[[[[[[[[[[[[["Not too deep"]]]]]]]]]]]]]]]]]]] JSON-DWIW-0.33/t/parse_file/pass0.json 0000644 0000764 0000764 00000000020 11173264050 015376 0 ustar don don {"var1":"val1"}
JSON-DWIW-0.33/t/parse_file/fail20.json 0000644 0000764 0000764 00000000027 11173264050 015434 0 ustar don don {"Double colon":: null} JSON-DWIW-0.33/t/parse_file/fail22.json 0000644 0000764 0000764 00000000041 11173264050 015432 0 ustar don don ["Colon instead of comma": false] JSON-DWIW-0.33/t/parse_file/pass3.json 0000644 0000764 0000764 00000000224 11173264050 015407 0 ustar don don {
"JSON Test Pattern pass3": {
"The outermost value": "must be an object or array.",
"In this test": "It is an object."
}
}
JSON-DWIW-0.33/t/parse_file/fail21.json 0000644 0000764 0000764 00000000040 11173264050 015430 0 ustar don don {"Comma instead of colon", null} JSON-DWIW-0.33/t/12error.t 0000755 0000764 0000764 00000007014 11173264050 013042 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-10-02 18:51:38
# Authors: don
use strict;
use warnings;
# main
{
use Test;
BEGIN {
plan tests => 27;
}
use JSON::DWIW;
my $json_obj = JSON::DWIW->new;
my $str = qq{{"test":"\xc3\xa4","funky":"\\u70":"key":"val"}};
my ($data, $error);
my $deser_skip = JSON::DWIW->has_deserialize ? '' : 'Skip -- deserialize not available';
unless ($deser_skip) {
$data = JSON::DWIW::deserialize($str);
$error = JSON::DWIW::get_error_string();
}
skip($deser_skip, $error);
skip($deser_skip, (defined $error and $error =~ /bad unicode character specification/));
skip($deser_skip, (defined $error and $error =~ /char 25/));
skip($deser_skip, (defined $error and $error =~ /byte 26/));
skip($deser_skip, (defined $error and $error =~ /line 1/));
skip($deser_skip, (defined $error and $error =~ /, col 25/));
skip($deser_skip, (defined $error and $error =~ /byte col 26/));
skip($deser_skip, (defined JSON::DWIW->get_error_string));
($data, $error) = JSON::DWIW->from_json($str);
ok($error);
# ok(defined $error and $error =~ /bad unicode character specification/);
# ok(defined $error and $error =~ /char 26/);
# ok(defined $error and $error =~ /byte 27/);
# ok(defined $error and $error =~ /line 1/);
# ok(defined $error and $error =~ /, col 26/);
# ok(defined $error and $error =~ /byte col 27/);
# ok(defined JSON::DWIW->get_error_string);
# when calling deserialize under the hood
ok(defined $error and $error =~ /bad unicode character specification/);
ok(defined $error and $error =~ /char 25/);
ok(defined $error and $error =~ /byte 26/);
ok(defined $error and $error =~ /line 1/);
ok(defined $error and $error =~ /, col 25/);
ok(defined $error and $error =~ /byte col 26/);
ok(defined JSON::DWIW->get_error_string);
$str = qq{{"test":"\xc3\xa4",\n"funky":"\\u70":"key":"val"}};
($data, $error) = JSON::DWIW->from_json($str);
# ok(defined $error and $error =~ /char 27/);
# ok(defined $error and $error =~ /byte 28/);
# ok(defined $error and $error =~ /line 2/);
# ok(defined $error and $error =~ /, col 14/);
# ok(defined $error and $error =~ /byte col 14/);
# when calling deserialize under the hood
ok(defined $error and $error =~ /char 26/);
ok(defined $error and $error =~ /byte 27/);
ok(defined $error and $error =~ /line 2/);
ok(defined $error and $error =~ /, col 13/);
ok(defined $error and $error =~ /byte col 13/);
$str = qq{{"test":"\xc3\xa4","test2":"}};
($data, $error) = JSON::DWIW->from_json($str);
# ok(defined $error and $error =~ /unterminated string starting at byte 22/);
# ok(defined $error and $error =~ /unterminated string/);
# ok(defined $error and $error =~ /char 22/);
# ok(defined $error and $error =~ /byte 23/);
# when calling deserialize under the hood
ok(defined $error and $error =~ /unterminated string/);
ok(defined $error and $error =~ /byte 22/);
ok(defined $error and $error =~ /char 21/);
ok(defined $error and $error =~ /byte col 22/);
$str = qq|{"var1":1,"var2":"val2","var3":[1,2,3,4,5], "test":true, "check":null}\n{"var4":"val4"}|;
($data, $error) = JSON::DWIW->from_json($str);
ok(defined $error);
($data, $error) = $json_obj->from_json($str);
ok(defined $json_obj->get_error_string);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/t/00use.t 0000755 0000764 0000764 00000000434 11173264050 012501 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-02-20 19:48:50
# Authors: don
# main
{
use strict;
use Test;
BEGIN { plan tests => 1 }
use JSON::DWIW; ok(1);
}
exit 0;
###############################################################################
# Subroutines
JSON-DWIW-0.33/evt.h 0000644 0000764 0000764 00000001421 11173264050 012056 0 ustar don don /*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
*/
#ifndef EVT_H
#define EVT_H
#include "jsonevt.h"
SV *
do_json_parse_buf(SV * self_sv, char * buf, STRLEN buf_len);
SV * do_json_parse(SV * self_sv, SV * json_str_sv);
SV * do_json_parse_file(SV * self_sv, SV * file_sv);
#endif
JSON-DWIW-0.33/DWIW.xs 0000644 0000764 0000764 00000112167 11175362561 012257 0 ustar don don /*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
*/
/* #define PERL_NO_GET_CONTEXT */
#include "DWIW.h"
#include "old_common.h"
/*
#include "old_parse.h"
*/
#ifndef JSONEVT_HAVE_FULL_VARIADIC_MACROS
void
JSON_DEBUG(char *fmt, ...) {
#if JSON_DO_DEBUG
va_list ap;
va_start(ap, fmt);
vprintf(fmt, ap);
printf("\n");
va_end(ap);
#endif
}
void
JSON_TRACE(char *fmt, ...) {
#if JSON_DO_TRACE
va_list ap;
va_start(ap, fmt);
vprintf(fmt, ap);
printf("\n");
va_end(ap);
#endif
}
#endif /* ifndef JSONEVT_HAVE_FULL_VARIADIC_MACROS */
/* get rid of "value computed is not used" warnings */
#define IGNORE_RV(x) (void)(x)
static SV *
vjson_encode_error(self_context * ctx, const char * file, int line_num, const char * fmt, va_list *ap_ptr) {
SV * error = newSVpv("", 0);
bool junk = 0;
HV * error_data = Nullhv;
sv_setpvf(error, "JSON::DWIW v%s - ", MOD_VERSION);
sv_vcatpvfn(error, fmt, strlen(fmt), ap_ptr, (SV **)0, 0, &junk);
error_data = newHV();
ctx->error_data = newRV_noinc((SV *)error_data);
IGNORE_RV(hv_store(error_data, "version", 7, newSVpvf("%s", MOD_VERSION), 0));
return error;
}
static SV *
json_encode_error(self_context * ctx, const char * file, int line_num, const char * fmt, ...) {
va_list ap;
SV * error;
va_start(ap, fmt);
error = vjson_encode_error(ctx, file, line_num, fmt, &ap);
va_end(ap);
return error;
}
#ifdef __GNUC__
#if JSON_DO_EXTENDED_ERRORS
#define JSON_ENCODE_ERROR(ctx, ...) json_encode_error(ctx, __FILE__, __LINE__, __VA_ARGS__)
#endif
#define JSON_ENCODE_ERROR(ctx, ...) json_encode_error(ctx, NULL, 0, __VA_ARGS__)
#else
static SV *
JSON_ENCODE_ERROR(self_context * ctx, const char * fmt, ...) {
va_list ap;
SV * error;
va_start(ap, fmt);
error = vjson_encode_error(ctx, NULL, 0, fmt, &ap);
va_end(ap);
return error;
}
#endif
#if DEBUG_UTF8
static STRLEN
print_hex(FILE * fp, const unsigned char * buf, STRLEN buf_len) {
STRLEN i;
UV c;
for (i = 0; i < buf_len; i++) {
c = buf[i];
if (c & 0x80) {
fprintf(fp, "\\x{%02"UVxf"}", c);
}
else {
fwrite(&buf[i], 1, 1, fp);
}
}
return i;
}
static STRLEN
print_hex_line(FILE * fp, const unsigned char * buf, STRLEN buf_len) {
STRLEN i = print_hex(fp, buf, buf_len);
fwrite("\n", 1, 1, fp);
i++;
return i;
}
#endif
static SV * to_json(self_context * self, SV * data_ref, int indent_level, unsigned int cur_level);
static SV * get_ref_addr(SV * ref);
#define JsSvLen(val) sv_len(val)
#define JsDumpSv(sv, flags) if (flags & kDumpVars) { sv_dump(sv); }
/*
static SV *
from_json_sv (SV * self, SV * data_sv, SV ** error_msg, int *throw_exception,
SV * error_data_ref, SV * stats_data_ref) {
STRLEN data_str_len;
char * data_str;
data_str = SvPV(data_sv, data_str_len);
return from_json(self, data_str, data_str_len, error_msg, throw_exception, error_data_ref,
stats_data_ref);
}
*/
static SV *
has_jsonevt() {
#ifdef HAVE_JSONEVT
return newSVuv(1);
#else
return newSV(0);
#endif
}
static SV *
deserialize_json(SV * self, char * data_str, STRLEN data_str_len) {
#ifdef HAVE_JSONEVT
SV * val;
UNLESS (data_str) {
/* return undef */
return (SV *)&PL_sv_undef;
}
if (data_str_len == 0) {
/* return empty string */
val = newSVpv("", 0);
return val;
}
val = do_json_parse_buf(self, data_str, data_str_len);
return (SV *)val;
#else
croak("the deserialize function is not yet available on this platform");
return &PL_sv_undef;
#endif
}
static SV *
deserialize_json_sv (SV * self, SV * data_sv) {
STRLEN data_str_len;
char * data_str;
data_str = SvPV(data_sv, data_str_len);
return deserialize_json(self, data_str, data_str_len);
}
/*
static int
get_unicode_char_count(SV * self, U8 *c_str, STRLEN len) {
STRLEN i;
U32 count = 0;
for (i = 0; i < len; i++) {
if (! UTF8_IS_INVARIANT(c_str[i])) {
len = UTF8SKIP(&c_str[i]);
i += len - 1;
count++;
}
}
return count;
}
*/
#if 0
static SV *
parse_json_file(SV * self, SV * file, SV * error_msg_ref) {
SV * rv;
SV * error_msg;
SV * passed_error_msg_sv;
int throw_exception = 0;
char * data;
STRLEN data_len;
char * filename;
char * filename_len;
FILE * fp;
filename = SvPV(file, filename_len);
if (! filename || ! (fp = fopen(filename, "r")) ) {
/* FIXME: put a good error msg here */
return &PL_sv_undef;
}
/* FIXME: read from file here */
error_msg = (SV *)&PL_sv_undef;
rv = from_json(self, data, data_len, &error_msg, &throw_exception);
if (SvOK(error_msg) && SvROK(error_msg_ref)) {
passed_error_msg_sv = SvRV(error_msg_ref);
sv_setsv(passed_error_msg_sv, error_msg);
}
return rv;
}
#endif
static char *
_safe_dup_buf(char *buf, uint32_t buf_len) {
char *dest = (char *)malloc(buf_len + 1);
memcpy(dest, buf, buf_len);
dest[buf_len] = 0;
return dest;
}
static SV *
escape_json_str(self_context * self, SV * sv_str) {
U8 * data_str;
STRLEN data_str_len;
STRLEN needed_len = 0;
STRLEN sv_pos = 0;
uint32_t len = 0;
U8 tmp_char = 0x00;
SV * rv;
int check_unicode = 1; /* FIXME: get rid of this */
UV this_uv = 0;
U8 unicode_bytes[5];
int escape_unicode = 0;
int pass_bad_char = 0;
uint32_t len32 = 0;
char *err_str = Nullch;
memzero(unicode_bytes, 5); /* memzero macro provided by Perl */
UNLESS (SvOK(sv_str)) {
return newSVpv("null", 4);
}
data_str = (U8 *)SvPV(sv_str, data_str_len);
UNLESS (data_str) {
return newSVpv("null", 4);
}
self->string_count++;
if (data_str_len == 0) {
/* empty string */
return newSVpv("\"\"", 2);
}
if (self->flags & kEscapeMultiByte) {
escape_unicode = 1;
}
/* get a better estimate of needed buffer size */
needed_len = data_str_len * 2 + 2;
/* check_unicode = SvUTF8(sv_str); */
rv = newSV(needed_len);
if (check_unicode) {
SvUTF8_on(rv);
}
sv_setpvn(rv, "\"", 1);
/* printf("\tencoding string %s\n", data_str); */
#if DEBUG_UTF8
fprintf(stderr, "\tencoding string ");
print_hex_line(stderr, data_str, data_str_len);
/* if (data_str[0] == 0xe4) { */
sv_dump(sv_str);
/* } */
fprintf(stderr, "==========\n");
#endif
for (sv_pos = 0; sv_pos < data_str_len; sv_pos++) {
pass_bad_char = 0;
/* this_uv = convert_utf8_to_uv(&data_str[sv_pos], &len); */
this_uv = (UV)utf8_bytes_to_unicode((uint8_t *)(&data_str[sv_pos]), data_str_len - sv_pos, &len);
if (len == 0) {
len = 1;
UNLESS (self->bad_char_policy) {
/* default */
this_uv = (UV)data_str[sv_pos];
if (data_str_len < 40) {
err_str = _safe_dup_buf((char *)data_str, data_str_len);
self->error = JSON_ENCODE_ERROR(self,
"bad utf8 sequence starting with %#02"UVxf" - %s",
this_uv, (char *)data_str);
free(err_str);
}
else {
self->error = JSON_ENCODE_ERROR(self,
"bad utf8 sequence starting with %#02"UVxf, this_uv);
}
sv_catpvn(rv, "\"", 1);
return rv;
}
else if (self->bad_char_policy & kBadCharConvert) {
this_uv = (UV)data_str[sv_pos];
}
else if (self->bad_char_policy & kBadCharPassThrough) {
this_uv = (UV)data_str[sv_pos];
pass_bad_char = 1;
}
}
sv_pos += len - 1;
switch (this_uv) {
case '\\':
sv_catpvn(rv, "\\\\", 2);
break;
case '"':
sv_catpvn(rv, "\\\"", 2);
break;
/*
case '\'':
sv_catpvn(rv, "\\'", 2);
break;
*/
case '/':
sv_catpvn(rv, "\\/", 2);
break;
case 0x08:
sv_catpvn(rv, "\\b", 2);
break;
case 0x0c:
sv_catpvn(rv, "\\f", 2);
break;
case 0x0a:
sv_catpvn(rv, "\\n", 2);
break;
case 0x0d:
sv_catpvn(rv, "\\r", 2);
break;
case 0x09:
sv_catpvn(rv, "\\t", 2);
break;
default:
if (this_uv < 0x1f) {
sv_catpvf(rv, "\\u%04"UVxf, this_uv);
}
else if (escape_unicode && ! UTF8_IS_INVARIANT(this_uv)) {
sv_catpvf(rv, "\\u%04"UVxf, this_uv);
}
else if (check_unicode && !pass_bad_char) {
len32 = common_utf8_unicode_to_bytes((uint32_t)this_uv, (uint8_t *)unicode_bytes);
if (len32 > 1) {
SvUTF8_on(rv);
}
sv_catpvn(rv, (char *)unicode_bytes, len32);
/*
tmp_str = convert_uv_to_utf8(unicode_bytes, this_uv);
if (PTR2UV(tmp_str) - PTR2UV(unicode_bytes) > 1) {
UNLESS (SvUTF8(rv)) {
SvUTF8_on(rv);
}
}
sv_catpvn(rv, (char *)unicode_bytes, PTR2UV(tmp_str) - PTR2UV(unicode_bytes));
*/
}
else {
tmp_char = (U8)this_uv;
sv_catpvn(rv, (char *)&tmp_char, 1);
}
break;
}
}
sv_catpvn(rv, "\"", 1);
return rv;
}
static SV *
encode_array(self_context * self, AV * array, int indent_level, unsigned int cur_level) {
SV * rsv = NULL;
SV * tmp_sv = NULL;
I32 max_i = av_len(array); /* max index, not length */
I32 i;
I32 j;
SV ** element = NULL;
I32 num_spaces = 0;
MAGIC * magic_ptr = NULL;
JsDumpSv((SV *)array, self->flags);
cur_level++;
UPDATE_CUR_LEVEL(self, cur_level);
self->array_count++;
if (self->flags & kPrettyPrint) {
if (indent_level == 0) {
rsv = newSVpv("[", 1);
}
else {
num_spaces = indent_level * 4;
rsv = newSV(num_spaces + 3);
sv_setpvn(rsv, "\n", 1);
for (i = 0; i < num_spaces; i++) {
sv_catpvn(rsv, " ", 1);
}
sv_catpvn(rsv, "[", 1);
}
}
else {
rsv = newSVpv("[", 1);
}
num_spaces = (indent_level + 1) * 4;
magic_ptr = mg_find((SV *)array, PERL_MAGIC_tied);
for (i = 0; i <= max_i; i++) {
element = av_fetch(array, i, 0);
if (element && *element) {
if (self->flags & kDumpVars) {
fprintf(stderr, "array element:\n");
}
/* need to call mg_get(val) to get the actual value if this is a tied array */
/* see sv_magic */
if (magic_ptr || SvTYPE(*element) == SVt_PVMG) {
/* mg_get(*element); */ /* causes assertion failure in perl 5.8.5 if tied scalar */
SvGETMAGIC(*element);
}
tmp_sv = to_json(self, *element, indent_level + 1, cur_level);
if (self->flags & kPrettyPrint) {
sv_catpvn(rsv, "\n", 1);
for (j = 0; j < num_spaces; j++) {
sv_catpvn(rsv, " ", 1);
}
}
sv_catsv(rsv, tmp_sv);
SvREFCNT_dec(tmp_sv);
if (self->error) {
SvREFCNT_dec(rsv);
return (SV *)&PL_sv_undef;
}
tmp_sv = NULL;
}
else {
/* error? */
sv_catpvn(rsv, "null", 4);
}
if (i != max_i) {
sv_catpvn(rsv, ",", 1);
}
}
if (self->flags & kPrettyPrint) {
sv_catpvn(rsv, "\n", 1);
num_spaces = indent_level * 4;
for (j = 0; j < num_spaces; j++) {
sv_catpvn(rsv, " ", 1);
}
}
sv_catpvn(rsv, "]", 1);
return rsv;
}
static void
setup_self_context(SV *self_sv, self_context *self) {
SV ** ptr = NULL;
SV * self_hash = NULL;
memzero((void *)self, sizeof(self_context));
UNLESS (SvROK(self_sv)) {
/* hmmm, this should always be a reference */
return;
}
self_hash = SvRV(self_sv);
/* HvUSEDKEYS(hv) */
/* HvKEYS(hv) */
if (HvKEYS(self_hash) == 0) {
/* empty hash, so return early */
return;
}
ptr = hv_fetch((HV *)self_hash, "bare_keys", 9, 0);
if (ptr && SvTRUE(*ptr)) {
self->bare_keys = 1;
}
ptr = hv_fetch((HV *)self_hash, "use_exceptions", 14, 0);
if (ptr && SvTRUE(*ptr)) {
self->flags |= kUseExceptions;
}
self->bad_char_policy = get_bad_char_policy((HV *)self_hash);
ptr = hv_fetch((HV *)self_hash, "dump_vars", 9, 0);
if (ptr && SvTRUE(*ptr)) {
self->flags |= kDumpVars;
}
ptr = hv_fetch((HV *)self_hash, "pretty", 6, 0);
if (ptr && SvTRUE(*ptr)) {
self->flags |= kPrettyPrint;
}
ptr = hv_fetch((HV *)self_hash, "escape_multi_byte", 17, 0);
if (ptr && SvTRUE(*ptr)) {
self->flags |= kEscapeMultiByte;
}
ptr = hv_fetch((HV *)self_hash, "detect_circular_refs", 20, 0);
if (ptr && SvTRUE(*ptr)) {
self->ref_track = newHV();
}
#if JSON_DUMP_OPTIONS
{
char * char_policy = NULL;
switch (self->bad_char_policy) {
case kBadCharError:
char_policy = "error";
break;
case kBadCharConvert:
char_policy = "convert";
break;
case kBadCharPassThrough:
char_policy = "pass_through";
break;
default:
char_policy = "unrecognized bad_char policy";
break;
}
fprintf(stderr, "\nBad char policy: %s\n", char_policy);
if (self->flags & kUseExceptions) {
fprintf(stderr, "Use Exceptions\n");
}
if (self->flags & kDumpVars) {
fprintf(stderr, "Dump Vars\n");
}
if (self->flags & kPrettyPrint) {
fprintf(stderr, "Pretty Print\n");
}
if (self->flags & kEscapeMultiByte) {
fprintf(stderr, "Escape Multi-Byte Characters\n");
}
fprintf(stderr, "\n");
fflush(stderr);
}
#endif
}
static int
hash_key_can_be_bare(self_context * self, U8 *key, STRLEN key_len) {
U8 this_byte;
STRLEN i;
UNLESS (self->bare_keys) {
return 0;
}
/* Only allow if 7-bit ascii, so use byte semantics, and only
allow if alphanumeric and '_'.
*/
for (i = 0; i < key_len; i++) {
this_byte = *key;
key++;
UNLESS (this_byte == '_'
|| (this_byte >= 'A' && this_byte <= 'Z')
|| (this_byte >= 'a' && this_byte <= 'z')
|| (this_byte >= '0' && this_byte <= '9')
) {
return 0;
}
}
return 1;
}
static SV *
encode_hash(self_context * self, HV * hash, int indent_level, unsigned int cur_level) {
SV * rsv = NULL;
SV * tmp_sv = NULL;
SV * tmp_sv2 = NULL;
U8 * key;
I32 key_len;
SV * val;
int first = 1;
int i;
int num_spaces = 0;
MAGIC * magic_ptr = NULL;
HE * entry;
/* SV * key_sv = NULL; */
cur_level++;
UPDATE_CUR_LEVEL(self, cur_level);
self->hash_count++;
if (self->flags & kPrettyPrint) {
if (indent_level == 0) {
rsv = newSVpv("{", 1);
}
else {
num_spaces = indent_level * 4;
rsv = newSV(num_spaces + 3);
sv_setpvn(rsv, "\n", 1);
for (i = 0; i < num_spaces; i++) {
sv_catpvn(rsv, " ", 1);
}
sv_catpvn(rsv, "{", 1);
}
}
else {
rsv = newSVpv("{", 1);
}
JsDumpSv((SV *)hash, self->flags);
magic_ptr = mg_find((SV *)hash, PERL_MAGIC_tied);
num_spaces = (indent_level + 1) * 4;
/* non-sorted keys */
hv_iterinit(hash);
/* while ( (val = hv_iternextsv(hash, (char **)&key, &key_len)) ) { */
while (1) {
entry = hv_iternext(hash);
UNLESS (entry) {
break;
}
/* key_sv = HeSVKEY(entry); */
key = (unsigned char *)hv_iterkey(entry, &key_len);
/* key = (U8 *)HePV(entry, key_len); */
val = hv_iterval(hash, entry);
UNLESS (first) {
sv_catpvn(rsv, ",", 1);
}
first = 0;
/* need to call mg_get(val) to get the actual value if this is a tied hash */
/* see sv_magic */
if (magic_ptr || SvTYPE(val) == SVt_PVMG) {
/* mg_get(val); */ /* crashes in Perl 5.8.5 if doesn't have "get magic" */
SvGETMAGIC(val);
}
if (self->flags & kDumpVars) {
fprintf(stderr, "hash key = %s\nval:\n", key);
}
if (self->flags & kPrettyPrint) {
sv_catpvn(rsv, "\n", 1);
for (i = 0; i < num_spaces; i++) {
sv_catpvn(rsv, " ", 1);
}
}
if (hash_key_can_be_bare(self, key, key_len)) {
/* if the key can be bare, then it cannot have any hi-bits
set, so no need to upgrade to utf-8
*/
sv_catpvn(rsv, (char *)key, key_len);
}
else {
tmp_sv = newSVpv((char *)key, key_len);
#ifdef IS_PERL_5_8
if (HeKWASUTF8(entry)) {
/* The hash key was utf-8 encoding, but the char * was
given to us with as the decoded bytes (e.g., utf-8 =>
latin1), so convert back to utf-8
*/
sv_utf8_upgrade(tmp_sv);
}
#endif
tmp_sv2 = escape_json_str(self, tmp_sv);
if (self->error) {
SvREFCNT_dec(tmp_sv);
SvREFCNT_dec(tmp_sv2);
SvREFCNT_dec(rsv);
return (SV *)&PL_sv_undef;
}
sv_catsv(rsv, tmp_sv2);
SvREFCNT_dec(tmp_sv);
SvREFCNT_dec(tmp_sv2);
}
sv_catpvn(rsv, ":", 1);
tmp_sv = to_json(self, val, indent_level + 2, cur_level);
if (self->error) {
SvREFCNT_dec(tmp_sv);
SvREFCNT_dec(rsv);
return (SV *)&PL_sv_undef;
}
sv_catsv(rsv, tmp_sv);
SvREFCNT_dec(tmp_sv);
}
if (self->flags & kPrettyPrint) {
sv_catpvn(rsv, "\n", 1);
num_spaces = indent_level * 4;
for (i = 0; i < num_spaces; i++) {
sv_catpvn(rsv, " ", 1);
}
}
sv_catpvn(rsv, "}", 1);
return rsv;
}
static SV *
to_json(self_context * self, SV * data_ref, int indent_level, unsigned int cur_level) {
SV * data;
int type;
SV * rsv = newSVpv("", 0);
SV * tmp = NULL;
STRLEN before_len = 0;
U8 * data_str = NULL;
STRLEN start = 0;
STRLEN len = 0;
SV * ref_tmp = NULL;
JSON_DEBUG("to_json() called");
JsDumpSv(data_ref, self->flags);
UNLESS (SvROK(data_ref)) {
JSON_DEBUG("not a reference");
data = data_ref;
if (SvOK(data)) {
/* scalar */
type = SvTYPE(data);
JSON_TRACE("found type %u", type);
switch (type) {
case SVt_NULL:
/* undef? */
sv_setpvn(rsv, "null", 4);
return rsv;
break;
case SVt_IV:
case SVt_NV:
before_len = JsSvLen(rsv);
sv_catsv(rsv, data);
self->number_count++;
if (JsSvLen(rsv) == before_len) {
sv_catpvn(rsv, "\"\"", 2);
}
return rsv;
break;
case SVt_PV:
JSON_TRACE("found SVt_PV");
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv; /* this works for the error case as well */
break;
case SVt_PVIV:
case SVt_PVNV:
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
break;
case SVt_PVLV:
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
break;
default:
/* now what? */
JSON_DEBUG("unkown data type");
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
break;
}
}
else {
/* undef */
sv_setpvn(rsv, "null", 4);
return rsv;
}
}
JSON_DEBUG("is a reference");
if (self->ref_track) {
ref_tmp = get_ref_addr(data_ref);
if (hv_exists_ent(self->ref_track, ref_tmp, 0)) {
SvREFCNT_dec(ref_tmp);
/* return a stringified version */
sv_catpvn(rsv, "\"circular ref: ", 15);
sv_catsv(rsv, data_ref);
sv_catpvn(rsv, "\"", 1);
return rsv;
}
else {
IGNORE_RV(hv_store_ent(self->ref_track, ref_tmp, newSV(0), 0));
SvREFCNT_dec(ref_tmp);
}
}
if (sv_isobject(data_ref)) {
if (sv_isa(data_ref, "JSON::DWIW::Boolean")) {
if (SvTRUE(data_ref)) {
sv_setpvn(rsv, "true", 4);
self->bool_count++;
return rsv;
}
else {
sv_setpvn(rsv, "false", 5);
self->bool_count++;
return rsv;
}
}
else if (sv_derived_from(data_ref, "Math::BigInt")
|| sv_derived_from(data_ref, "Math::BigFloat")) {
JSON_DEBUG("found big number");
tmp = newSVpv("", 0);
sv_catsv(tmp, data_ref);
data_str = (U8 *)SvPV(tmp, before_len);
if (before_len > 0) {
start = 0;
len = before_len;
if (data_str[0] == '+') {
start++;
len--;
}
if (data_str[before_len - 1] == '.') {
len--;
}
sv_catpvn(rsv, (char *)data_str + start, len);
}
else {
sv_setpvn(rsv, "\"\"", 2);
}
SvREFCNT_dec(tmp);
return rsv;
}
}
data = SvRV(data_ref);
if (SvROK(data)) {
/* reference to a referrence */
sv_catsv(rsv, data_ref);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
}
type = SvTYPE(data);
switch (type) {
case SVt_NULL:
/* undef ? */
sv_setpvn(rsv, "null", 4);
return rsv;
break;
case SVt_IV:
case SVt_NV:
before_len = JsSvLen(rsv);
sv_catsv(rsv, data);
if (JsSvLen(rsv) == before_len) {
sv_catpvn(rsv, "\"\"", 2);
}
return rsv;
break;
case SVt_PV:
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
break;
case SVt_PVIV:
case SVt_PVNV:
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
break;
case SVt_PVAV: /* array */
JSON_DEBUG("==========> found array ref");
SvREFCNT_dec(rsv);
return encode_array(self, (AV *)data, indent_level, cur_level);
break;
case SVt_PVHV: /* hash */
JSON_DEBUG("==========> found hash ref");
SvREFCNT_dec(rsv);
return encode_hash(self, (HV *)data, indent_level, cur_level);
break;
case SVt_PVCV: /* code */
sv_catsv(rsv, data_ref);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
/*
sv_setpvn(rsv, "\"code\"", 6);
return rsv;
*/
break;
case SVt_PVGV: /* glob */
sv_catsv(rsv, data_ref);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
break;
case SVt_PVIO:
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
break;
case SVt_PVMG: /* blessed or magical scalar */
if (sv_isobject(data_ref)) {
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
}
else {
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
}
break;
default:
sv_catsv(rsv, data);
tmp = rsv;
rsv = escape_json_str(self, tmp);
SvREFCNT_dec(tmp);
return rsv;
/* sv_setpvn(rsv, "unknown type", 12); */
/* return rsv; */
break;
}
sv_setpvn(rsv, "unknown type 2", 14);
return rsv;
}
static int
set_encode_stats(self_context * ctx, SV * stats_data_ref) {
SV * data = Nullsv;
if (SvOK(stats_data_ref) && SvROK(stats_data_ref)) {
data = SvRV(stats_data_ref);
/* FIXME: should destroy these if the store fails */
/*
hv_store((HV *)data, "max_string_bytes", 16, newSVuv(ctx->longest_string_bytes), 0);
hv_store((HV *)data, "max_string_chars", 16, newSVuv(ctx->longest_string_chars), 0);
hv_store((HV *)data, "nulls", 5, newSVuv(ctx->null_count), 0);
*/
/*
hv_store((HV *)data, "strings", 7, newSVuv(ctx->string_count), 0);
hv_store((HV *)data, "bools", 5, newSVuv(ctx->bool_count), 0);
hv_store((HV *)data, "numbers", 7, newSVuv(ctx->number_count), 0);
*/
IGNORE_RV(hv_store((HV *)data, "hashes", 6, newSVuv(ctx->hash_count), 0));
IGNORE_RV(hv_store((HV *)data, "arrays", 6, newSVuv(ctx->array_count), 0));
IGNORE_RV(hv_store((HV *)data, "max_depth", 9, newSVuv(ctx->deepest_level), 0));
}
return 1;
}
static SV *
has_mmap() {
#ifdef HAS_MMAP
return &PL_sv_yes;
#else
return &PL_sv_no;
#endif
}
static SV *
parse_mmap_file(SV * self, SV * file, SV * error_msg_ref) {
#if USE_MMAP
char * filename;
STRLEN filename_len;
void * base;
int fd = -1;
struct stat file_info;
size_t len = 0;
SV * rv;
int throw_exception = 0;
SV * error_msg = &PL_sv_undef;
SV * passed_error_msg_sv;
UNLESS (SvOK(file)) {
return &PL_sv_undef;
}
filename = (char *)SvPV(file, filename_len);
fd = open(filename, O_RDONLY, 0644);
if (fd < 0) {
return &PL_sv_undef;
}
if (fstat(fd, &file_info)) {
return &PL_sv_undef;
}
JSON_DEBUG("HERE - filename='%s'\n", filename);
/* FIXME: check here to see if file size too big, e.g., > 2GB */
len = file_info.st_size;
base = mmap(NULL, len, PROT_READ, 0, fd, 0);
if (base == MAP_FAILED) {
printf("mmap failed\n");
return &PL_sv_undef;
}
JSON_DEBUG("HERE 2 - len=%u, base=%"UVxf"\n", len, PTR2UV(base));
JSON_DEBUG("data: ");
fread(base, 1, len, stdout);
JSON_DEBUG("\n");
rv = from_json(self, base, len, &error_msg, &throw_exception);
if (SvOK(error_msg) && SvROK(error_msg_ref)) {
passed_error_msg_sv = SvRV(error_msg_ref);
sv_setsv(passed_error_msg_sv, error_msg);
}
munmap(base, len);
#else
return &PL_sv_undef;
#endif
}
static SV *
get_ref_addr(SV * ref) {
SV * addr_str = Nullsv;
SV * sv_addr = Nullsv;
char * str = Nullch;
if (SvROK(ref)) {
sv_addr = SvRV(ref);
str = form("%"UVuf"", PTR2UV((void *)sv_addr));
addr_str = newSVpvn(str, strlen(str));
}
else {
return newSV(0);
}
return addr_str;
}
static SV *
get_ref_type(SV * ref) {
UNLESS (SvROK(ref)) {
return newSV(0);
}
/* FIXME: complete the type checks here */
return newSV(0);
}
MODULE = JSON::DWIW PACKAGE = JSON::DWIW
PROTOTYPES: DISABLE
=pod
SV *
_xs_from_json(SV * self, SV * data, SV * error_msg_ref, SV * error_data_ref, SV * stats_data_ref)
PREINIT:
SV * rv;
SV * error_msg;
SV * passed_error_msg_sv;
int throw_exception = 0;
CODE:
error_msg = (SV *)&PL_sv_undef;
rv = from_json_sv(self, data, &error_msg, &throw_exception, error_data_ref, stats_data_ref);
if (SvOK(error_msg) && SvROK(error_msg_ref)) {
passed_error_msg_sv = SvRV(error_msg_ref);
sv_setsv(passed_error_msg_sv, error_msg);
}
RETVAL = rv;
OUTPUT:
RETVAL
=cut
SV *
has_deserialize(...)
CODE:
items = items;
RETVAL = has_jsonevt();
OUTPUT:
RETVAL
SV *
deserialize(SV * data, ...)
ALIAS:
JSON::DWIW::load = 1
JSON::DWIW::deserialize_json = 2
PREINIT:
SV * self = Nullsv;
SV * rv;
CODE:
if (items > 1) {
self = (SV *)ST(1);
}
/* avoid compiler warnings about unused variable */
ix = ix;
rv = deserialize_json_sv(self, data);
RETVAL = rv;
OUTPUT:
RETVAL
SV *
deserialize_file(SV * file, ...)
ALIAS:
JSON::DWIW::load_file = 1
PREINIT:
SV * self = Nullsv;
SV * rv;
CODE:
if (items > 1) {
self = (SV *)ST(1);
}
/* avoid compiler warnings about unused variable */
ix = ix;
rv = do_json_parse_file(self, file);
RETVAL = rv;
OUTPUT:
RETVAL
SV *
_xs_to_json(SV * self, SV * data, SV * error_msg_ref, SV * error_data_ref, SV * stats_ref)
PREINIT:
self_context self_context;
SV * rv;
int indent_level = 0;
SV * passed_error_data_sv = Nullsv;
CODE:
setup_self_context(self, &self_context);
rv = to_json(&self_context, data, indent_level, 0);
if (SvOK(stats_ref)) {
set_encode_stats(&self_context, stats_ref);
}
if (self_context.error) {
sv_setsv(SvRV(error_msg_ref), self_context.error);
if (SvOK(error_data_ref) && SvROK(error_data_ref) && self_context.error_data) {
passed_error_data_sv = SvRV(error_data_ref);
sv_setsv(passed_error_data_sv, self_context.error_data);
}
}
if (self_context.ref_track) {
SvREFCNT_dec(self_context.ref_track);
self_context.ref_track = Nullhv;
}
RETVAL = rv;
OUTPUT:
RETVAL
SV *
have_big_int(SV * self)
PREINIT:
SV * rsv = newSV(0);
int rv;
CODE:
self = self;
rv = have_bigint();
if (rv) {
sv_setsv(rsv, &PL_sv_yes);
}
else {
sv_setsv(rsv, &PL_sv_no);
}
RETVAL = rsv;
OUTPUT:
RETVAL
SV *
have_big_float(SV * self)
PREINIT:
SV * rsv = newSV(0);
int rv;
CODE:
self = self; /* get rid of compiler warnings */
rv = have_bigfloat();
if (rv) {
sv_setsv(rsv, &PL_sv_yes);
}
else {
sv_setsv(rsv, &PL_sv_no);
}
RETVAL = rsv;
OUTPUT:
RETVAL
SV *
size_of_uv(SV * self)
PREINIT:
SV * rsv = newSV(0);
CODE:
self = self; /* get rid of compiler warnings */
sv_setuv(rsv, UVSIZE);
RETVAL = rsv;
OUTPUT:
RETVAL
SV *
peek_scalar(SV * self, SV * val)
CODE:
self = self; /* get rid of compiler warnings */
sv_dump(val);
RETVAL = &PL_sv_yes;
OUTPUT:
RETVAL
SV *
has_high_bit_bytes(SV *self, SV *val)
PREINIT:
U8 * s;
STRLEN len;
STRLEN i;
CODE:
self = self;
RETVAL = &PL_sv_no;
s = (U8 *)SvPV(val, len);
for (i = 0; i < len; i++) {
if (s[i] > 0x80) {
RETVAL = &PL_sv_yes;
}
}
OUTPUT:
RETVAL
SV *
is_valid_utf8(SV * self, SV * str)
PREINIT:
SV * rv = &PL_sv_no;
U8 * s;
STRLEN len;
CODE:
self = self;
s = (U8 *)SvPV(str, len);
if (is_utf8_string(s, len)) {
rv = &PL_sv_yes;
}
RETVAL = rv;
OUTPUT:
RETVAL
SV *
upgrade_to_utf8(SV * self, SV * str)
CODE:
self = self;
sv_utf8_upgrade(str);
if (GIMME_V == G_VOID) {
RETVAL = &PL_sv_yes;
}
else {
RETVAL = newSVsv(str);
}
OUTPUT:
RETVAL
SV *
flagged_as_utf8(SV * self, SV * str)
PREINIT:
SV * rv = &PL_sv_no;
CODE:
self = self;
if (SvUTF8(str)) {
rv = &PL_sv_yes;
}
RETVAL = rv;
OUTPUT:
RETVAL
SV *
flag_as_utf8(SV * self, SV * str)
PREINIT:
SV * rv = &PL_sv_yes;
CODE:
self = self;
SvUTF8_on(str);
RETVAL = rv;
OUTPUT:
RETVAL
SV *
unflag_as_utf8(SV * self, SV * str)
PREINIT:
SV * rv = &PL_sv_yes;
CODE:
self = self;
SvUTF8_off(str);
RETVAL = rv;
OUTPUT:
RETVAL
SV *
code_point_to_utf8_str(SV *, SV * code_point_sv)
PREINIT:
UV code_point;
U8 utf8_bytes[5];
SV * rv = Nullsv;
uint32_t len32 = 0;
CODE:
utf8_bytes[4] = '\x00';
code_point = SvUV(code_point_sv);
len32 = common_utf8_unicode_to_bytes((uint32_t)code_point, (uint8_t *)utf8_bytes);
utf8_bytes[len32] = '\x00';
if (len32) {
rv = newSVpv((char *)utf8_bytes, (STRLEN)len32);
SvUTF8_on(rv);
}
else {
rv = newSV(0);
}
RETVAL = rv;
OUTPUT:
RETVAL
SV *
code_point_to_hex_bytes(SV *, SV * code_point_sv)
PREINIT:
UV code_point;
U8 utf8_bytes[5];
SV * rv;
uint32_t len32 = 0;
CODE:
utf8_bytes[4] = '\x00';
code_point = SvUV(code_point_sv);
rv = newSVpv("", 0);
len32 = common_utf8_unicode_to_bytes((uint32_t)code_point, (uint8_t *) utf8_bytes);
utf8_bytes[len32] = '\x00';
if (len32) {
uint32_t i;
for (i = 0; i < len32; i++) {
sv_catpvf(rv, "\\x%02x", (unsigned int)utf8_bytes[i]);
}
}
else {
}
RETVAL = rv;
OUTPUT:
RETVAL
SV *
bytes_to_code_points(SV *, SV * bytes)
PREINIT:
U8 * data_str;
STRLEN data_str_len;
AV * array = newAV();
STRLEN len = 0;
UV this_char;
STRLEN pos = 0;
I32 max_i;
SV * sv = NULL;
I32 i;
SV ** element;
CODE:
if (SvROK(bytes) && SvTYPE(SvRV(bytes)) == SVt_PVAV) {
AV * av = (AV *)SvRV(bytes);
max_i = av_len(av);
sv = newSV(max_i);
sv_setpvn(sv, "", 0);
for (i = 0; i <= max_i; i++) {
element = av_fetch(av, i , 0);
if (element && *element) {
this_char = SvUV(*element);
fprintf(stderr, "%02"UVxf"\n", this_char);
}
else {
this_char = 0;
}
sv_catpvf(sv, "%c", (unsigned char)this_char);
}
bytes = sv;
}
data_str = (U8 *)SvPV(bytes, data_str_len);
while (pos < data_str_len) {
this_char = convert_utf8_to_uv(&data_str[pos], &len);
pos += len;
av_push(array, newSVuv(this_char));
}
if (sv) {
SvREFCNT_dec(sv);
}
RETVAL = newRV_noinc((SV *)array);
OUTPUT:
RETVAL
SV *
_has_mmap()
CODE:
RETVAL = has_mmap();
OUTPUT:
RETVAL
SV *
_parse_mmap_file(SV * self, SV * file, SV * error_msg_ref)
CODE:
RETVAL = parse_mmap_file(self, file, error_msg_ref);
OUTPUT:
RETVAL
SV *
_check_scalar(SV *, SV * the_scalar)
CODE:
fprintf(stderr, "SV * at addr %"UVxf"\n", PTR2UV(the_scalar));
sv_dump(the_scalar);
if (SvROK(the_scalar)) {
printf("\ndereferenced:\n");
fprintf(stderr, "SV * at addr %"UVxf"\n", PTR2UV(SvRV(the_scalar)));
sv_dump(SvRV(the_scalar));
}
RETVAL = &PL_sv_yes;
OUTPUT:
RETVAL
SV *
skip_deserialize_file()
CODE:
RETVAL = &PL_sv_no;
OUTPUT:
RETVAL
SV *
get_ref_addr(SV * ref)
CODE:
RETVAL = get_ref_addr(ref);
OUTPUT:
RETVAL
SV *
get_ref_type(SV * ref)
CODE:
RETVAL = get_ref_type(ref);
OUTPUT:
RETVAL
JSON-DWIW-0.33/evt.c 0000644 0000764 0000764 00000064513 11216640147 012067 0 ustar don don /*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See perlartistic.
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
*/
/* TODO before release:
- add benchmark prog to distribution
- add comparison of features of other JSON modules
- (done) fix static stack (switch to heap if data structure is deep)
- (done) write test for deep structure
- (done) test scripts
- compatability with old implementation
+ bad_char_policy (done)
+ booleans (done)
+ numbers - handle ints and overflow (done)
+ bare hash keys (done)
- compilation on windows (done)
- turn off forced -Wall (done)
- take care of mmap case (includes on windows, etc.)
- (done) remove unused callbacks
- (done) add module name and version to errors, as in the old implementation
- (done) handle booleans, nulls, and numbers by themselves
- (done) check if need to free src when calling sv_setsv()
- (done) make sure module name and version are in error messages
+ done and have test for it
- add deserialize_file() subroutine
- check stats fields (missing max_string_chars/bytes)
- document stats fields (is max_string_bytes the size of the JSON string or the Perl string)
- "strict" option to follow Crockford's tests
- document deserialize() and deserialize_file()
*/
/* #define PERL_NO_GET_CONTEXT */
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif
#if PERL_VERSION >= 8
#define IS_PERL_5_8
#else
#if PERL_VERSION <= 5
#error "This module requires at least Perl 5.6"
#else
#define IS_PERL_5_6
#endif
#endif
#include
#include "jsonevt.h"
#include "evt.h"
#ifndef DO_DEBUG
#define DO_DEBUG 0
#endif
#if DO_DEBUG && defined(JSONEVT_HAVE_FULL_VARIADIC_MACROS)
#define LOG_DEBUG(...) printf("%s (%d) - ", __FILE__, __LINE__); printf(__VA_ARGS__); \
printf("\n"); fflush(stdout)
#define DUMP_STACK(ctx) dump_stack(ctx)
#else
#define LOG_DEBUG(...)
#define DUMP_STACK
#endif
#if 0 && defined(JSONEVT_HAVE_FULL_VARIADIC_MACROS)
#define PDB(...) fprintf(stderr, "in %s, line %d of %s: ", __func__, __LINE__, __FILE__); \
fprintf(stderr, __VA_ARGS__); fprintf(stderr, "\n"); fflush(stderr)
#else
#define PDB(...)
#endif
#if 0
#define SETUP_TRACE fprintf(stderr, "in %s() at line %d of %s\n", __func__, __LINE__, __FILE__); \
fflush(stderr);
#else
#define SETUP_TRACE
#endif
#define MOD_NAME "JSON::DWIW"
#define UNLESS(stuff) if (! (stuff))
/* get rid of "value computed is not used" warnings */
#define IGNORE_RV(x) (void)(x)
typedef struct {
SV * data;
} parse_cb_stack_entry;
#define EVT_OPTION_CONVERT_BOOL 1
#define EVT_OPTION_USE_EXCEPTIONS (1 << 1)
typedef struct {
parse_cb_stack_entry * stack;
int stack_level;
int stack_size;
uint options;
} parse_callback_ctx;
typedef struct {
parse_callback_ctx cbd;
} perl_wrapper_ctx;
#define GROW_STACK(ctx) ( ((ctx)->stack_size <<= 1), Renew((ctx)->stack, (ctx)->stack_size, parse_cb_stack_entry))
#define ENSURE_STACK(ctx) ( (ctx)->stack_level >= (ctx)->stack_size - 1 ? GROW_STACK(ctx) : 0 )
#define CUR_STACK_LEVEL(ctx) ((ctx)->stack_level)
#define CUR_STACK_ENTRY(ctx) ( (parse_cb_stack_entry *)((ctx)->stack + (ctx)->stack_level) )
#define POP_STACK(ctx) memzero((void *)((ctx)->stack + (ctx)->stack_level), sizeof((ctx)->stack));\
(ctx)->stack_level--;
#define PUSH_STACK_ENTRY(ctx) ( ENSURE_STACK(ctx), (ctx)->stack_level++, ( (parse_cb_stack_entry *)((ctx)->stack + (ctx)->stack_level) ) )
static void
_json_call_method_no_arg_one_return(SV * obj_or_class, char * method, SV ** rv_ptr) {
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(obj_or_class);
PUTBACK;
call_method(method, G_SCALAR);
SPAGAIN;
*rv_ptr = POPs;
if (SvOK(*rv_ptr)) {
SvREFCNT_inc(*rv_ptr);
}
PUTBACK;
FREETMPS;
LEAVE;
}
static SV *
json_call_method_no_arg_one_return(SV * obj_or_class, char * method) {
SV * rv = NULL;
_json_call_method_no_arg_one_return(obj_or_class, method, &rv);
return rv;
}
static void
_json_call_method_one_arg_one_return(SV * obj_or_class, char * method, SV * arg, SV ** rv_ptr) {
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
XPUSHs(obj_or_class);
XPUSHs(arg);
PUTBACK;
call_method(method, G_SCALAR);
SPAGAIN;
*rv_ptr = POPs;
if (SvOK(*rv_ptr)) {
SvREFCNT_inc(*rv_ptr);
}
PUTBACK;
FREETMPS;
LEAVE;
}
static SV *
json_call_method_one_arg_one_return(SV * obj_or_class, char * method, SV * arg) {
SV * rv = NULL;
_json_call_method_one_arg_one_return(obj_or_class, method, arg, &rv);
return rv;
}
static SV *
get_new_bool_obj(int bool_val) {
SV * class_name = newSVpv("JSON::DWIW::Boolean", 19);
SV * obj;
if (bool_val) {
obj = json_call_method_no_arg_one_return(class_name, "true");
}
else {
obj = json_call_method_no_arg_one_return(class_name, "false");
}
SvREFCNT_dec(class_name);
return obj;
}
#if 0
static int bool_module_loaded = 0;
static SV *
get_new_bool_obj(int bool_val) {
SV * obj;
/* SV * bool_sv = bool_val ? newSViv(bool_val) : newSVpv("", 0); */
SV * bool_sv = newSViv(bool_val);
HV * class_stash;
SV * class_name = newSVpvn("JSON::DWIW::Boolean", 19);
SV * version = newSVpvn("0", 1);
UNLESS (bool_module_loaded) {
load_module(0, class_name, version);
bool_module_loaded = 1;
}
SvREFCNT_dec(class_name);
SvREFCNT_dec(version);
class_stash = gv_stashpv("JSON::DWIW::Boolean", 1);
obj = sv_bless(newRV_noinc(bool_sv), class_stash);
return obj;
}
#endif
#if 0
static void
dump_stack(parse_callback_ctx * ctx) {
parse_cb_stack_entry * entry;
int i;
char * type_str;
for (i = 0; i <= ctx->stack_level; i++) {
entry = (parse_cb_stack_entry *)(ctx->stack + i);
LOG_DEBUG("stack level %d\n", i);
switch (entry->type) {
case TYPE_NONE:
type_str = "None";
break;
case TYPE_HASH:
type_str = "Hash";
break;
case TYPE_ARRAY:
type_str = "Array";
break;
case TYPE_HASH_ENTRY_KEY:
type_str = "HashEntryKey";
break;
case TYPE_HASH_ENTRY_VAL:
type_str = "HashEntryVal";
break;
case TYPE_ARRAY_ELEMENT:
type_str = "ArrayElement";
break;
case TYPE_HASH_ENTRY:
type_str = "HashEntry";
break;
default:
type_str = "Unknown";
break;
}
LOG_DEBUG("\ttype %s\n", type_str);
if (entry->ref) {
LOG_DEBUG("\tRV\n");
}
else {
LOG_DEBUG("\tSV\n");
}
}
}
#endif
#define kHaveModuleNotChecked 0
#define kHaveModule 1
#define kHaveModuleDontHave 2
static int
have_bigint() {
static unsigned char have_big_int = kHaveModuleNotChecked;
SV *rv;
if (have_big_int != kHaveModuleNotChecked) {
if (have_big_int == kHaveModule) {
return 1;
}
else {
return 0;
}
}
rv = eval_pv("require Math::BigInt", 0);
if (rv && SvTRUE(rv)) {
/* module loaded successfully */
have_big_int = kHaveModule;
return 1;
}
else {
/* we don't have it */
have_big_int = kHaveModuleDontHave;
return 0;
}
return 0;
}
static int
have_bigfloat() {
static unsigned char have_big_float = kHaveModuleNotChecked;
SV *rv;
if (have_big_float != kHaveModuleNotChecked) {
if (have_big_float == kHaveModule) {
return 1;
}
else {
return 0;
}
}
rv = eval_pv("require Math::BigFloat", 0);
if (rv && SvTRUE(rv)) {
/* module loaded successfully */
have_big_float = kHaveModule;
return 1;
}
else {
/* we don't have it */
have_big_float = kHaveModuleDontHave;
return 0;
}
return 0;
}
static SV *
get_new_big_int(SV * num_string) {
SV * class_name = newSVpv("Math::BigInt", 12);
SV * rv = NULL;
rv = json_call_method_one_arg_one_return(class_name, "new", num_string);
SvREFCNT_dec(class_name);
return rv;
}
static SV *
get_new_big_float(SV * num_string) {
SV * class_name = newSVpv("Math::BigFloat", 14);
SV * rv = NULL;
rv = json_call_method_one_arg_one_return(class_name, "new", num_string);
SvREFCNT_dec(class_name);
return rv;
}
static int
insert_entry(parse_callback_ctx * ctx, SV * val) {
parse_cb_stack_entry * cur_entry = CUR_STACK_ENTRY(ctx);
parse_cb_stack_entry * new_entry;
int type = 0;
int level = CUR_STACK_LEVEL(ctx);
SV * s;
if (SvROK(cur_entry->data)) {
s = SvRV(cur_entry->data);
type = SvTYPE(s);
if (type == SVt_PVAV) {
av_push((AV *)SvRV(cur_entry->data), val);
}
else {
/* must be a hash (SVt_PVHV) */
/* val must be a hash key, so push it onto the stack */
new_entry = PUSH_STACK_ENTRY(ctx);
new_entry->data = val;
}
}
else {
/* scalar -- must be a hash key, so insert the val */
s = cur_entry->data;
cur_entry = (parse_cb_stack_entry *)(ctx->stack + level - 1);
IGNORE_RV(hv_store_ent((HV *)SvRV(cur_entry->data), s, val, 0));
POP_STACK(ctx);
}
return 1;
}
static int
push_stack_val(parse_callback_ctx * ctx, SV * val) {
int cur_level = CUR_STACK_LEVEL(ctx);
/* parse_cb_stack_entry * cur_entry = CUR_STACK_ENTRY(ctx); */
parse_cb_stack_entry * new_entry;
int is_hash_or_array = 0;
int type = 0;
/*
int type = cur_entry->type;
int sv_type = SvTYPE(val);
*/
if (SvROK(val)) {
type = SvTYPE(SvRV(val));
if (type == SVt_PVHV || type == SVt_PVAV) {
is_hash_or_array = 1;
}
}
if (is_hash_or_array) {
if (cur_level >= 0) {
/* av_push((AV *)SvRV(cur_entry->data), val); */
SETUP_TRACE;
insert_entry(ctx, val);
}
new_entry = PUSH_STACK_ENTRY(ctx);
new_entry->data = val;
}
else {
SETUP_TRACE;
if (cur_level >= 0) {
SETUP_TRACE;
insert_entry(ctx, val);
}
else {
SETUP_TRACE;
new_entry = PUSH_STACK_ENTRY(ctx);
new_entry->data = val;
}
/* av_push((AV *)SvRV(cur_entry->data), val); */
}
return 1;
#if 0
switch (type) {
case TYPE_HASH_ENTRY:
new_entry = PUSH_STACK_ENTRY(ctx);
new_entry->type = TYPE_HASH_ENTRY_KEY;
new_entry->ref = NULL;
new_entry->data = val;
LOG_DEBUG("adding hash key");
break;
case TYPE_HASH_ENTRY_KEY:
new_entry = PUSH_STACK_ENTRY(ctx);
new_entry->type = TYPE_HASH_ENTRY_VAL;
new_entry->ref = NULL;
new_entry->data = val;
LOG_DEBUG("adding hash val");
break;
case TYPE_ARRAY_ELEMENT:
POP_STACK(ctx);
cur_entry = PUSH_STACK_ENTRY(ctx);
cur_entry->type = TYPE_ARRAY_ELEMENT;
if (SvOK(val)) {
cur_entry->ref = val;
cur_entry->data = SvRV(val);
} else {
cur_entry->ref = NULL;
cur_entry->data = val;
}
LOG_DEBUG("adding array element");
break;
default:
LOG_DEBUG("reached default case in push_stack_val()");
return 0;
break;
}
return 1;
#endif
}
static int
string_callback(void * cb_data, char * data, uint data_len, uint flags, uint level) {
parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data;
SV * val;
val = newSVpvn(data, data_len);
/* flag as utf-8 */
SvUTF8_on(val);
SETUP_TRACE;
push_stack_val(ctx, val);
SETUP_TRACE;
return 0;
}
static int
number_callback(void * cb_data, char * data, uint data_len, uint flags, uint level) {
parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data;
NV nv_val;
IV iv_val;
UV uv_val;
SV * sv_val = Nullsv;
SV * tmp_sv = Nullsv;
int try_big_num = 0;
char * uv_str = Nullch;
unsigned char number_done = 0;
SETUP_TRACE;
/* figure out if we need to create a BigNum object or not */
if (flags & (JSON_EVT_PARSE_NUMBER_HAVE_DECIMAL | JSON_EVT_PARSE_NUMBER_HAVE_EXPONENT)) {
if (flags & JSON_EVT_PARSE_NUMBER_HAVE_SIGN) {
if (data_len - 1 >= DBL_DIG) {
try_big_num = 1;
}
}
else if (data_len >= DBL_DIG) {
try_big_num = 1;
}
}
else {
if (flags & JSON_EVT_PARSE_NUMBER_HAVE_SIGN) {
if (data_len - 1 >= IV_DIG) {
if (data_len - 1 == IV_DIG) {
uv_str = form("%"IVdf"", (IV)IV_MIN);
if (strncmp(data, uv_str, data_len) > 0) {
try_big_num = 1;
}
}
else {
try_big_num = 1;
}
}
}
else {
if (data_len >= UV_DIG) {
if (data_len == UV_DIG) {
uv_str = form("%"UVuf"", (UV)UV_MAX);
if (strncmp(data, uv_str, data_len) > 0) {
try_big_num = 1;
}
}
else {
try_big_num = 1;
}
}
}
}
if (try_big_num) {
if (flags & (JSON_EVT_PARSE_NUMBER_HAVE_EXPONENT | JSON_EVT_PARSE_NUMBER_HAVE_DECIMAL)) {
if (have_bigfloat()) {
tmp_sv = newSVpvn(data, data_len);
sv_val = get_new_big_float(tmp_sv);
SvREFCNT_dec(tmp_sv);
}
}
else {
if (have_bigint()) {
tmp_sv = newSVpvn(data, data_len);
sv_val = get_new_big_int(tmp_sv);
SvREFCNT_dec(tmp_sv);
}
}
if (sv_val) {
if (SvOK(sv_val)) {
number_done = 1;
}
else {
SvREFCNT_dec(sv_val);
sv_val = Nullsv;
}
}
}
UNLESS (number_done) {
sv_val = newSVpvn(data, data_len);
if (try_big_num) {
/* we're in danger of overflow, so leave it as a string */
SvUTF8_on(sv_val);
}
else {
if (flags & (JSON_EVT_PARSE_NUMBER_HAVE_DECIMAL | JSON_EVT_PARSE_NUMBER_HAVE_EXPONENT)) {
/* float */
nv_val = SvNV(sv_val);
sv_setnv(sv_val, nv_val);
}
else if (flags & JSON_EVT_PARSE_NUMBER_HAVE_SIGN) {
/* signed int */
iv_val = SvIV(sv_val);
sv_setiv(sv_val, iv_val);
}
else {
/* unsigned int */
uv_val = SvUV(sv_val);
sv_setuv(sv_val, uv_val);
}
}
}
push_stack_val(ctx, sv_val);
return 0;
}
static int
array_begin_callback(void * cb_data, uint flags, uint level) {
parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data;
push_stack_val(ctx, newRV_noinc((SV *)newAV()));
LOG_DEBUG("\nin array_begin callback at level %u\n", level);
return 0;
}
static int
array_end_callback(void * cb_data, uint flags, uint level) {
parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data;
if (CUR_STACK_LEVEL(ctx) > 0) {
POP_STACK(ctx);
}
LOG_DEBUG("\nin array_end callback at level %u\n", level);
return 0;
}
#if 0
static int
array_element_begin_callback(void * cb_data, uint flags, uint level) {
LOG_DEBUG("\nin array element begin callback at level %u\n", level);
return 0;
}
static int
array_element_end_callback(void * cb_data, uint flags, uint level) {
LOG_DEBUG("\nin array element end callback at level %u\n", level);
return 0;
}
#endif
static int
hash_begin_callback(void * cb_data, uint flags, uint level) {
parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data;
push_stack_val(ctx, newRV_noinc((SV *)newHV()));
LOG_DEBUG("in hash_begin callback at level %u, cb_data is %"UVxf, level, PTR2UV(ctx));
return 0;
}
static int
hash_end_callback(void * cb_data, uint flags, uint level) {
parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data;
if (CUR_STACK_LEVEL(ctx) > 0) {
POP_STACK(ctx);
}
LOG_DEBUG("in hash_end callback at level %u, cb_data is %"UVxf, level, PTR2UV(ctx));
return 0;
}
#if 0
static int
hash_entry_begin_callback(void * cb_data, uint flags, uint level) {
/* parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data; */
LOG_DEBUG("in hash_entry_begin callback at level %u", level);
return 0;
}
static int
hash_entry_end_callback(void * cb_data, uint flags, uint level) {
/*
*/
LOG_DEBUG("\nin hash_entry_end callback at level %u, stack_level %d\n", level, ctx->stack_level);
return 0;
}
#endif
static int
bool_callback(void * cb_data, uint bool_val, uint flags, uint level) {
parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data;
SV * s;
if (ctx->options & EVT_OPTION_CONVERT_BOOL) {
s = get_new_bool_obj(bool_val);
}
else {
s = bool_val ? newSVuv(1) : newSVpvn("", 0);
}
push_stack_val(ctx, s);
LOG_DEBUG("\nin bool_callback with val %u at level %u\n", bool_val, level);
return 0;
}
static int
null_callback(void * cb_data, uint flags, uint level) {
parse_callback_ctx * ctx = (parse_callback_ctx *)cb_data;
SV * s = newSV(0);
push_stack_val(ctx, s);
return 0;
}
static int
sv_str_eq(SV * sv_val, const char * c_buf, STRLEN c_buf_len) {
STRLEN sv_len = 0;
char * sv_buf;
sv_buf = SvPV(sv_val, sv_len);
UNLESS (sv_len == c_buf_len) {
return 0;
}
UNLESS (memcmp((void *)sv_buf, (void *)c_buf, (size_t)c_buf_len)) {
return 1;
}
return 0;
}
static int
setup_options(jsonevt_ctx * json_ctx, parse_callback_ctx * ctx, SV * self_sv) {
SV ** ptr;
HV * self_hash;
IV num_keys = 0;
UNLESS (self_sv) {
return 0;
}
if (SvROK(self_sv)) {
self_hash = (HV *)SvRV(self_sv);
}
else {
self_hash = (HV *)self_sv;
}
if (SvTYPE(self_hash) != SVt_PVHV) {
return 0;
}
num_keys = HvKEYS(self_hash);
if (num_keys == 0) {
return 0;
}
ptr = hv_fetch((HV *)self_hash, "convert_bool", 12, 0);
if (ptr && SvTRUE(*ptr)) {
ctx->options |= EVT_OPTION_CONVERT_BOOL;
}
ptr = hv_fetch((HV *)self_hash, "use_exceptions", 14, 0);
if (ptr && SvTRUE(*ptr)) {
ctx->options |= EVT_OPTION_USE_EXCEPTIONS;
}
ptr = hv_fetch((HV *)self_hash, "bad_char_policy", 15, 0);
if (ptr && SvTRUE(*ptr)) {
if (sv_str_eq(*ptr, "convert", 7)) {
jsonevt_set_bad_char_policy(json_ctx, JSON_EVT_OPTION_BAD_CHAR_POLICY_CONVERT);
}
else if (sv_str_eq(*ptr, "pass_through", 12)) {
jsonevt_set_bad_char_policy(json_ctx, JSON_EVT_OPTION_BAD_CHAR_POLICY_PASS);
}
}
return 1;
}
static jsonevt_ctx *
init_cbs(perl_wrapper_ctx * pwctx, SV * self_sv) {
static jsonevt_ctx * ctx = (jsonevt_ctx *)0;
/* jsonevt_ctx * ctx = jsonevt_new_ctx(); */
parse_callback_ctx * cb_data;
/*
char * error = Nullch;
SV * rv = Nullsv;
HV * error_hash = Nullhv;
HV * stats = Nullhv;
int throw_exception = 0;
SV * tmp_sv = Nullsv;
SV * error_msg = Nullsv;
SV * error_data_ref = Nullsv;
SV * stats_ref = Nullsv;
*/
SETUP_TRACE;
UNLESS (ctx) {
ctx = jsonevt_new_ctx();
jsonevt_set_string_cb(ctx, string_callback);
jsonevt_set_number_cb(ctx, number_callback);
jsonevt_set_begin_array_cb(ctx, array_begin_callback);
jsonevt_set_end_array_cb(ctx, array_end_callback);
/*
jsonevt_set_begin_array_element_cb(ctx, array_element_begin_callback);
jsonevt_set_end_array_element_cb(ctx, array_element_end_callback);
*/
jsonevt_set_begin_hash_cb(ctx, hash_begin_callback);
jsonevt_set_end_hash_cb(ctx, hash_end_callback);
/*
jsonevt_set_begin_hash_entry_cb(ctx, hash_entry_begin_callback);
jsonevt_set_end_hash_entry_cb(ctx, hash_entry_end_callback);
*/
jsonevt_set_bool_cb(ctx, bool_callback);
jsonevt_set_null_cb(ctx, null_callback);
}
memzero(pwctx, sizeof(*pwctx));
cb_data = &pwctx->cbd;
/* memzero(&cb_data, sizeof(parse_callback_ctx)); */
cb_data->stack_size = 64;
New(0, cb_data->stack, cb_data->stack_size, parse_cb_stack_entry);
cb_data->stack_level = -1;
memzero(cb_data->stack, cb_data->stack_size * sizeof(parse_cb_stack_entry));
jsonevt_set_cb_data(ctx, cb_data);
if (self_sv) {
setup_options(ctx, cb_data, self_sv);
}
return ctx;
}
static SV *
handle_parse_result(int result, jsonevt_ctx * ctx, perl_wrapper_ctx * wctx) {
char * error = Nullch;
SV * rv = Nullsv;
HV * error_hash = Nullhv;
int throw_exception = 0;
SV * tmp_sv = Nullsv;
SV * error_msg = Nullsv;
SV * error_data_ref = Nullsv;
SV * stats_ref = Nullsv;
HV * stats = Nullhv;
UNLESS (result) {
SETUP_TRACE;
error = jsonevt_get_error(ctx);
if (wctx->cbd.options & EVT_OPTION_USE_EXCEPTIONS) {
throw_exception = 1;
}
SETUP_TRACE;
LOG_DEBUG("\nError: %s\n\n", error);
if (error) {
error_msg = newSVpvf("%s v%s %s", MOD_NAME, XS_VERSION, error);
}
else {
error_msg = newSVpvf("%s v%s - error", MOD_NAME, XS_VERSION);
}
error_hash = newHV();
error_data_ref = newRV_noinc((SV *)error_hash);
IGNORE_RV(hv_store(error_hash, "version", 7, newSVpvf("%s", XS_VERSION), 0));
IGNORE_RV(hv_store(error_hash, "char", 4, newSVuv(jsonevt_get_error_char_pos(ctx)), 0));
IGNORE_RV(hv_store(error_hash, "byte", 4, newSVuv(jsonevt_get_error_byte_pos(ctx)), 0));
IGNORE_RV(hv_store(error_hash, "line", 4, newSVuv(jsonevt_get_error_line(ctx)), 0));
IGNORE_RV(hv_store(error_hash, "col", 3, newSVuv(jsonevt_get_error_char_col(ctx)), 0));
IGNORE_RV(hv_store(error_hash, "byte_col", 8, newSVuv(jsonevt_get_error_byte_col(ctx)), 0));
tmp_sv = get_sv("JSON::DWIW::LastErrorData", 1);
sv_setsv(tmp_sv, error_data_ref);
SvREFCNT_dec(error_data_ref);
tmp_sv = get_sv("JSON::DWIW::LastError", 1);
sv_setsv(tmp_sv, error_msg); /* ref count decremented below after exceptions check */
tmp_sv = get_sv("JSON::DWIW::Last_Stats", 1);
sv_setsv(tmp_sv, &PL_sv_undef);
if (wctx->cbd.stack[0].data) {
SvREFCNT_dec(wctx->cbd.stack[0].data);
}
SETUP_TRACE;
}
else {
SETUP_TRACE;
rv = wctx->cbd.stack[0].data;
stats = newHV();
IGNORE_RV(hv_store(stats, "strings", 7,
newSVuv(jsonevt_get_stats_string_count(ctx)), 0));
IGNORE_RV(hv_store(stats, "max_string_bytes", 16,
newSVuv(jsonevt_get_stats_longest_string_bytes(ctx)), 0));
IGNORE_RV(hv_store(stats, "max_string_chars", 16,
newSVuv(jsonevt_get_stats_longest_string_chars(ctx)), 0));
IGNORE_RV(hv_store(stats, "numbers", 7,
newSVuv(jsonevt_get_stats_number_count(ctx)), 0));
IGNORE_RV(hv_store(stats, "bools", 5, newSVuv(jsonevt_get_stats_bool_count(ctx)), 0));
IGNORE_RV(hv_store(stats, "nulls", 5, newSVuv(jsonevt_get_stats_null_count(ctx)), 0));
IGNORE_RV(hv_store(stats, "hashes", 6, newSVuv(jsonevt_get_stats_hash_count(ctx)), 0));
IGNORE_RV(hv_store(stats, "arrays", 6, newSVuv(jsonevt_get_stats_array_count(ctx)), 0));
IGNORE_RV(hv_store(stats, "max_depth", 9,
newSVuv(jsonevt_get_stats_deepest_level(ctx)), 0));
IGNORE_RV(hv_store(stats, "lines", 5, newSVuv(jsonevt_get_stats_line_count(ctx)), 0));
IGNORE_RV(hv_store(stats, "bytes", 5, newSVuv(jsonevt_get_stats_byte_count(ctx)), 0));
IGNORE_RV(hv_store(stats, "chars", 5, newSVuv(jsonevt_get_stats_char_count(ctx)), 0));
tmp_sv = get_sv("JSON::DWIW::Last_Stats", 1);
stats_ref = newRV_noinc((SV *)stats);
sv_setsv(tmp_sv, stats_ref);
SvREFCNT_dec(stats_ref);
tmp_sv = get_sv("JSON::DWIW::LastErrorData", 1);
sv_setsv(tmp_sv, &PL_sv_undef);
tmp_sv = get_sv("JSON::DWIW::LastError", 1);
sv_setsv(tmp_sv, &PL_sv_undef);
}
/* fix memory leak -- the stack was allocated in init_cbs() */
free(wctx->cbd.stack); wctx->cbd.stack = NULL;
jsonevt_reset_ctx(ctx);
if (throw_exception) {
tmp_sv = get_sv("@", TRUE);
sv_setsv(tmp_sv, error_msg);
SvREFCNT_dec(error_msg);
croak(Nullch);
}
SvREFCNT_dec(error_msg);
/* LOG_DEBUG("\n\noriginal buf: %s\n\n", buf); */
if (rv) {
LOG_DEBUG("returning rv");
/* return &PL_sv_yes; */
return rv;
}
else {
LOG_DEBUG("returning undef");
return &PL_sv_undef;
}
return &PL_sv_undef;
}
SV *
do_json_parse_buf(SV * self_sv, char * buf, STRLEN buf_len) {
jsonevt_ctx * ctx;
perl_wrapper_ctx wctx;
SETUP_TRACE;
memzero(&wctx, sizeof(perl_wrapper_ctx));
ctx = init_cbs(&wctx, self_sv);
return handle_parse_result(jsonevt_parse(ctx, buf, buf_len), ctx, &wctx);
}
SV *
do_json_parse(SV * self_sv, SV * json_str_sv) {
char * buf;
STRLEN buf_len;
SETUP_TRACE;
buf = SvPV(json_str_sv, buf_len);
return do_json_parse_buf(self_sv, buf, buf_len);
}
SV *
do_json_parse_file(SV * self_sv, SV * file_sv) {
char * filename;
STRLEN filename_len;
jsonevt_ctx * ctx;
perl_wrapper_ctx wctx;
SETUP_TRACE;
filename = SvPV(file_sv, filename_len);
memzero(&wctx, sizeof(perl_wrapper_ctx));
ctx = init_cbs(&wctx, self_sv);
return handle_parse_result(jsonevt_parse_file(ctx, filename), ctx, &wctx);
}
JSON-DWIW-0.33/libjsonevt/ 0000755 0000764 0000764 00000000000 11216640546 013276 5 ustar don don JSON-DWIW-0.33/libjsonevt/utf32.h 0000644 0000764 0000764 00000002012 11173360305 014377 0 ustar don don /*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/utf32.h,v 1.3 2009-02-23 17:46:55 don Exp $ */
#ifndef UTF32_H
#define UTF32_H
#include "uni.h"
#include "int_defs.h"
UNI_DO_CPLUSPLUS_WRAP_BEGIN
uint32_t utf32_bytes_to_unicode(const uint8_t *orig_buf, uint32_t buf_len, uint32_t *ret_len,
uint32_t is_little_endian);
uint32_t utf32_unicode_to_bytes(uint32_t code_point, uint8_t *out_buf,
uint32_t output_little_endian);
UNI_DO_CPLUSPLUS_WRAP_END
#endif /* UTF32_H */
JSON-DWIW-0.33/libjsonevt/utf16.c 0000644 0000764 0000764 00000007016 11173360305 014405 0 ustar don don /* Creation date: 2008-04-05T22:10:32Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/utf16.c,v 1.3 2009-02-23 17:46:55 don Exp $ */
#include "utf16.h"
#define SAFE_SET_POINTER_VAL(ptr, val) if (ptr) { *(ptr) = val; }
uint32_t
utf16_bytes_to_unicode(const uint8_t *orig_buf, uint32_t buf_len, uint32_t *ret_len,
uint32_t is_little_endian) {
const uint8_t *s = orig_buf;
if (buf_len < 2) {
/* utf-16 requires at least two bytes for a code point */
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
if (is_little_endian) {
if ( (s[1] & 0xfc) == 0xd8 ) {
/* surrogate pair -- requires 4 bytes */
if (buf_len < 4) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
SAFE_SET_POINTER_VAL(ret_len, 4);
return 0x010000
+ ( s[2] | ((s[3] & 0x03) << 8) | ((*s & 0xff) << 10) | ((s[1] & 0x03) << 18) );
}
else {
SAFE_SET_POINTER_VAL(ret_len, 2);
return ( *s | (s[1] << 8) );
}
}
else { /* big endian */
if ( (*s & 0xfc) == 0xd8 ) {
/* surrogate pair -- requires 4 bytes */
if (buf_len < 4) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
SAFE_SET_POINTER_VAL(ret_len, 4);
return 0x010000
+ ( s[3] | ((s[2] & 0x03) << 8) | (s[1] << 10) | ((*s & 0x03) << 18) );
}
else {
SAFE_SET_POINTER_VAL(ret_len, 2);
return ( (*s << 8) | s[1] );
}
}
return 0;
}
uint32_t
utf16_unicode_to_bytes(uint32_t cp, uint8_t *out_buf, uint32_t output_little_endian) {
uint8_t *d = out_buf;
if (cp < 0xffff) {
/* single unsigned 16-bit code unit, so 2 bytes, with same value as the code point */
/* but 0xd800 .. 0xdfff are ill-formed */
if (cp >= 0xd800 && cp <= 0xdfff) {
*d = 0;
return 0;
}
/* big endian is the default */
if (output_little_endian) {
/* little endian */
*d++ = cp & 0xff;
*d++ = (cp & 0xff00) >> 8;
}
else {
/* big endian */
*d++ = (cp & 0xff00) >> 8;
*d++ = cp & 0xff;
}
return 2;
}
else {
/* use surrogate pairs */
cp -= 0x010000;
if (output_little_endian) {
/* little endian */
*d++ = (cp & 0x000ff300) >> 10;
*d++ = ((cp & 0x00300000) >> 18) | 0xd8;
*d++ = cp & 0x00ff;
*d++ = ((cp & 0x0300) >> 8) | 0xdc;
}
else {
/* big endian */
*d++ = ((cp & 0x00300000) >> 18) | 0xd8;
*d++ = (cp & 0x000ff300) >> 10;
*d++ = ((cp & 0x0300) >> 8) | 0xdc;
*d++ = cp & 0x00ff;
}
return 4;
}
return 0;
}
JSON-DWIW-0.33/libjsonevt/utf16.h 0000644 0000764 0000764 00000002105 11173360305 014404 0 ustar don don /* Creation date: 2008-04-05T22:11:13Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/utf16.h,v 1.2 2009-02-23 17:46:55 don Exp $ */
#ifndef UTF16_H
#define UTF16_H
#include "uni.h"
#include "int_defs.h"
UNI_DO_CPLUSPLUS_WRAP_BEGIN
uint32_t utf16_bytes_to_unicode(const uint8_t *orig_buf, uint32_t buf_len, uint32_t *ret_len,
uint32_t is_little_endian);
uint32_t utf16_unicode_to_bytes(uint32_t code_point, uint8_t *out_buf,
uint32_t output_little_endian);
UNI_DO_CPLUSPLUS_WRAP_END
#endif /* UTF16_H */
JSON-DWIW-0.33/libjsonevt/print.c 0000644 0000764 0000764 00000002303 11173360305 014566 0 ustar don don /* Creation date: 2008-12-03T12:59:04Z
* Authors: Don
*/
#ifdef __GNUC__
#ifndef _GNU_SOURCE
#define _GNU_SOURCE
#endif
#endif
#include
#include
#include
#include "jsonevt_config.h"
#include "print.h"
#define UNLESS(stuff) if (! stuff)
#define MEM_CPY(dst_buf, src_buf, size) memcpy(dst_buf, src_buf, size)
int
js_vasprintf(char **ret, const char *fmt, va_list *ap_ptr) {
#if !defined(JSONEVT_ON_WINDOWS) && defined(HAVE_FUNC_VASPRINTF)
return vasprintf(ret, fmt, *ap_ptr);
#else
char buf[4096];
int rv = 0;
UNLESS (ret) {
return 0;
}
*ret = NULL;
rv = vsnprintf(buf, 4096, fmt, *ap_ptr);
if (rv < 0) {
return rv;
}
if (rv >= 4096) {
/* just drop the rest of the msg */
rv = 4095;
}
*ret = (char *)malloc(rv + 1);
UNLESS (*ret) {
return -1;
}
MEM_CPY(*ret, buf, rv + 1);
(*ret)[rv] = '\x00'; /* in case the original buf was not large enough */
return rv;
#endif
}
int
js_asprintf(char ** ret, const char * fmt, ...) {
va_list ap;
int rv = 0;
va_start(ap, fmt);
rv = js_vasprintf(ret, fmt, &ap);
va_end(ap);
return rv;
}
JSON-DWIW-0.33/libjsonevt/uni.h 0000644 0000764 0000764 00000002436 11173360305 014241 0 ustar don don /* Creation date: 2008-04-05T21:10:18Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/uni.h,v 1.4 2009-02-23 17:46:55 don Exp $ */
#ifndef UNI_H
#define UNI_H
#include "int_defs.h"
#ifdef __cplusplus
#define UNI_DO_CPLUSPLUS_WRAP_BEGIN extern "C" {
#define UNI_DO_CPLUSPLUS_WRAP_END }
#else
#define UNI_DO_CPLUSPLUS_WRAP_BEGIN
#define UNI_DO_CPLUSPLUS_WRAP_END
#endif
UNI_DO_CPLUSPLUS_WRAP_BEGIN
/* if the only set bits are in the lower 7, then the byte sequence in utf-8 is the same as ascii */
#define UNICODE_IS_INVARIANT(v) (((uint32_t)v) < 0x80)
/* the byte order mark is the code point 0xFEFF */
/* encoded as utf-8: "\xef\xbb\xbf" */
#define UNICODE_IS_BOM(v) ((v) == 0xFEFF);
UNI_DO_CPLUSPLUS_WRAP_END
#endif /* UNI_H */
JSON-DWIW-0.33/libjsonevt/jsonevt_private.h 0000644 0000764 0000764 00000024266 11173360305 016675 0 ustar don don /* Creation date: 2007-07-18 00:51:42
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/jsonevt_private.h,v 1.33 2009-02-23 17:46:55 don Exp $ */
#ifndef JSONEVT_PRIVATE_H
#define JSONEVT_PRIVATE_H
#include "jsonevt.h"
#include "utf8.h"
#include "print.h"
JSON_DO_CPLUSPLUS_WRAP_BEGIN
#include
typedef struct {
char * buf;
uint len;
} json_datum;
struct context_flags_struct {
int have_char:1;
int pad:7;
};
typedef struct json_extern_ctx json_context;
struct json_extern_ctx {
char * buf;
uint len;
uint pos;
uint char_pos;
char * error;
uint error_byte_pos;
uint error_char_pos;
uint error_line;
uint error_byte_col;
uint error_char_col;
void * cb_data;
json_string_cb string_cb;
json_array_begin_cb begin_array_cb;
json_array_end_cb end_array_cb;
json_array_begin_element_cb begin_array_element_cb;
json_array_end_element_cb end_array_element_cb;
json_hash_begin_cb begin_hash_cb;
json_hash_end_cb end_hash_cb;
json_hash_begin_entry_cb begin_hash_entry_cb;
json_hash_end_entry_cb end_hash_entry_cb;
json_number_cb number_cb;
json_bool_cb bool_cb;
json_null_cb null_cb;
json_comment_cb comment_cb;
uint string_count;
uint longest_string_bytes;
uint longest_string_chars;
uint number_count;
uint bool_count;
uint null_count;
uint hash_count;
uint array_count;
uint deepest_level;
uint line;
uint byte_count;
uint char_count;
uint options;
uint bad_char_policy;
uint cur_char;
uint cur_char_len;
uint cur_byte_pos;
uint cur_char_pos;
uint cur_line;
uint cur_byte_col;
uint cur_char_col;
struct context_flags_struct flags;
jsonevt_ctx * ext_ctx;
};
/*
typedef struct {
char * buf;
uint len;
uint pos;
uint char_pos;
void * cb_data;
json_string_cb string_cb;
json_array_begin_cb begin_array_cb;
json_array_end_cb end_array_cb;
json_array_begin_element_cb begin_array_element_cb;
json_array_end_element_cb end_array_element_cb;
json_hash_begin_cb begin_hash_cb;
json_hash_end_cb end_hash_cb;
json_hash_begin_entry_cb begin_hash_entry_cb;
json_hash_end_entry_cb end_hash_entry_cb;
json_number_cb number_cb;
json_bool_cb bool_cb;
json_null_cb null_cb;
json_comment_cb comment_cb;
uint cur_char;
uint cur_char_len;
uint cur_byte_pos;
uint cur_char_pos;
uint cur_line;
uint cur_byte_col;
uint cur_char_col;
uint options;
uint bad_char_policy;
struct context_flags_struct flags;
jsonevt_ctx * ext_ctx;
} json_context;
*/
struct str_flags_struct {
int using_orig:1;
int pad:6;
};
typedef struct {
char * buf;
uint len;
uint pos;
char * stack_buf;
uint stack_buf_len;
struct str_flags_struct flags;
} json_str; /* used to build up string when parsing */
#define JSON_DO_DEBUG 0
#if defined(JSONEVT_HAVE_FULL_VARIADIC_MACROS)
#if JSON_DO_DEBUG
#define JSON_DEBUG(...) printf("in %s, %s (%d) - ", __func__, __FILE__, __LINE__); \
printf(__VA_ARGS__); \
printf("\n"); fflush(stdout)
#else
/* FIXME: make this work under compilers not supporting variadic macros */
#define JSON_DEBUG(...)
#endif
#else
static void JSON_DEBUG(...) { }
#endif
#if defined(JSONEVT_HAVE_FULL_VARIADIC_MACROS)
#if 0
#define PDB(...) fprintf(stderr, "in %s, line %d of %s: ", __func__, __LINE__, __FILE__); \
fprintf(stderr, __VA_ARGS__); fprintf(stderr, "\n"); fflush(stderr)
#else
#define PDB(...)
#endif
#else
static void PDB(...) { }
#endif
#ifdef JSONEVT_ON_WINDOWS
#define JSONEVT_INLINE_FUNC
#else
#define JSONEVT_INLINE_FUNC inline
#endif
#ifdef JSONEVT_ON_WINDOWS
#define _CRT_SECURE_NO_WARNINGS
#endif
#define UNLESS(stuff) if (! stuff)
#define BUF_EQ(buf1, buf2, len) ( strncmp(buf1, buf2, len) == 0 )
#define MEM_EQ(buf1, buf2, len) ( memcmp(buf1, buf2, len) == 0 )
#define HEX_NIBBLE_TO_INT(nc) \
( nc >= '0' && nc <= '9' ? (int)(nc - '0') : \
( nc >= 'a' && nc <= 'f' ? (int)(nc - 'a' + 10) : \
( nc >= 'A' && nc <= 'F' ? (int)(nc - 'A' + 10) : -1 ) \
) \
)
#define STATIC_BUF_SIZE 32
int js_asprintf(char ** ret, const char * fmt, ...);
#define ZERO_MEM(buf, buf_size) JSON_DEBUG("ZERO_MEM: buf=%p, size=%u", buf, buf_size); \
memzero(buf, buf_size)
#define MEM_CPY(dst_buf, src_buf, size) JSON_DEBUG("MEM_CPY: dst=%p, src=%p, size=%u", \
(dst_buf), (src_buf), (size)); \
memcpy(dst_buf, src_buf, size)
/* linefeed or line separator */
#define JSON_IS_END_OF_LINE(ch) ( (ch) == 0x0a || (ch) == 0x2028)
#define NEXT_CHAR(c) (next_char(c))
#define PEEK_CHAR(ctx) ( (ctx)->flags.have_char ? (ctx)->cur_char : peek_char(ctx) )
#define PEEK_CHAR_LEN(c) (c->cur_char_len);
#define HAVE_MORE_CHARS(ctx) (ctx->pos >= ctx->len ? 0 : 1)
#define GET_BUF(c) ((c)->buf)
#define GET_STACK_BUF(c) ((c)->stack_buf)
#define GET_STACK_BUF_LEN(s) ((s)->stack_buf_len)
#define USING_STACK_BUF(s) ((s)->stack_buf && (s)->buf == (s)->stack_buf)
#define USING_ORIG_BUF(s) ((s)->flags.using_orig)
#define CUR_POS(c) ((c)->cur_byte_pos)
#define CUR_CHAR(c) ( (c)->cur_char )
#define CUR_CHAR_POS(c) ((c)->cur_char_pos)
#define CUR_LINE(ctx) ((ctx)->cur_line)
#define CUR_COL(ctx) ((ctx)->cur_char_col)
#define CUR_BYTE_COL(ctx) ((ctx)->cur_byte_col)
#define CUR_BUF(c) (&c->buf[c->pos])
#define BUF_POS(c) ( (c)->pos )
#define BYTES_LEFT(c) ((c)->len - (c)->pos)
#define INIT_JSON_STR(s) ( ZERO_MEM(s, sizeof(json_str)) )
#define INCR_DATA_DEPTH(ctx, level) if (level > (ctx)->ext_ctx->deepest_level) \
{ (ctx)->ext_ctx->deepest_level = level; }
#define UPDATE_STATS_STRING_BYTES(ctx, len) if (len > (ctx)->ext_ctx->longest_string_bytes) \
{ (ctx)->ext_ctx->longest_string_bytes = len; }
#define UPDATE_STATS_STRING_CHARS(ctx, len) if (len > (ctx)->ext_ctx->longest_string_chars) \
{ (ctx)->ext_ctx->longest_string_chars = len; }
#define CLEAR_JSON_STR(s) JSON_DEBUG("CLEAR_JSON_STR() called: buf=%p, len=%u", (s)->buf, (s)->len); \
if (! (USING_ORIG_BUF(s) || USING_STACK_BUF(s)) ) { JSON_DEBUG("CLEAR_JSON_STR() - calling free(%p)", (s)->buf); free((void *)((s)->buf)); (s)->buf = NULL; } JSON_DEBUG("CLEAR_JSON_STR() completed: buf=%p, len=%u", (s)->buf, (s)->len)
#define INIT_JSON_STR_STATIC_BUF(s, orig_buf, orig_len, st_buf, st_buf_len) \
ZERO_MEM((void *)(s), sizeof(json_str)); (s)->flags.using_orig = 1; \
(s)->buf = (orig_buf); (s)->len = orig_len; \
(s)->stack_buf = st_buf; (s)->stack_buf_len = st_buf_len; \
JSON_DEBUG("INIT_JSON_STR_STATIC_BUF() called, orig_buf=%p, orig_len=%u", orig_buf, orig_len)
#define ALLOC_NEW_BUF(s, size) (s)->buf = (char *)malloc(size); \
(s)->len = size; \
JSON_DEBUG("ALLOC_NEW_BUF() called for size %u, returning %p", \
size, (s)->buf);
#define DO_REALLOC(buf, size) (buf ? realloc(buf, size) : malloc(size))
#define REALLOC_BUF(s, size) if (USING_STACK_BUF(s)) { switch_from_static_buf(s, size); } else { \
JSON_DEBUG("reallocing %p", (s)->buf); (s)->buf = (char *)DO_REALLOC((void *)((s)->buf), size); (s)->len = size; }
#define SWITCH_FROM_STATIC(s) JSON_DEBUG("SWITCH_FROM_STATIC() called"); if (USING_ORIG_BUF(s)) { switch_from_static_buf(s, 0); }
#define GROW_JSON_STR(s, min_size) if (min_size > (s)->len) { \
if (USING_ORIG_BUF(s)) { SWITCH_FROM_STATIC(s); REALLOC_BUF((s), min_size); } \
else { REALLOC_BUF((s), min_size); } }
/*
#define GROW_JSON_STR(s, min_size) (min_size > (s)->len ? (USING_ORIG_BUF(s) ? \
(SWITCH_TO_DYNAMIC(s), REALLOC_BUF((s), min_size)) : REALLOC_BUF((s), min_size)) : 0)
*/
#define APPEND_BYTES(s, bytes, len) GROW_JSON_STR(s, (s)->pos + len + 1); \
MEM_CPY(&((s)->buf[(s)->pos]), bytes, len); (s)->pos += len; \
JSON_DEBUG("APPEND_BYTES(): appended %u bytes to %p, starting at %p", \
len, (s)->buf, &((s)->buf[(s)->pos]) )
#define MAYBE_APPEND_BYTES(s, bytes, len) if (USING_ORIG_BUF(s)) { \
(s)->pos += len; } else { APPEND_BYTES(s, bytes, len); }
#define EAT_WHITESPACE(s, f) eat_whitespace(s, f, __LINE__)
#define CB_OK_VAL 0
#define CB_IS_TERM(the_call) (the_call ? 1 : 0)
#define DO_GEN_CALLBACK(ctx, c_name, flags, level) ( (ctx)->c_name ? \
(ctx)->c_name((ctx)->cb_data, flags, level) : CB_OK_VAL)
#define DO_BOOL_CALLBACK(ctx, val, flags, level) ( (ctx)->bool_cb ? \
(ctx)->bool_cb((ctx)->cb_data, val, flags, level) : CB_OK_VAL)
#define SET_CB_ERROR(ctx, cb_name) set_error(ctx, __FILE__, __LINE__, \
"early termination from %s callback", cb_name)
#define RET_CB_TERM(ctx, cb_name) SET_CB_ERROR(ctx, cb_name); return 0
/* return with early-termination code if the callback indicated we should do so */
#define DO_CB_WITH_RET(ctx, cb_name, the_call) if (CB_IS_TERM(the_call)) { RET_CB_TERM(ctx, cb_name); }
#define DO_BOOL_CALLBACK_WITH_RET(ctx, val, flags, level) \
DO_CB_WITH_RET(ctx, "bool", DO_BOOL_CALLBACK(ctx, val, flags, level))
#define DO_GEN_CALLBACK_WITH_RET(ctx, c_name, flags, level, c_name_str) \
DO_CB_WITH_RET(ctx, c_name_str, DO_GEN_CALLBACK(ctx, c_name, flags, level))
#define DO_COMMENT_CALLBACK(ctx, data, data_len, flags) ( (ctx)->comment_cb ? \
(ctx)->comment_cb((ctx)->cb_data, data, data_len, flags, 0) : CB_OK_VAL )
#define DO_COMMENT_CALLBACK_WITH_RET(ctx, data, data_len, flags) \
DO_CB_WITH_RET(ctx, "comment", DO_COMMENT_CALLBACK(ctx, data, data_len, flags))
JSON_DO_CPLUSPLUS_WRAP_END
#endif
JSON-DWIW-0.33/libjsonevt/int_defs.h 0000644 0000764 0000764 00000000666 11173360305 015244 0 ustar don don /* Creation date: 2008-04-05T03:57:11Z
* Authors: Don
*/
/* $Header: /repository/projects/libjsonevt/int_defs.h,v 1.2 2008-04-17 04:15:29 don Exp $ */
#ifndef INT_DEFS_H
#define INT_DEFS_H
#include "jsonevt_config.h"
#ifdef _MSC_VER
typedef unsigned __int8 uint8_t;
typedef unsigned __int32 uint32_t;
#else
#if 0
#ifdef __FreeBSD__
#include
#else
#include
#endif
#endif
#endif
#endif /* INT_DEFS_H */
JSON-DWIW-0.33/libjsonevt/json_writer.c 0000644 0000764 0000764 00000033274 11173360305 016012 0 ustar don don /* Creation date: 2008-11-27T07:33:50Z
* Authors: Don
*/
/*
Copyright (c) 2008-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/json_writer.c,v 1.6 2009-04-21 06:21:44 don Exp $ */
#include "jsonevt_private.h"
#include
#include
#include
#include
#include
#define WR_TYPE_PREFIX \
jsonevt_data_type type
typedef enum {
unknown, str, array, hash, float_val, int_val, uint_val, bool_val, data
} jsonevt_data_type;
struct jsonevt_writer_data_struct {
WR_TYPE_PREFIX;
};
struct jsonevt_float_struct {
WR_TYPE_PREFIX;
double val;
};
struct jsonevt_int_struct {
WR_TYPE_PREFIX;
long val;
};
struct jsonevt_uint_struct {
WR_TYPE_PREFIX;
unsigned long val;
};
struct jsonevt_bool_struct {
WR_TYPE_PREFIX;
int val;
};
struct jsonevt_string_struct {
WR_TYPE_PREFIX;
size_t size;
char * data;
};
typedef struct {
WR_TYPE_PREFIX; /* for debugging */
size_t max_size;
size_t used_size;
char * data;
} _jsonevt_buf;
/* typedef struct jsonevt_str_struct json_str_ctx; */
struct json_array_flags {
int started:1;
int ended: 1;
int pad:30;
};
struct jsonevt_array_struct {
WR_TYPE_PREFIX;
_jsonevt_buf * str_ctx;
size_t count;
struct json_array_flags flags;
};
struct json_hash_flags {
int started:1;
int ended: 1;
int pad:30;
};
struct jsonevt_hash_struct {
WR_TYPE_PREFIX;
_jsonevt_buf * str_ctx;
size_t count;
struct json_hash_flags flags;
};
static void *
_json_malloc(size_t size) {
return malloc(size);
}
static void *
_json_realloc(void *buf, size_t size) {
return realloc(buf, size);
}
static char *
_json_ensure_buf_size(_jsonevt_buf * ctx, size_t size) {
if (size == 0) {
size = 1;
}
if (ctx->data == 0) {
ctx->data = _json_malloc(size);
ctx->max_size = size;
}
else if (size > ctx->max_size) {
ctx->data = _json_realloc(ctx->data, size);
ctx->max_size = size;
}
return ctx->data;
}
jsonevt_float *
jsonevt_new_float(double val) {
jsonevt_float *ctx = _json_malloc(sizeof(jsonevt_float));
memset(ctx, 0, sizeof(jsonevt_float));
ctx->type = float_val;
ctx->val = val;
return ctx;
}
jsonevt_int *
jsonevt_new_int(long val) {
jsonevt_int *ctx = _json_malloc(sizeof(jsonevt_int));
memset(ctx, 0, sizeof(jsonevt_int));
ctx->type = int_val;
ctx->val = val;
return ctx;
}
jsonevt_uint *
jsonevt_new_uint(unsigned long val) {
jsonevt_uint *ctx = _json_malloc(sizeof(jsonevt_uint));
memset(ctx, 0, sizeof(jsonevt_uint));
ctx->type = uint_val;
ctx->val = val;
return ctx;
}
jsonevt_bool *
jsonevt_new_bool(int val) {
jsonevt_bool *ctx = _json_malloc(sizeof(jsonevt_bool));
memset(ctx, 0, sizeof(jsonevt_bool));
ctx->type = bool_val;
ctx->val = val;
return ctx;
}
jsonevt_string *
jsonevt_new_string(char * buf, size_t size) {
jsonevt_string * ctx = _json_malloc(sizeof(jsonevt_string));
UNLESS (buf) {
size = 0;
}
memset(ctx, 0, sizeof(jsonevt_string));
ctx->type = str;
ctx->size = size;
ctx->data = (char *)_json_malloc(size + 1);
memcpy(ctx->data, buf, size);
ctx->data[size] = 0;
return ctx;
}
static _jsonevt_buf *
json_new_buf(size_t size) {
_jsonevt_buf * ctx = _json_malloc(sizeof(_jsonevt_buf));
memset(ctx, 0, sizeof(_jsonevt_buf));
ctx->type = data;
if (size > 0) {
_json_ensure_buf_size(ctx, size + 1);
}
return ctx;
}
static void
_json_free_buf(_jsonevt_buf * ctx) {
if (! ctx) {
return;
}
if (ctx->data) {
free(ctx->data);
}
free(ctx);
}
static void
json_str_disown_buffer(_jsonevt_buf *ctx) {
if (ctx) {
memset(ctx, 0, sizeof(_jsonevt_buf));
}
}
static int
json_append_bytes(_jsonevt_buf * ctx, char * data, size_t length) {
size_t new_size;
UNLESS (data) {
length = 0;
}
if (ctx->max_size - ctx->used_size < length + 1) {
new_size = length + 1 + ctx->used_size;
_json_ensure_buf_size(ctx, new_size);
}
memcpy(&(ctx->data[ctx->used_size]), data, length);
ctx->used_size += length;
ctx->data[ctx->used_size] = '\x00';
return 1;
}
static int
json_append_one_byte(_jsonevt_buf * ctx, char to_append) {
return json_append_bytes(ctx, &to_append, 1);
}
static int
json_append_unicode_char(_jsonevt_buf * ctx, uint32_t code_point) {
uint32_t size = 0;
uint8_t bytes[4];
size = utf8_unicode_to_bytes(code_point, bytes);
return json_append_bytes(ctx, (char *)bytes, size);
}
static char *
json_get_str_buffer(_jsonevt_buf * ctx, size_t * size) {
if (size) {
*size = ctx->used_size;
}
return ctx->data;
}
static _jsonevt_buf *
_json_escape_c_buffer(char * str, size_t length, unsigned long options) {
_jsonevt_buf * ctx = json_new_buf(length + 1);
size_t i;
uint32_t this_char;
char * tmp_buf = NULL;
uint32_t char_len = 0;
/* opening quotes */
json_append_one_byte(ctx, '"');
for (i = 0; i < length;) {
this_char = utf8_bytes_to_unicode((uint8_t *)str + i, length - i - 1, &char_len);
if (char_len == 0) {
/* bad utf-8 sequence */
/* for now, assume latin-1 and convert to utf-8 */
char_len = 1;
this_char = str[i];
}
i += char_len;
switch (this_char) {
case '\\':
json_append_bytes(ctx, "\\\\", 2);
break;
case '"':
json_append_bytes(ctx, "\\\"", 2);
break;
case '/':
json_append_bytes(ctx, "\\/", 2);
break;
case 0x08:
json_append_bytes(ctx, "\\b", 2);
break;
case 0x0c:
json_append_bytes(ctx, "\\f", 2);
break;
case 0x0a:
json_append_bytes(ctx, "\\n", 2);
break;
case 0x0d:
json_append_bytes(ctx, "\\r", 2);
break;
case 0x09:
json_append_bytes(ctx, "\\t", 2);
break;
default:
if (this_char < 0x1f || ( this_char >= 0x80 && (options & JSON_EVT_OPTION_ASCII) ) ) {
/* FIXME: don't use js_asprintf -- instead convert
the bits directly to hex nibbles
*/
js_asprintf(&tmp_buf, "\\u%04x", this_char);
json_append_bytes(ctx, tmp_buf, strlen(tmp_buf));
free(tmp_buf); tmp_buf = NULL;
}
else {
json_append_unicode_char(ctx, this_char);
}
break;
}
}
/* closing quotes */
json_append_one_byte(ctx, '"');
return ctx;
}
char *
jsonevt_escape_c_buffer(char * in_buf, size_t length_in, size_t *length_out,
unsigned long options) {
_jsonevt_buf *str = _json_escape_c_buffer(in_buf, length_in, options);
char *ret_buf;
ret_buf = json_get_str_buffer(str, length_out);
json_str_disown_buffer(str);
_json_free_buf(str);
return ret_buf;
}
jsonevt_array *
jsonevt_new_array() {
jsonevt_array * ctx = _json_malloc(sizeof(jsonevt_array));
memset(ctx, 0, sizeof(jsonevt_array));
ctx->type = array;
return ctx;
}
void
jsonevt_free_array(jsonevt_array * ctx) {
UNLESS (ctx) {
return;
}
if (ctx->str_ctx) {
_json_free_buf(ctx->str_ctx);
}
free(ctx);
}
void
jsonevt_array_start(jsonevt_array * ctx) {
UNLESS (ctx->flags.started) {
ctx->str_ctx = json_new_buf(1);
json_append_one_byte(ctx->str_ctx, '[');
ctx->flags.started = 1;
}
}
void
jsonevt_array_end(jsonevt_array * ctx) {
json_append_one_byte(ctx->str_ctx, ']');
ctx->flags.ended = 1;
}
char *
jsonevt_array_get_string(jsonevt_array * ctx, size_t * length_ptr) {
UNLESS (ctx->str_ctx) {
return NULL;
}
if (length_ptr) {
*length_ptr = ctx->str_ctx->used_size;
}
return ctx->str_ctx->data;
}
int
jsonevt_array_append_raw_element(jsonevt_array * ctx, char * buf, size_t length) {
UNLESS (ctx->flags.started) {
ctx->str_ctx = json_new_buf(1 + length);
json_append_one_byte(ctx->str_ctx, '[');
ctx->flags.started = 1;
}
else if (ctx->count > 0) {
json_append_one_byte(ctx->str_ctx, ',');
}
json_append_bytes(ctx->str_ctx, buf, length);
ctx->count++;
return 1;
}
int
jsonevt_array_append_buffer(jsonevt_array * ctx, char * buf, size_t length) {
_jsonevt_buf * str_ctx = _json_escape_c_buffer(buf, length, JSON_EVT_OPTION_NONE);
int rv;
rv = jsonevt_array_append_raw_element(ctx, str_ctx->data, str_ctx->used_size);
_json_free_buf(str_ctx);
return rv;
}
int
jsonevt_array_append_string_buffer(jsonevt_array * array, char * buf) {
return jsonevt_array_append_buffer(array, buf, strlen(buf));
}
int
jsonevt_array_add_data(jsonevt_array *dest, jsonevt_writer_data *src) {
size_t src_len = 0;
char *src_buf = 0;
int rv = 0;
src_buf = jsonevt_get_data_string(src, &src_len);
rv = jsonevt_array_append_raw_element(dest, src_buf, src_len);
/* FIXME: decide here whether to free data in src */
return rv;
}
void
jsonevt_array_disown_buffer(jsonevt_array *array) {
json_str_disown_buffer(array->str_ctx);
}
jsonevt_hash *
jsonevt_new_hash() {
jsonevt_hash * ctx = (jsonevt_hash *)_json_malloc(sizeof(jsonevt_hash));
memset(ctx, 0, sizeof(jsonevt_hash));
ctx->type = hash;
return ctx;
}
void
jsonevt_free_hash(jsonevt_hash * ctx) {
UNLESS (ctx) {
return;
}
if (ctx->str_ctx) {
_json_free_buf(ctx->str_ctx);
}
free(ctx);
}
void
jsonevt_hash_start(jsonevt_hash * ctx) {
if (! ctx->flags.started) {
ctx->str_ctx = json_new_buf(0);
json_append_one_byte(ctx->str_ctx, '{');
ctx->flags.started = 1;
}
}
void
jsonevt_hash_end(jsonevt_hash * ctx) {
json_append_one_byte(ctx->str_ctx, '}');
}
char *
jsonevt_hash_get_string(jsonevt_hash * ctx, size_t * length_ptr) {
if (! ctx->str_ctx) {
return NULL;
}
if (length_ptr) {
*length_ptr = ctx->str_ctx->used_size;
}
return ctx->str_ctx->data;
}
char *
jsonevt_string_get_string(jsonevt_string *ctx, size_t * length_ptr) {
UNLESS (ctx->data) {
return NULL;
}
if (length_ptr) {
*length_ptr = ctx->size;
}
return ctx->data;
}
char *
jsonevt_get_data_string(jsonevt_writer_data *ctx, size_t *length_ptr) {
UNLESS (ctx) {
*length_ptr = 0;
return NULL;
}
if (ctx->type == array) {
return jsonevt_array_get_string((jsonevt_array *)ctx, length_ptr);
}
else if (ctx->type == hash) {
return jsonevt_hash_get_string((jsonevt_hash *)ctx, length_ptr);
}
else if (ctx->type == str) {
return jsonevt_string_get_string((jsonevt_string *)ctx, length_ptr);
}
*length_ptr = 0;
return NULL;
}
int
jsonevt_hash_append_raw_entry(jsonevt_hash * ctx, char * key, size_t key_size, char * val,
size_t val_size) {
_jsonevt_buf * key_ctx = _json_escape_c_buffer(key, key_size, JSON_EVT_OPTION_NONE);
if (! ctx->flags.started) {
/* add 3 -- 1 for open brace, 1 for closing brace, one for the colon */
ctx->str_ctx = json_new_buf(3 + key_ctx->used_size + val_size);
json_append_one_byte(ctx->str_ctx, '{');
ctx->flags.started = 1;
}
else if (ctx->count > 0) {
json_append_one_byte(ctx->str_ctx, ',');
}
json_append_bytes(ctx->str_ctx, key_ctx->data, key_ctx->used_size);
json_append_one_byte(ctx->str_ctx, ':');
json_append_bytes(ctx->str_ctx, val, val_size);
ctx->count++;
_json_free_buf(key_ctx);
return 1;
}
int
jsonevt_hash_append_buffer(jsonevt_hash * ctx, char * key, size_t key_size, char * val,
size_t val_size) {
_jsonevt_buf * val_ctx = _json_escape_c_buffer(val, val_size, JSON_EVT_OPTION_NONE);
int rv;
rv = jsonevt_hash_append_raw_entry(ctx, key, key_size, val_ctx->data, val_ctx->used_size);
_json_free_buf(val_ctx);
return rv;
}
int
jsonevt_hash_append_string_buffer(jsonevt_hash * hash, char * key, char * val) {
return jsonevt_hash_append_buffer(hash, key, strlen(key), val, strlen(val));
}
void
jsonevt_hash_disown_buffer(jsonevt_hash *hash) {
json_str_disown_buffer(hash->str_ctx);
}
int
jsonevt_hash_add_data(jsonevt_hash *dest, jsonevt_writer_data *src, char *key, size_t key_len) {
size_t src_len = 0;
char *src_buf = 0;
int rv = 0;
src_buf = jsonevt_get_data_string(src, &src_len);
rv = jsonevt_hash_append_raw_entry(dest, key, key_len, src_buf, src_len);
/* FIXME: decide here whether to free data in src */
return rv;
}
int
jsonevt_do_unit_tests() {
_jsonevt_buf * val_ctx;
char *test_buf = "foo \x0a \"\xe7\x81\xab\" bar";
char *expected_buf = NULL;
val_ctx = _json_escape_c_buffer(test_buf, strlen(test_buf), JSON_EVT_OPTION_NONE);
expected_buf = "foo \x0a \\\"\xe7\x81\xab\\\" bar";
printf("in: %s\n", test_buf);
printf("out: %s\n", val_ctx->data);
return 0;
}
JSON-DWIW-0.33/libjsonevt/utf8.c 0000644 0000764 0000764 00000007121 11175204013 014316 0 ustar don don /* Creation date: 2008-04-04T02:51:26Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/*
$Revision: 268 $
$Date: 2009-04-26 18:19:07 -0700 (Sun, 26 Apr 2009) $
*/
#include "utf8.h"
#define UNLESS(stuff) if (! stuff)
#define SAFE_SET_POINTER_VAL(ptr, val) if (ptr) { *(ptr) = val; }
uint32_t
utf8_bytes_to_unicode(const uint8_t *orig_buf, uint32_t buf_len, uint32_t *ret_len) {
uint32_t this_octet;
uint32_t code_point = 0;
uint32_t expected_len = 0;
uint32_t len = 0;
const uint8_t *buf = orig_buf;
if (buf_len == 0) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
this_octet = *buf;
if (UTF8_BYTE_IS_INVARIANT(this_octet)) {
SAFE_SET_POINTER_VAL(ret_len, 1);
return this_octet;
}
/* the first byte should not be a continuation byte */
if (UTF8_IS_CONTINUATION_BYTE(this_octet)) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
UNLESS (UTF8_IS_START_BYTE(this_octet)) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
/* compute the number of expected bytes and pull out the bits
contributing to the code point
*/
if ((this_octet & 0xf8) == 0xf0) {
expected_len = 4;
this_octet &= 0x07;
}
else if ((this_octet & 0xf0) == 0xe0) {
expected_len = 3;
this_octet &= 0x0f;
}
else if ((this_octet & 0xe0) == 0xc0) {
expected_len = 2;
this_octet &= 0x1f;
}
else {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
if (buf_len < expected_len) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
/* now need to grab the rest of the bytes */
/* grab the bits we want (mask with 0x3f) and OR it with the old value left shifted by 6 */
len = expected_len - 1;
buf++;
code_point = this_octet;
while (len--) {
UNLESS (UTF8_IS_CONTINUATION_BYTE(*buf)) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
this_octet = *buf;
this_octet = (this_octet & 0x3f) | (code_point << 6);
/* FIXME: should check here for illegal vals? */
buf++;
code_point = this_octet;
}
SAFE_SET_POINTER_VAL(ret_len, expected_len);
return code_point;
}
uint32_t
utf8_unicode_to_bytes(uint32_t cp, uint8_t *out_buf) {
uint8_t *d = out_buf;
if (UNICODE_IS_INVARIANT(cp)) {
*d = cp;
return 1;
}
if (cp < 0x0800) {
/* 2 bytes */
*d++ = (cp >> 6) | 0xc0;
*d++ = (cp & 0x3f) | 0x80;
return 2;
}
if (cp < 0x010000) {
/* 3 bytes */
*d++ = (cp >> 12) | 0xe0;
*d++ = ((cp >> 6) & 0x3f) | 0x80;
*d++ = (cp & 0x3f) | 0x80;
return 3;
}
if (cp < 0x200000) {
/* 4 bytes */
*d++ = (cp >> 18) | 0xf0;
*d++ = ((cp >> 12) & 0x3f) | 0x80;
*d++ = ((cp >> 6) & 0x3f) | 0x80;
*d++ = (cp & 0x3f) | 0x80;
return 4;
}
/* invalid */
*d = 0;
return 0;
}
JSON-DWIW-0.33/libjsonevt/jsonevt.h 0000644 0000764 0000764 00000020570 11173360305 015135 0 ustar don don /* Creation date: 2007-07-13 20:56:30
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/jsonevt.h,v 1.28 2009-04-21 06:21:44 don Exp $ */
#ifndef JSONEVT_H
#define JSONEVT_H
#include
#include "jsonevt_config.h"
#ifdef __cplusplus
#define JSON_DO_CPLUSPLUS_WRAP_BEGIN extern "C" {
#define JSON_DO_CPLUSPLUS_WRAP_END }
#else
#define JSON_DO_CPLUSPLUS_WRAP_BEGIN
#define JSON_DO_CPLUSPLUS_WRAP_END
#endif
JSON_DO_CPLUSPLUS_WRAP_BEGIN
#if defined(__WIN32) || defined(WIN32) || defined(_WIN32)
#define JSONEVT_ON_WINDOWS
#endif
#ifdef _MSC_VER
/* Microsoft Visual C++ */
#if _MSC_VER >= 1400
/* MS Visual C++ 2005 */
#define JSONEVT_HAVE_FULL_VARIADIC_MACROS
#define JSONEVT_HAVE_VARIADIC_MACROS
#endif
#if _MSC_VER < 1400
#define JSONEVT_NO_HAVE_VSNPRINTF
#endif
#endif
#ifdef __GNUC__
#define JSONEVT_HAVE_FULL_VARIADIC_MACROS
#define JSONEVT_HAVE_VARIADIC_MACROS
#endif
/* FIXME: probably should change this to ifdef HAVE_TYPE_UINT from jsonevt_config.h */
#ifdef JSONEVT_ON_WINDOWS
typedef unsigned int uint;
#endif
typedef struct json_extern_ctx jsonevt_ctx;
jsonevt_ctx * jsonevt_new_ctx();
void jsonevt_free_ctx(jsonevt_ctx * ctx);
void jsonevt_reset_ctx(jsonevt_ctx * ctx);
char * jsonevt_get_error(jsonevt_ctx * ctx);
int jsonevt_parse(jsonevt_ctx * ctx, char * buf, uint len);
int jsonevt_parse_file(jsonevt_ctx * ctx, char * file);
typedef int (*json_gen_cb)(void * cb_data, uint flags, uint level);
typedef int (*json_string_cb)(void * cb_data, char * data, uint data_len, uint flags, uint level);
typedef int (*json_number_cb)(void * cb_data, char * data, uint data_len, uint flags, uint level);
typedef int (*json_bool_cb)(void * cb_data, uint bool_val, uint flags, uint level);
typedef int (*json_comment_cb)(void * cb_data, char * data, uint data_len, uint flags, uint level);
typedef json_gen_cb json_array_begin_cb;
typedef json_gen_cb json_array_end_cb;
typedef json_gen_cb json_array_begin_element_cb;
typedef json_gen_cb json_array_end_element_cb;
typedef json_gen_cb json_hash_begin_cb;
typedef json_gen_cb json_hash_end_cb;
typedef json_gen_cb json_hash_begin_entry_cb;
typedef json_gen_cb json_hash_end_entry_cb;
typedef json_gen_cb json_null_cb;
int jsonevt_set_cb_data(jsonevt_ctx * ctx, void * data);
int jsonevt_set_string_cb(jsonevt_ctx * ctx, json_string_cb callback);
int jsonevt_set_number_cb(jsonevt_ctx * ctx, json_number_cb callback);
int jsonevt_set_begin_array_cb(jsonevt_ctx * ctx, json_array_begin_cb callback);
int jsonevt_set_end_array_cb(jsonevt_ctx * ctx, json_array_end_cb callback);
int jsonevt_set_begin_array_element_cb(jsonevt_ctx * ctx, json_array_begin_element_cb callback);
int jsonevt_set_end_array_element_cb(jsonevt_ctx * ctx, json_array_end_element_cb callback);
int jsonevt_set_begin_hash_cb(jsonevt_ctx * ctx, json_hash_begin_cb callback);
int jsonevt_set_end_hash_cb(jsonevt_ctx * ctx, json_hash_end_cb callback);
int jsonevt_set_begin_hash_entry_cb(jsonevt_ctx * ctx, json_hash_begin_entry_cb callback);
int jsonevt_set_end_hash_entry_cb(jsonevt_ctx * ctx, json_hash_end_entry_cb callback);
int jsonevt_set_bool_cb(jsonevt_ctx * ctx, json_bool_cb callback);
int jsonevt_set_null_cb(jsonevt_ctx * ctx, json_null_cb callback);
int jsonevt_set_comment_cb(jsonevt_ctx * ctx, json_comment_cb callback);
/* int jsonevt_set_options(jsonevt_ctx * ctx, uint options); */
int jsonevt_set_bad_char_policy(jsonevt_ctx * ctx, uint policy);
/* use these to find out where an error occurred or where a callback
terminated the parse early
*/
uint jsonevt_get_error_line(jsonevt_ctx * ctx);
uint jsonevt_get_error_char_col(jsonevt_ctx * ctx);
uint jsonevt_get_error_byte_col(jsonevt_ctx * ctx);
uint jsonevt_get_error_char_pos(jsonevt_ctx * ctx);
uint jsonevt_get_error_byte_pos(jsonevt_ctx * ctx);
uint jsonevt_get_stats_string_count(jsonevt_ctx * ctx);
uint jsonevt_get_stats_longest_string_bytes(jsonevt_ctx * ctx);
uint jsonevt_get_stats_longest_string_chars(jsonevt_ctx * ctx);
uint jsonevt_get_stats_number_count(jsonevt_ctx * ctx);
uint jsonevt_get_stats_bool_count(jsonevt_ctx * ctx);
uint jsonevt_get_stats_null_count(jsonevt_ctx * ctx);
uint jsonevt_get_stats_hash_count(jsonevt_ctx * ctx);
uint jsonevt_get_stats_array_count(jsonevt_ctx * ctx);
uint jsonevt_get_stats_deepest_level(jsonevt_ctx * ctx);
uint jsonevt_get_stats_line_count(jsonevt_ctx * ctx);
uint jsonevt_get_stats_byte_count(jsonevt_ctx * ctx);
uint jsonevt_get_stats_char_count(jsonevt_ctx * ctx);
void jsonevt_get_version(uint *major, uint *minor, uint *patch);
/* Use these inside a callback to find out where the parser is in the buffer/file. */
/* These will be implemented later. */
/*
uint jsonevt_get_line_num(jsonevt_ctx * ctx);
uint jsonevt_get_char_col(jsonevt_ctx * ctx);
uint jsonevt_get_byte_col(json_ctx * ctx);
uint jsonevt_get_char_pos(json_ctx * ctx);
uint jsonevt_get_byte_pos(json_ctx * ctx);
*/
#define JSON_EVT_PARSE_NUMBER_HAVE_SIGN 1
#define JSON_EVT_PARSE_NUMBER_HAVE_DECIMAL (1 << 1)
#define JSON_EVT_PARSE_NUMBER_HAVE_EXPONENT (1 << 2)
#define JSON_EVT_IS_HASH_KEY (1 << 3)
#define JSON_EVT_IS_HASH_VALUE (1 << 4)
#define JSON_EVT_IS_ARRAY_ELEMENT (1 << 5)
#define JSON_EVT_IS_C_COMMENT (1 << 6)
#define JSON_EVT_IS_CPLUSPLUS_COMMENT (1 << 7)
#define JSON_EVT_IS_PERL_COMMENT (1 << 8)
#define JSON_EVT_OPTION_NONE 0
#define JSON_EVT_OPTION_BAD_CHAR_POLICY_ERROR 0
#define JSON_EVT_OPTION_BAD_CHAR_POLICY_CONVERT 1
#define JSON_EVT_OPTION_BAD_CHAR_POLICY_PASS (1 << 1)
#define JSON_EVT_OPTION_ASCII (1 << 2)
/* #define JSON_EVT_OPTION_CONVERT_BOOL 1 */
#define JSON_EVT_MAJOR_VERSION 0
#define JSON_EVT_MINOR_VERSION 0
#define JSON_EVT_PATCH_LEVEL 9
/* writer */
typedef struct jsonevt_array_struct jsonevt_array;
typedef struct jsonevt_hash_struct jsonevt_hash;
typedef struct jsonevt_string_struct jsonevt_string;
typedef struct jsonevt_writer_data_struct jsonevt_writer_data;
typedef struct jsonevt_float_struct jsonevt_float;
typedef struct jsonevt_int_struct jsonevt_int;
typedef struct jsonevt_uint_struct jsonevt_uint;
typedef struct jsonevt_bool_struct jsonevt_bool;
jsonevt_float *jsonevt_new_float(double val);
jsonevt_int *jsonevt_new_int(long val);
jsonevt_uint *jsonevt_new_uint(unsigned long val);
jsonevt_bool *jsonevt_new_bool(int val);
jsonevt_string * json_new_string(char * buf, size_t size);
jsonevt_array * jsonevt_new_array();
void jsonevt_free_array(jsonevt_array * array);
void jsonevt_array_start(jsonevt_array * array);
void jsonevt_array_end(jsonevt_array * array);
int jsonevt_array_append_buffer(jsonevt_array * array, char * buf, size_t length);
int jsonevt_array_append_string_buffer(jsonevt_array * array, char * buf);
int jsonevt_array_append_raw_element(jsonevt_array * array, char * buf, size_t length);
char * jsonevt_array_get_string(jsonevt_array * array, size_t * length_ptr);
void jsonevt_array_disown_buffer(jsonevt_array *array);
int jsonevt_array_add_data(jsonevt_array *dest, jsonevt_writer_data *src);
jsonevt_hash * jsonevt_new_hash();
void jsonevt_free_hash(jsonevt_hash * hash);
void jsonevt_hash_start(jsonevt_hash * hash);
int jsonevt_hash_append_buffer(jsonevt_hash * hash, char * key, size_t key_size,
char * val, size_t val_size);
int jsonevt_hash_append_string_buffer(jsonevt_hash * hash, char * key, char * val);
int jsonevt_hash_append_raw_entry(jsonevt_hash * hash, char * key, size_t key_size,
char * val, size_t val_size);
char * jsonevt_hash_get_string(jsonevt_hash * hash, size_t * length_ptr);
void jsonevt_hash_disown_buffer(jsonevt_hash *hash);
int jsonevt_hash_add_data(jsonevt_hash *dest, jsonevt_writer_data *src, char *key, size_t key_len);
/* utility only -- not for normal use */
char * jsonevt_escape_c_buffer(char *in_buf, size_t length_in, size_t *length_out,
unsigned long options);
char * jsonevt_get_data_string(jsonevt_writer_data *ctx, size_t *length_ptr);
int jsonevt_do_unit_tests();
JSON_DO_CPLUSPLUS_WRAP_END
#endif
JSON-DWIW-0.33/libjsonevt/make_config.c 0000644 0000764 0000764 00000017025 11173360305 015703 0 ustar don don
#ifdef __GNUC__
#ifndef _GNU_SOURCE
#define _GNU_SOURCE
#endif
#endif
#include
#include
#include
#include
#include
#include
char *g_test_file = "test_config.c";
char *g_types[ ] = { "unsigned char", "unsigned short", "unsigned int", "unsigned long" };
static int
do_system_with_redirect(int argc, char *const argv[ ], FILE *stdout_redir, FILE *stderr_redir) {
char **arg_list;
int i = 0;
pid_t pid;
int status = 0;
int rv;
arg_list = (char **)malloc((argc + 1) * sizeof(char *));
for (i = 0; i < argc; i++) {
arg_list[i] = argv[i];
}
/* arg_list must be null-terminated */
arg_list[argc] = NULL;
fflush(NULL); /* flush all output streams */
pid = fork();
if (pid == -1) {
/* error */
return 1;
}
if (pid == 0) {
/* child */
if (stdout_redir) {
close(1);
fcntl(fileno(stdout_redir), F_DUPFD, 1);
}
if (stderr_redir) {
close(2);
fcntl(fileno(stdout_redir), F_DUPFD, 2);
}
rv = execvp(arg_list[0], arg_list);
fprintf(stderr, "execvp failed with val %d\n", rv);
exit(1);
}
else {
/* parent */
free(arg_list);
waitpid(pid, &status, 0);
if (WIFEXITED(status)) {
/* called exit */
return WEXITSTATUS(status);
}
}
return 1;
}
static int
do_system_with_file_redirect(int argc, char *const argv[ ], const char *file) {
int rv;
FILE *fp = fopen(file, "a");
if (! fp) {
return 2;
}
rv = do_system_with_redirect(argc, argv, fp, fp);
fclose(fp);
return rv;
}
/*
static int
do_system(int argc, char *const argv[ ]) {
return do_system_with_redirect(argc, argv, NULL, NULL);
}
*/
static void
print_head(FILE *fp) {
fprintf(fp, "\n");
fprintf(fp, "#ifndef JSONEVT_CONFIG_H\n");
fprintf(fp, "#define JSONEVT_CONFIG_H\n");
fprintf(fp, "\n");
}
static void
print_foot(FILE *fp) {
fprintf(fp, "\n#endif /* JSONEVT_CONFIG_H */\n");
}
static FILE *
sync_header(FILE *cur_fp, const char *new_file) {
FILE *fp = fopen(new_file, "w");
// long cur_pos = ftell(cur_fp);
char buf[1024];
int amt_read;
fseek(cur_fp, 0, 0);
while ( (amt_read = fread(buf, 1, 1024, cur_fp)) > 0 ) {
fwrite(buf, 1, amt_read, fp);
}
print_foot(fp);
return fp;
}
static int
test_include(const char *include_file, int exec_argc, char **exec_argv) {
FILE *fp = fopen(g_test_file, "w");
if (! fp) {
fprintf(stderr, "\ncouldn't open file %s for output!\n", g_test_file);
exit(1);
}
fprintf(fp, "\n");
fprintf(fp, "#include <%s>\n\n", include_file);
fprintf(fp, "int\nmain(int argc, char **argv) {\n");
fprintf(fp, " return 0;\n");
fprintf(fp, "}\n");
fclose(fp);
if (do_system_with_file_redirect(exec_argc, exec_argv, "config_output.txt")) {
return 0;
}
return 1;
}
static int
test_func(const char *func_name, int exec_argc, char **exec_argv, char *test_exec) {
FILE *fp = fopen(g_test_file, "w");
if (! fp) {
fprintf(stderr, "\ncouldn't open file %s for output!\n", g_test_file);
exit(1);
}
fprintf(fp, "\n");
fprintf(fp, "int %s();\n\n", func_name);
fprintf(fp, "int\nmain(int argc, char **argv) {\n");
fprintf(fp, " %s();\n", func_name);
fprintf(fp, " return 0;\n");
fprintf(fp, "}\n");
fclose(fp);
if (do_system_with_file_redirect(exec_argc, exec_argv, "config_output.txt")) {
return 0;
}
if (do_system_with_file_redirect(1, &test_exec, "config_output.txt")) {
return 0;
}
return 1;
}
static int
test_type(const char *type_name, int exec_argc, char **exec_argv, FILE *conf_fh) {
FILE *fp = sync_header(conf_fh, g_test_file);
if (! fp) {
fprintf(stderr, "\ncouldn't open file %s for output!\n", g_test_file);
exit(1);
}
fprintf(fp, "\n");
fprintf(fp, "int\nmain(int argc, char **argv) {\n");
fprintf(fp, " %s blah;\n", type_name);
fprintf(fp, " return 0;\n");
fprintf(fp, "}\n");
fclose(fp);
if (do_system_with_file_redirect(exec_argc, exec_argv, "config_output.txt")) {
return 0;
}
return 1;
}
typedef struct {
char *file;
char *name;
} test_rec;
int
main(int argc, char **argv) {
char *out_file = "jsonevt_config.h";
char *name;
char *file;
char *test_exec;
FILE *conf_fh;
/* int rv; */
int exec_argc;
char **exec_argv;
int i;
int first_arg_count = 0;
test_rec header_list[ ] = {
{ "stdint.h", "STDINT_H" },
{ "inttypes.h", "INT_TYPES_H" },
{ "sys/types.h", "SYS_TYPES_H" },
{ "sys/mman.h", "SYS_MMAN_H" },
{ "limits.h", "LIMITS_H" },
{NULL}
};
test_rec func_list[ ] = {
{ "vsnprintf", "VSNPRINTF" },
{ "_vsnprintf", "_VSNPRINTF" },
{ "vasprintf", "VASPRINTF" },
{ "asprintf", "ASPRINTF" },
{ "my_dummy_func", "MY_DUMMY_FUNC" },
{NULL}
};
test_rec type_list[ ] = {
{ "uint", "UINT" },
{NULL}
};
test_rec *hp;
if (argc < 4) {
fprintf(stderr, "Usage: make_config ...\n\n");
return 1;
}
first_arg_count = 1;
out_file = argv[1];
first_arg_count++;
test_exec = argv[2];
first_arg_count++;
exec_argc = argc - first_arg_count;
exec_argv = (char **)malloc((exec_argc + 1) * sizeof(char *));
for (i = 0; i < exec_argc; i++) {
exec_argv[i] = argv[i + first_arg_count];
}
exec_argv[exec_argc] = "test_config.c";
exec_argc++;
conf_fh = fopen(out_file, "w+");
if (! conf_fh) {
fprintf(stderr, "\ncouldn't open %s for output!\n", out_file);
return 1;
}
print_head(conf_fh);
hp = header_list;
while (hp && hp->file) {
file = hp->file;
name = hp->name;
fprintf(conf_fh, "/* %s */\n", file);
if (test_include(file, exec_argc, exec_argv)) {
/* printf("%s ok\n", file); */
fprintf(conf_fh, "#include <%s>\n", file);
fprintf(conf_fh, "#ifndef HAVE_%s\n", name);
fprintf(conf_fh, "#define HAVE_%s 1\n", name);
fprintf(conf_fh, "#endif\n");
}
fprintf(conf_fh, "\n");
hp++;
}
fprintf(conf_fh, "\n/* Functions */\n\n");
hp = func_list;
while (hp && hp->file) {
file = hp->file;
name = hp->name;
fprintf(conf_fh, "/* %s */\n", file);
if (test_func(file, exec_argc, exec_argv, test_exec)) {
fprintf(conf_fh, "#ifndef HAVE_FUNC_%s\n", name);
fprintf(conf_fh, "#define HAVE_FUNC_%s 1\n", name);
fprintf(conf_fh, "#endif\n");
}
else {
fprintf(conf_fh, "/* #define HAVE_FUNC_%s 1 */\n", name);
}
fprintf(conf_fh, "\n");
hp++;
}
fprintf(conf_fh, "\n/* Types */\n\n");
hp = type_list;
while (hp && hp->file) {
file = hp->file;
name = hp->name;
fprintf(conf_fh, "/* %s */\n", file);
if (test_type(file, exec_argc, exec_argv, conf_fh)) {
fprintf(conf_fh, "#ifndef HAVE_TYPE_%s\n", name);
fprintf(conf_fh, "#define HAVE_TYPE_%s 1\n", name);
fprintf(conf_fh, "#endif\n");
}
hp++;
}
print_foot(conf_fh);
free(exec_argv);
return 0;
}
JSON-DWIW-0.33/libjsonevt/jsonevt.c 0000644 0000764 0000764 00000125545 11175230340 015135 0 ustar don don /* Creation date: 2007-07-13 20:41:08
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/jsonevt.c,v 1.51 2009-02-24 06:22:21 don Exp $ */
/*
#if defined(__WIN32) || defined(WIN32) || defined(_WIN32)
#define JSONEVT_ON_WINDOWS
#endif
*/
#include "jsonevt_private.h"
#include
#include
#include
#include
#include
#ifdef JSONEVT_ON_WINDOWS
typedef unsigned int uint;
#endif
#ifndef JSONEVT_ON_WINDOWS
#define USE_MMAP
#endif
#ifdef USE_MMAP
#include
#include
#endif
#include
#include
#if 0
#define SETUP_TRACE fprintf(stderr, "in %s() at line %d of %s\n", __func__, __LINE__, __FILE__); \
fflush(stderr);
#else
#define SETUP_TRACE
#endif
#define memzero(buf, size) memset(buf, 0, size)
static char * vset_error(json_context * ctx, char * file, uint line, char * fmt, va_list *ap);
#ifdef JSONEVT_HAVE_VARIADIC_MACROS
#define SET_ERROR(ctx,fmt,...) set_error(ctx, __FILE__, __LINE__, fmt, ## __VA_ARGS__)
#else
static char *
SET_ERROR(json_context * ctx, char * fmt, ...) {
va_list ap;
char * error;
va_start(ap, fmt);
error = vset_error(ctx, "", 0, fmt, &ap);
va_end(ap);
return error;
}
#endif
#define ERROR_IS_SET(ctx) ((ctx)->ext_ctx->error)
#define BREAK_ON_ERROR(ctx) if (ERROR_IS_SET(ctx)) { break; }
static int parse_value(json_context * ctx, uint level, uint flags);
static char * set_error(json_context * ctx, char * file, uint line, char * fmt, ...);
/*
#define UNI_CHK_RETURN(ctx, val) ((ctx->options && (ctx->options & JSON_EVT_OPTION_BAD_CHAR_POLICY_CONVERT ? val : (ctx->options & JSON_EVT_OPTION_BAD_CHAR_POLICY_PASS ? val : 0)) ) : 0)
*/
static uint
json_utf8_to_uni_with_check(json_context * ctx, char * str, uint cur_len, uint * ret_len,
uint flags) {
uint uval;
unsigned char * s = (unsigned char *)str;
if (ret_len) {
*ret_len = 0;
}
if (cur_len == 0) {
return 0;
}
uval = utf8_bytes_to_unicode((uint8_t *)str, cur_len, ret_len);
if (uval == 0) {
if (ctx->bad_char_policy && (ctx->bad_char_policy & JSON_EVT_OPTION_BAD_CHAR_POLICY_CONVERT)) {
uval = (uint)*s;
if (ret_len) {
*ret_len = 1;
}
}
else {
SET_ERROR(ctx, "bad utf-8 sequence");
}
}
return uval;
}
#define UTF8_TO_CODE_POINT(ctx, str, cur_len, ret_len) ( cur_len > 0 ? ( UTF8_BYTE_IS_INVARIANT(*str) ? ( (*ret_len = 1), (uint)*str) : json_utf8_to_uni_with_check(ctx, str, cur_len, ret_len, 0)) : 0 )
#define READ_CHAR(ctx, ret_len) ( HAVE_MORE_CHARS(ctx) ? (UTF8_TO_CODE_POINT(ctx, &(ctx)->buf[(ctx)->pos], (ctx)->len - (ctx)->pos, ret_len)) : 0 )
static uint
peek_char(json_context * ctx) {
uint len = 0;
if (ctx->pos >= ctx->len) {
return 0;
}
ctx->cur_char = READ_CHAR(ctx, &len);
ctx->cur_char_len = len;
ctx->flags.have_char = 1;
return ctx->cur_char;
}
static uint
next_char(json_context * ctx) {
uint len = 0;
if (ctx->pos >= ctx->len) {
return 0;
}
if (JSON_IS_END_OF_LINE(ctx->cur_char)) {
ctx->cur_line++;
ctx->cur_byte_col = 0;
ctx->cur_char_col = 0;
}
else {
if (ctx->pos) {
ctx->cur_byte_col += ctx->cur_char_len;
ctx->cur_char_col++;
}
}
ctx->cur_byte_pos = ctx->pos;
ctx->cur_char = READ_CHAR(ctx, &len);
ctx->cur_char_len = len;
ctx->cur_char_pos = ctx->char_pos;
ctx->flags.have_char = 1;
ctx->pos += len;
ctx->char_pos++;
return ctx->cur_char;
}
static char *
vset_error(json_context * ctx, char * file, uint line, char * fmt, va_list *ap) {
char * error = NULL;
char * loc = NULL;
char * msg = NULL;
int loc_len = 0;
int msg_len = 0;
if (! ctx->ext_ctx) {
return NULL;
}
if (ctx->ext_ctx->error) {
return ctx->ext_ctx->error;
}
#if JSON_DO_DEBUG
loc_len = js_asprintf(&loc, "%s (%u) v%u.%u.%u byte %u, char %u, line %u, col %u (byte col %u) - ",
file, line, JSON_EVT_MAJOR_VERSION, JSON_EVT_MINOR_VERSION, JSON_EVT_PATCH_LEVEL,
CUR_POS(ctx), CUR_CHAR_POS(ctx), CUR_LINE(ctx), CUR_COL(ctx), CUR_BYTE_COL(ctx));
#else
#if NO_VERSION_IN_ERROR
loc_len = js_asprintf(&loc, "byte %u, char %u, line %u, col %u (byte col %u) - ",
CUR_POS(ctx), CUR_CHAR_POS(ctx), CUR_LINE(ctx), CUR_COL(ctx), CUR_BYTE_COL(ctx));
#else
loc_len = js_asprintf(&loc, "v%u.%u.%u byte %u, char %u, line %u, col %u (byte col %u) - ",
JSON_EVT_MAJOR_VERSION, JSON_EVT_MINOR_VERSION, JSON_EVT_PATCH_LEVEL,
CUR_POS(ctx), CUR_CHAR_POS(ctx), CUR_LINE(ctx), CUR_COL(ctx), CUR_BYTE_COL(ctx));
#endif
#endif
msg_len = js_vasprintf(&msg, fmt, ap);
error = (char *)malloc(loc_len + msg_len + 1);
MEM_CPY(error, loc, loc_len);
MEM_CPY(&error[loc_len], msg, msg_len);
error[loc_len + msg_len] = '\x00';
ctx->ext_ctx->error = error;
ctx->ext_ctx->error_line = CUR_LINE(ctx);
ctx->ext_ctx->error_char_col = CUR_COL(ctx);
ctx->ext_ctx->error_byte_col = CUR_BYTE_COL(ctx);
ctx->ext_ctx->error_byte_pos = CUR_POS(ctx);
ctx->ext_ctx->error_char_pos = CUR_CHAR_POS(ctx);
free(msg);
free(loc);
return error;
}
static char *
set_error(json_context * ctx, char * file, uint line, char * fmt, ...) {
va_list ap;
char * error;
va_start(ap, fmt);
error = vset_error(ctx, file, line, fmt, &ap);
va_end(ap);
return error;
}
static int
eat_whitespace(json_context *ctx, int commas_are_whitespace, uint line) {
uint this_char;
int keep_going = 1;
uint last_char = 0;
uint last_char_valid = 0;
char * tmp_buf = NULL;
SETUP_TRACE;
PDB("pos=%u, len=%u", ctx->pos, ctx->len);
if (! HAVE_MORE_CHARS(ctx)) {
return 0;
}
SETUP_TRACE;
while (keep_going && HAVE_MORE_CHARS(ctx)) {
this_char = PEEK_CHAR(ctx);
if (this_char >= 0x0009 && this_char <= 0x000d) {
/* U+0009 - tab
U+000A - line feed
U+000B - vertical tab
U+000C - form feed
U+000D - carriage return
*/
NEXT_CHAR(ctx);
continue;
}
switch (this_char) {
case 0x0020: /* space */
case 0x0085: /* NEL - next line */
case 0x00a0: /* NSBP - non-breaking space */
case 0x200b: /* ZWSP - zero width space */
case 0x2028: /* LS - line separator */
case 0x2029: /* PS - paragraph separator */
case 0x2060: /* WJ - word joiner */
NEXT_CHAR(ctx);
break;
case ',':
if (commas_are_whitespace) {
NEXT_CHAR(ctx);
}
else {
keep_going = 0;
}
break;
case '#':
tmp_buf = CUR_BUF(ctx);
while (HAVE_MORE_CHARS(ctx)) {
this_char = NEXT_CHAR(ctx);
if (this_char == 0x000a || this_char == 0x0085 || this_char == 0x2028) {
/* eat the eol char */
this_char = NEXT_CHAR(ctx);
DO_COMMENT_CALLBACK_WITH_RET(ctx, tmp_buf,
CUR_BUF(ctx) - tmp_buf - 1, JSON_EVT_IS_PERL_COMMENT);
break;
}
}
/* end of buffer */
DO_COMMENT_CALLBACK_WITH_RET(ctx, tmp_buf,
CUR_BUF(ctx) - tmp_buf, JSON_EVT_IS_PERL_COMMENT);
break;
case '/':
this_char = NEXT_CHAR(ctx);
if (this_char == '/') {
/* C++ style comment -- rest of line is a comment */
tmp_buf = CUR_BUF(ctx);
while (HAVE_MORE_CHARS(ctx)) {
this_char = NEXT_CHAR(ctx);
if (this_char == 0x000a || this_char == 0x0085 || this_char == 0x2028) {
/* eat the eol char */
this_char = NEXT_CHAR(ctx);
DO_COMMENT_CALLBACK_WITH_RET(ctx, tmp_buf,
CUR_BUF(ctx) - tmp_buf - 1, JSON_EVT_IS_CPLUSPLUS_COMMENT);
break;
}
}
/* end of buffer */
DO_COMMENT_CALLBACK_WITH_RET(ctx, tmp_buf,
CUR_BUF(ctx) - tmp_buf, JSON_EVT_IS_CPLUSPLUS_COMMENT);
break;
}
else if (this_char == '*') {
last_char_valid = 0;
tmp_buf = CUR_BUF(ctx);
while (HAVE_MORE_CHARS(ctx)) {
this_char = NEXT_CHAR(ctx);
if (last_char_valid) {
if (this_char == '/') {
if (last_char == '*') {
/* end of comment */
DO_COMMENT_CALLBACK_WITH_RET(ctx, tmp_buf,
CUR_BUF(ctx) - tmp_buf - 2, JSON_EVT_IS_C_COMMENT);
this_char = NEXT_CHAR(ctx);
break;
}
}
}
else {
last_char_valid = 1;
}
last_char = this_char;
}
}
else {
JSON_DEBUG("bad comment -- found first '/' but not second one");
SET_ERROR(ctx, "syntax error -- can't have '/' by itself");
return 0;
}
break;
default:
/* JSON_DEBUG("%c is not whitespace (code line %u)", this_char, line); */
keep_going = 0;
break;
}
}
return 1;
}
static uint
switch_from_static_buf(json_str * s, uint new_size) {
char * orig_buf = s->buf;
uint orig_len = s->len;
new_size = new_size > orig_len ? new_size : orig_len;
if (new_size == 0) {
new_size = 8;
}
ALLOC_NEW_BUF(s, new_size);
MEM_CPY(s->buf, orig_buf, orig_len);
s->flags.using_orig = 0;
JSON_DEBUG("-- switched to heap buf (%p, len %u), orig_buf is %p, len %u, stack_buf %p, len %u",
s->buf, new_size, orig_buf, orig_len, s->stack_buf, s->stack_buf_len);
return 1;
}
#if 0
static uint
switch_to_dynamic_buf(json_str * s) {
if (s->flags.using_orig) {
char * orig_buf = s->buf;
uint orig_len = s->len;
if (0 && s->stack_buf && orig_len <= s->stack_buf_len) {
JSON_DEBUG("-- switching to stack buf (%p), old buf is %p", s->stack_buf, orig_buf);
s->buf = s->stack_buf;
s->len = s->stack_buf_len;
}
else {
/* FIXME: should up to a power of 2 */
JSON_DEBUG("-- switching to heap buf");
ALLOC_NEW_BUF(s, orig_len);
}
MEM_CPY(s->buf, orig_buf, orig_len);
s->flags.using_orig = 0;
}
return 1;
}
#endif
#define UNICODE_TO_BYTES(ctx, code_point, out_buf) \
(UNICODE_IS_INVARIANT(code_point) ? (*(out_buf) = code_point, 1) : \
utf8_unicode_to_bytes((uint32_t)code_point, out_buf) )
/* return estimate JSON string size in bytes */
/* assume utf-8 for now */
static uint
estimate_json_string_size(char * buf, uint max_len, uint boundary_char, uint * end_quote_pos) {
uint i;
uint size = 0;
uint bytes_this_char = 0;
JSON_DEBUG("max_len=%u", max_len);
if (end_quote_pos) {
*end_quote_pos = 0;
}
for (i = 0; i < max_len; i++) {
if (size < max_len) {
if (buf[size] == boundary_char) {
if (end_quote_pos) {
*end_quote_pos = size;
JSON_DEBUG("set end_quote_pos=%u", *end_quote_pos);
}
break;
}
size++;
}
else {
JSON_DEBUG("returning size %u", size);
return size;
}
/* FIXME: utf-8 can be two bytes, both of which can have the high bit set, e.g.,
ce a9 (e with accute accent */
if (buf[size - 1] & 0x80) {
JSON_DEBUG("HERE in multibyte sequence");
/* multi-byte char */
bytes_this_char = 1;
size++;
while (bytes_this_char < 4) {
if (size < max_len) {
size++;
bytes_this_char++;
if (! (buf[size - 1] & 0x80) ) {
break;
}
}
else {
break;
}
}
}
}
JSON_DEBUG("returning size %u", size);
return size;
}
#define EAT_DIGITS(ctx) while (HAVE_MORE_CHARS(ctx) && \
CUR_CHAR(ctx) >= '0' && CUR_CHAR(ctx) <= '9' ) { NEXT_CHAR(ctx); } \
if (CUR_CHAR(ctx) >= '0' && CUR_CHAR(ctx) <= '9' ) { NEXT_CHAR(ctx); }
/*
#define EAT_DIGITS(ctx) fprintf(stderr, "looking at char %c\n", CUR_CHAR(ctx)); while (HAVE_MORE_CHARS(ctx) && \
CUR_CHAR(ctx) >= '0' && CUR_CHAR(ctx) <= '9' ) { NEXT_CHAR(ctx); fprintf(stderr, "looking at char %c\n", CUR_CHAR(ctx)); }
*/
#define kParseNumberHaveSign JSON_EVT_PARSE_NUMBER_HAVE_SIGN
#define kParseNumberHaveDecimal JSON_EVT_PARSE_NUMBER_HAVE_DECIMAL
#define kParseNumberHaveExponent JSON_EVT_PARSE_NUMBER_HAVE_EXPONENT
/*
#define kParseNumberDone (1 << 3)
#define kParseNumberTryBigNum (1 << 4)
*/
static int
parse_number(json_context * ctx, uint level, uint flags) {
uint this_char;
uint start_pos = 0;
uint len = 0;
this_char = PEEK_CHAR(ctx);
start_pos = CUR_POS(ctx);
if (this_char == '-') {
this_char = NEXT_CHAR(ctx);
flags |= kParseNumberHaveSign;
}
if (this_char < '0' || this_char > '9') {
SET_ERROR(ctx, "syntax error");
return 0;
}
ctx->ext_ctx->number_count++;
EAT_DIGITS(ctx);
if (HAVE_MORE_CHARS(ctx)) {
this_char = CUR_CHAR(ctx);
if (this_char == '.') {
flags |= kParseNumberHaveDecimal;
NEXT_CHAR(ctx);
EAT_DIGITS(ctx);
this_char = CUR_CHAR(ctx);
}
if (HAVE_MORE_CHARS(ctx)) {
if (this_char == 'E' || this_char == 'e') {
/* exponential notation */
flags |= kParseNumberHaveExponent;
this_char = NEXT_CHAR(ctx);
if (HAVE_MORE_CHARS(ctx)) {
if (this_char == '+' || this_char == '-') {
this_char = NEXT_CHAR(ctx);
}
EAT_DIGITS(ctx);
this_char = CUR_CHAR(ctx);
}
}
}
}
if (ctx->number_cb) {
len = CUR_POS(ctx) - start_pos;
/* work around edge case where the entire input is just a number */
if (level == 0) {
len++;
}
/*
if (BYTES_LEFT(ctx) == 0) {
len++;
}
*/
DO_CB_WITH_RET(ctx, "number", ctx->number_cb(ctx->cb_data, &(ctx->buf[start_pos]), len,
flags, level));
}
return 1;
}
/*
If is_identifier is true, this word is an identifier, e.g., an
unquoted hash key, so the characters is may consist of are limited to
[0-9A-Za-z_] and must start with a letter. If is_identifier is
false, the word must be either "true", "false", or "null".
*/
static int
parse_word(json_context * ctx, int is_identifier, uint level, uint flags) {
uint this_char = PEEK_CHAR(ctx);
uint start_pos;
char * start_buf;
uint len;
if (this_char >= '0' && this_char <= '9') {
if (flags & JSON_EVT_IS_HASH_KEY) {
SET_ERROR(ctx, "syntax error in hash key (bare keys must begin with [A-Za-z_0-9])");
return 0;
}
return parse_number(ctx, level, flags);
}
/* FIXME: check "strict" option here and error out if set and this is a hash key */
/* FIXME: check identifiers by section 5.16 of version 3.0 of unicode standard,
but allow $ and _
*/
start_pos = CUR_POS(ctx);
start_buf = &ctx->buf[start_pos];
while (HAVE_MORE_CHARS(ctx) &&
( (this_char >= '0' && this_char <= '9')
|| (this_char >= 'A' && this_char <= 'Z')
|| (this_char >= 'a' && this_char <= 'z')
|| this_char == '_' || this_char == '$'
)) {
this_char = NEXT_CHAR(ctx);
}
len = CUR_POS(ctx) - start_pos;
if (len == 0) {
if (flags & JSON_EVT_IS_HASH_VALUE) {
SET_ERROR(ctx, "syntax error in hash value");
}
else if (flags & JSON_EVT_IS_HASH_KEY) {
SET_ERROR(ctx, "syntax error in hash key");
}
else {
SET_ERROR(ctx, "syntax error");
}
return 0;
}
if (is_identifier) {
/* treat as if it were a string */
if (ctx->string_cb) {
DO_CB_WITH_RET(ctx, "string",
ctx->string_cb(ctx->cb_data, start_buf, len, flags, level));
}
ctx->ext_ctx->string_count++;
return 1;
}
else {
if (BUF_EQ("true", start_buf, len)) {
DO_BOOL_CALLBACK_WITH_RET(ctx, 1, flags, level);
ctx->ext_ctx->bool_count++;
return 1;
}
else if (BUF_EQ("false", start_buf, len)) {
DO_BOOL_CALLBACK_WITH_RET(ctx, 0, flags, level);
ctx->ext_ctx->bool_count++;
return 1;
}
else if (BUF_EQ("null", start_buf, len)) {
/* call null callback */
DO_GEN_CALLBACK_WITH_RET(ctx, null_cb, flags, level, "null");
ctx->ext_ctx->null_count++;
return 1;
}
else {
SET_ERROR(ctx, "syntax error");
/* fwrite(start_buf, 1, len, stdout); */
return 0;
}
}
SET_ERROR(ctx, "unknown error in parse_word()");
return 0;
}
#define GET_HEX_NIBBLE(ctx, nv, u_bytes, i, this_char, error_msg) \
this_char = NEXT_CHAR(ctx); \
nv = HEX_NIBBLE_TO_INT(this_char); \
if (nv == -1) { \
SET_ERROR(ctx, error_msg); \
CLEAR_JSON_STR(&str); \
return 0; \
} \
u_bytes[i] = (uint8_t)nv; \
i++;
static int
parse_string(json_context * ctx, uint level, uint flags) {
uint32_t this_char;
int nibble_val;
uint32_t quote_char;
uint char_count = 0;
uint buf_size = 0;
json_str str;
uint end_quote_pos = 0;
uint8_t u_bytes[4];
uint32_t u_bytes_len;
/* uint multiplier; */
int i;
/* uint this_val; */
uint first_time = 1;
char * orig_buf = NULL;
char stack_buf[STATIC_BUF_SIZE];
int cb_rv = CB_OK_VAL;
SETUP_TRACE;
ZERO_MEM((void *)&str, sizeof(json_str));
this_char = PEEK_CHAR(ctx);
if (this_char == '"' || this_char == '\'') {
quote_char = this_char;
}
else {
JSON_DEBUG("bad quote: 0x%04x", this_char);
SET_ERROR(ctx, "syntax error: missing quote in string");
return 0;
}
SETUP_TRACE;
ctx->ext_ctx->string_count++;
if (CUR_POS(ctx) == 0) {
NEXT_CHAR(ctx);
}
orig_buf = CUR_BUF(ctx);
while (HAVE_MORE_CHARS(ctx)) {
this_char = NEXT_CHAR(ctx);
BREAK_ON_ERROR(ctx);
if (first_time) {
first_time = 0;
buf_size = estimate_json_string_size(orig_buf, ctx->len - CUR_POS(ctx),
quote_char, &end_quote_pos);
INIT_JSON_STR_STATIC_BUF(&str, orig_buf, end_quote_pos, stack_buf, STATIC_BUF_SIZE);
GROW_JSON_STR(&str, buf_size);
}
if (this_char == quote_char) {
SETUP_TRACE;
UPDATE_STATS_STRING_BYTES(ctx, str.pos);
UPDATE_STATS_STRING_CHARS(ctx, char_count);
if (ctx->string_cb) {
SETUP_TRACE;
JSON_DEBUG("about to call string callback with buf %p, len %u, flags %#x, level %u",
str.buf, str.pos, flags, level);
cb_rv = ctx->string_cb(ctx->cb_data, str.buf, str.pos, flags, level);
SETUP_TRACE;
}
CLEAR_JSON_STR(&str);
if (CB_IS_TERM(cb_rv)) {
SETUP_TRACE;
SET_CB_ERROR(ctx, "string");
return 0;
}
/* eat the quote */
NEXT_CHAR(ctx);
BREAK_ON_ERROR(ctx);
SETUP_TRACE;
return 1;
}
char_count++;
if (this_char == '\\') {
this_char = NEXT_CHAR(ctx);
SWITCH_FROM_STATIC(&str);
/* FIXME: should \0 be accepted, as in the ECMA standard? */
switch (this_char) {
case '\\': /* 0x5c */
case '/': /* 0x2f */
case '"': /* 0x22 */
case '\'': /* 0x27 */
/* treat these as literals */
break;
case 'b': /* 0x62 */
this_char = 0x08; /* backspace */
break;
case 'n': /* 0x6e */
this_char = 0x0a; /* line feed */
break;
case 'v': /* 0x76 */
this_char = 0x0b; /* vertical tab */
break;
case 'f': /* 0x66 */
this_char = 0x0c; /* form feed */
break;
case 'r': /* 0x72 */
this_char = 0x0d; /* carriage return */
break;
case 't': /* 0x74 */
this_char = 0x09; /* tab */
break;
case 'x': /* 0x78 */
/* hex escape sequence */
#define BHE_MSG "bad hex escape character specification"
i = 0;
GET_HEX_NIBBLE(ctx, nibble_val, u_bytes, i, this_char, BHE_MSG);
GET_HEX_NIBBLE(ctx, nibble_val, u_bytes, i, this_char, BHE_MSG);
this_char = 16 * u_bytes[0] + u_bytes[1];
break;
case 'u': /* 0x75 */
/* unicode escape sequence */
#define BUE_MSG "bad unicode character specification"
i = 0;
GET_HEX_NIBBLE(ctx, nibble_val, u_bytes, i, this_char, BUE_MSG);
GET_HEX_NIBBLE(ctx, nibble_val, u_bytes, i, this_char, BUE_MSG);
GET_HEX_NIBBLE(ctx, nibble_val, u_bytes, i, this_char, BUE_MSG);
GET_HEX_NIBBLE(ctx, nibble_val, u_bytes, i, this_char, BUE_MSG);
this_char = 4096 * u_bytes[0] + 256 * u_bytes[1] + 16 * u_bytes[2] + u_bytes[3];
break;
default:
/* unrecognized escape, send it through literally */
/* FIXME: check "strict" option here and error out if set */
break;
}
}
BREAK_ON_ERROR(ctx);
u_bytes_len = UNICODE_TO_BYTES(ctx, this_char, u_bytes);
MAYBE_APPEND_BYTES(&str, u_bytes, u_bytes_len);
}
JSON_DEBUG("Error: got %c (0x%04x)", this_char, this_char);
SET_ERROR(ctx, "unterminated string");
CLEAR_JSON_STR(&str);
return 0;
}
static int
parse_array(json_context * ctx, uint level, uint flags) {
uint this_char = PEEK_CHAR(ctx);
int keep_going = 1;
int found_comma = 0;
if (this_char != '[') {
return 0;
}
ctx->ext_ctx->array_count++;
DO_GEN_CALLBACK_WITH_RET(ctx, begin_array_cb, flags, level, "begin_array");
level++;
INCR_DATA_DEPTH(ctx, level);
if (CUR_POS(ctx) == 0) {
NEXT_CHAR(ctx);
}
NEXT_CHAR(ctx);
EAT_WHITESPACE(ctx, 0);
this_char = PEEK_CHAR(ctx);
if (this_char == ']') {
DO_GEN_CALLBACK_WITH_RET(ctx, end_array_cb, flags, level - 1, "end_array");
NEXT_CHAR(ctx);
EAT_WHITESPACE(ctx, 0);
return 1;
}
while (keep_going) {
DO_GEN_CALLBACK_WITH_RET(ctx, begin_array_element_cb, 0, level, "begin_array_element");
if (! parse_value(ctx, level, JSON_EVT_IS_ARRAY_ELEMENT)) {
JSON_DEBUG("parse_value() returned error");
return 0;
}
DO_GEN_CALLBACK_WITH_RET(ctx, end_array_element_cb, 0, level, "end_array_element");
EAT_WHITESPACE(ctx, 0);
this_char = PEEK_CHAR(ctx);
if (this_char == ',') {
EAT_WHITESPACE(ctx, 1);
found_comma = 1;
}
else {
found_comma = 0;
}
switch (this_char) {
case ']':
/* end of the array */
DO_GEN_CALLBACK_WITH_RET(ctx, end_array_cb, flags, level - 1, "end_array");
NEXT_CHAR(ctx);
EAT_WHITESPACE(ctx, 0);
return 1;
break;
default:
if (! found_comma) {
/* error */
JSON_DEBUG("didn't find comma for array, char is %c", this_char);
SET_ERROR(ctx, "syntax error in array");
return 0;
}
break;
}
}
SET_ERROR(ctx, "unknown error in array");
return 0;
}
static int
parse_hash(json_context * ctx, uint level, uint flags) {
uint this_char = PEEK_CHAR(ctx);
int keep_going = 1;
int found_comma = 0;
JSON_DEBUG("parse_hash() called");
if (this_char != '{') {
SET_ERROR(ctx, "syntax error: bad object (didn't find '{'");
return 0;
}
ctx->ext_ctx->hash_count++;
JSON_DEBUG("before begin_hash_cb call");
DO_GEN_CALLBACK_WITH_RET(ctx, begin_hash_cb, flags, level, "begin_hash");
level++;
INCR_DATA_DEPTH(ctx, level);
JSON_DEBUG("after begin_hash_cb call");
if (CUR_POS(ctx) == 0) {
NEXT_CHAR(ctx);
}
NEXT_CHAR(ctx);
EAT_WHITESPACE(ctx, 1);
this_char = PEEK_CHAR(ctx);
if (this_char == '}') {
DO_GEN_CALLBACK_WITH_RET(ctx, end_hash_cb, flags, level - 1, "end_hash");
NEXT_CHAR(ctx);
EAT_WHITESPACE(ctx, 0);
return 1;
}
while (keep_going) {
EAT_WHITESPACE(ctx, 0);
this_char = PEEK_CHAR(ctx);
DO_GEN_CALLBACK_WITH_RET(ctx, begin_hash_entry_cb, 0, level, "begin_hash_entry");
/* this should be parse_string() or parse_identifier */
if (this_char == '\'' || this_char == '"') {
if (! parse_string(ctx, level, JSON_EVT_IS_HASH_KEY)) {
JSON_DEBUG("parse_string() returned error");
return 0;
}
}
else {
if (! parse_word(ctx, 1, level, JSON_EVT_IS_HASH_KEY) ) {
JSON_DEBUG("parse_word() returned error");
return 0;
}
}
EAT_WHITESPACE(ctx, 0);
this_char = PEEK_CHAR(ctx);
if (this_char != ':') {
JSON_DEBUG("parse error");
SET_ERROR(ctx, "syntax error: bad object (missing ':')");
return 0;
}
NEXT_CHAR(ctx);
EAT_WHITESPACE(ctx, 0);
JSON_DEBUG("looking at 0x%02x ('%c'), pos %u", PEEK_CHAR(ctx), PEEK_CHAR(ctx), ctx->pos);
if (!parse_value(ctx, level, JSON_EVT_IS_HASH_VALUE)) {
JSON_DEBUG("parse error in object");
return 0;
}
DO_GEN_CALLBACK_WITH_RET(ctx, end_hash_entry_cb, 0, level, "end_hash_entry");
EAT_WHITESPACE(ctx, 0);
this_char = PEEK_CHAR(ctx);
if (this_char == ',') {
found_comma = 1;
EAT_WHITESPACE(ctx, 1);
}
else {
found_comma = 0;
}
this_char = PEEK_CHAR(ctx);
switch (this_char) {
case '}':
DO_GEN_CALLBACK_WITH_RET(ctx, end_hash_cb, flags, level - 1, "end_hash");
NEXT_CHAR(ctx);
EAT_WHITESPACE(ctx, 0);
return 1;
break;
default:
if (! found_comma) {
SET_ERROR(ctx, "syntax error: bad object (missing ',' or '}')");
return 0;
}
break;
}
}
SET_ERROR(ctx, "unknown error in parse_hash()");
return 0;
}
static int
parse_value(json_context * ctx, uint level, uint flags) {
uint this_char;
SETUP_TRACE;
PDB("HERE");
EAT_WHITESPACE(ctx, 0);
this_char = PEEK_CHAR(ctx);
PDB("HERE - char is %#04x", this_char);
/* JSON_DEBUG("parse_value() - pos %u, char %c", CUR_POS(ctx), this_char); */
switch (this_char) {
case '"':
case '\'':
return parse_string(ctx, level, flags);
break;
case '[':
return parse_array(ctx, level, flags);
break;
case '{':
PDB("Found hash");
return parse_hash(ctx, level, flags);
break;
case '-':
case '+':
return parse_number(ctx, level, flags);
break;
default:
if (this_char >= '0' && this_char <= '9') {
return parse_number(ctx, level, flags);
}
return parse_word(ctx, 0, level, flags);
break;
}
return 0;
}
jsonevt_ctx *
jsonevt_new_ctx() {
jsonevt_ctx * ctx = (jsonevt_ctx *)malloc(sizeof(jsonevt_ctx));
ZERO_MEM((void *)ctx, sizeof(jsonevt_ctx));
JSON_DEBUG("allocated new jsonevt_ctx %p", ctx);
return ctx;
}
void
jsonevt_free_ctx(jsonevt_ctx * ext_ctx) {
if (ext_ctx) {
if (ext_ctx->error) {
free(ext_ctx->error);
ext_ctx->error = NULL;
}
JSON_DEBUG("deallocating jsonevt_ctx %p", ext_ctx);
free(ext_ctx);
JSON_DEBUG("deallocated jsonevt_ctx %p", ext_ctx);
}
}
void
jsonevt_reset_ctx(jsonevt_ctx * ctx) {
void * cb_data;
json_string_cb string_cb;
json_array_begin_cb begin_array_cb;
json_array_end_cb end_array_cb;
json_array_begin_element_cb begin_array_element_cb;
json_array_end_element_cb end_array_element_cb;
json_hash_begin_cb begin_hash_cb;
json_hash_end_cb end_hash_cb;
json_hash_begin_entry_cb begin_hash_entry_cb;
json_hash_end_entry_cb end_hash_entry_cb;
json_number_cb number_cb;
json_bool_cb bool_cb;
json_null_cb null_cb;
json_comment_cb comment_cb;
uint options;
uint bad_char_policy;
UNLESS (ctx) {
return;
}
ctx->ext_ctx = ctx;
cb_data = ctx->cb_data;
string_cb = ctx->string_cb;
begin_array_cb = ctx->begin_array_cb;
end_array_cb = ctx->end_array_cb;
begin_array_element_cb = ctx->begin_array_element_cb;
end_array_element_cb = ctx->end_array_element_cb;
begin_hash_cb = ctx->begin_hash_cb;
end_hash_cb = ctx->end_hash_cb;
begin_hash_entry_cb = ctx->begin_hash_entry_cb;
end_hash_entry_cb = ctx->end_hash_entry_cb;
number_cb = ctx->number_cb;
bool_cb = ctx->bool_cb;
null_cb = ctx->null_cb;
comment_cb = ctx->comment_cb;
options = ctx->options;
bad_char_policy = ctx->bad_char_policy;
if (ctx->error) {
free(ctx->error);
ctx->error = NULL;
}
ZERO_MEM((void *)ctx, sizeof(*ctx));
ctx->cb_data = cb_data;
ctx->string_cb = string_cb;
ctx->begin_array_cb = begin_array_cb;
ctx->end_array_cb = end_array_cb;
ctx->begin_array_element_cb = begin_array_element_cb;
ctx->end_array_element_cb = end_array_element_cb;
ctx->begin_hash_cb = begin_hash_cb;
ctx->end_hash_cb = end_hash_cb;
ctx->begin_hash_entry_cb = begin_hash_entry_cb;
ctx->end_hash_entry_cb = end_hash_entry_cb;
ctx->number_cb = number_cb;
ctx->bool_cb = bool_cb;
ctx->null_cb = null_cb;
ctx->comment_cb = comment_cb;
ctx->options = options;
ctx->bad_char_policy = bad_char_policy;
}
char *
jsonevt_get_error(jsonevt_ctx * ctx) {
return ctx->error;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_cb_data(jsonevt_ctx * ctx, void * data) {
if (ctx) {
ctx->cb_data = data;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_string_cb(jsonevt_ctx * ctx, json_string_cb callback) {
if (ctx) {
ctx->string_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_number_cb(jsonevt_ctx * ctx, json_number_cb callback) {
if (ctx) {
ctx->number_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_begin_array_cb(jsonevt_ctx * ctx, json_array_begin_cb callback) {
if (ctx) {
ctx->begin_array_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_end_array_cb(jsonevt_ctx * ctx, json_array_end_cb callback) {
if (ctx) {
ctx->end_array_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_begin_array_element_cb(jsonevt_ctx * ctx, json_array_begin_element_cb callback) {
if (ctx) {
ctx->begin_array_element_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_end_array_element_cb(jsonevt_ctx * ctx, json_array_end_element_cb callback) {
if (ctx) {
ctx->end_array_element_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_begin_hash_cb(jsonevt_ctx * ctx, json_hash_begin_cb callback) {
if (ctx) {
ctx->begin_hash_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_end_hash_cb(jsonevt_ctx * ctx, json_hash_end_cb callback) {
if (ctx) {
ctx->end_hash_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_begin_hash_entry_cb(jsonevt_ctx * ctx, json_hash_begin_entry_cb callback) {
if (ctx) {
ctx->begin_hash_entry_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_end_hash_entry_cb(jsonevt_ctx * ctx, json_hash_end_entry_cb callback) {
if (ctx) {
ctx->end_hash_entry_cb = callback;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_bool_cb(jsonevt_ctx * ctx, json_bool_cb callback) {
if (ctx) {
ctx->bool_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_null_cb(jsonevt_ctx * ctx, json_null_cb callback) {
if (ctx) {
ctx->null_cb = callback;
return 1;
}
return 0;
}
JSONEVT_INLINE_FUNC int
jsonevt_set_comment_cb(jsonevt_ctx * ctx, json_comment_cb callback) {
if (ctx) {
ctx->comment_cb = callback;
return 1;
}
return 0;
}
/*
JSONEVT_INLINE_FUNC int
jsonevt_set_options(jsonevt_ctx * ctx, uint options) {
ctx->options = options;
return 1;
}
*/
JSONEVT_INLINE_FUNC int
jsonevt_set_bad_char_policy(jsonevt_ctx * ctx, uint policy) {
ctx->bad_char_policy = policy;
return 1;
}
JSONEVT_INLINE_FUNC uint
jsonevt_get_error_line(jsonevt_ctx * ctx) {
return ctx->error_line;
}
JSONEVT_INLINE_FUNC uint
jsonevt_get_error_char_col(jsonevt_ctx * ctx) {
return ctx->error_char_col;
}
JSONEVT_INLINE_FUNC uint
jsonevt_get_error_byte_col(jsonevt_ctx * ctx) {
return ctx->error_byte_col;
}
JSONEVT_INLINE_FUNC uint
jsonevt_get_error_char_pos(jsonevt_ctx * ctx) {
return ctx->error_char_pos;
}
JSONEVT_INLINE_FUNC uint
jsonevt_get_error_byte_pos(jsonevt_ctx * ctx) {
return ctx->error_byte_pos;
}
uint
jsonevt_get_stats_string_count(jsonevt_ctx * ctx) {
return ctx->string_count;
}
uint
jsonevt_get_stats_longest_string_bytes(jsonevt_ctx * ctx) {
return ctx->longest_string_bytes;
}
uint
jsonevt_get_stats_longest_string_chars(jsonevt_ctx * ctx) {
return ctx->longest_string_chars;
}
uint
jsonevt_get_stats_number_count(jsonevt_ctx * ctx) {
return ctx->number_count;
}
uint
jsonevt_get_stats_bool_count(jsonevt_ctx * ctx) {
return ctx->bool_count;
}
uint
jsonevt_get_stats_null_count(jsonevt_ctx * ctx) {
return ctx->null_count;
}
uint
jsonevt_get_stats_hash_count(jsonevt_ctx * ctx) {
return ctx->hash_count;
}
uint
jsonevt_get_stats_array_count(jsonevt_ctx * ctx) {
return ctx->array_count;
}
uint
jsonevt_get_stats_deepest_level(jsonevt_ctx * ctx) {
return ctx->deepest_level;
}
uint
jsonevt_get_stats_line_count(jsonevt_ctx * ctx) {
return ctx->line;
}
uint
jsonevt_get_stats_byte_count(jsonevt_ctx * ctx) {
return ctx->byte_count;
}
uint
jsonevt_get_stats_char_count(jsonevt_ctx * ctx) {
return ctx->char_count;
}
/*
JSONEVT_INLINE_FUNC uint
jsonevt_get_line_num(jsonevt_ctx * ctx) {
return CUR_LINE(ctx);
}
*/
static int
check_bom(json_context * ctx) {
uint len = ctx->len;
char * buf = ctx->buf;
char * error_fmt = "found BOM for unsupported %s encoding -- this parser requires UTF-8";
/* check for UTF BOM signature */
/* The signature, if present, is the U+FEFF character encoded the
same as the rest of the buffer.
See .
*/
if (len >= 1) {
switch (*buf) {
case '\xEF': /* maybe utf-8 */
if (len >= 3 && MEM_EQ(buf, "\xEF\xBB\xBF", 3)) {
/* UTF-8 signature */
/* Move our position past the signature and parse as
if there were no signature, but this explicitly
indicates the buffer is encoded in utf-8
*/
NEXT_CHAR(ctx);
NEXT_CHAR(ctx);
}
return 1;
break;
/* The rest, if present are not supported by this
parser, so reject with an error.
*/
case '\xFE': /* maybe utf-16 big-endian */
if (len >= 2 && MEM_EQ(buf, "\xFE\xFF", 2)) {
/* UTF-16BE */
SET_ERROR(ctx, error_fmt, "UTF-16BE");
return 0;
}
break;
case '\xFF': /* maybe utf-16 little-endian or utf-32 little-endian */
if (len >= 2) {
if (MEM_EQ(buf, "\xFF\xFE", 2)) {
/* UTF-16LE */
SET_ERROR(ctx, error_fmt, "UTF-16LE");
return 0;
}
else if (len >= 4) {
if (MEM_EQ(buf, "\xFF\xFE\x00\x00", 4)) {
/* UTF-32LE */
SET_ERROR(ctx, error_fmt, "UTF-32LE");
return 0;
}
}
}
break;
case '\x00': /* maybe utf-32 big-endian */
if (len >= 4) {
if (MEM_EQ(buf, "\x00\x00\xFE\xFF", 4)) {
/* UTF-32BE */
SET_ERROR(ctx, error_fmt, "UTF-32B");
return 0;
}
}
break;
default:
/* allow through */
return 1;
break;
}
}
return 1;
}
int
jsonevt_parse(jsonevt_ctx * ext_ctx, char * buf, uint len) {
/* json_context ctx; */
jsonevt_ctx * ctx = ext_ctx;
int rv = 0;
/* memzero((void *)&ctx, sizeof(ctx)); */
jsonevt_reset_ctx(ctx);
ctx->buf = buf;
ctx->len = len;
ctx->pos = 0;
ctx->char_pos = 0;
ctx->cur_line = 1;
ctx->line = ctx->cur_line;
ctx->byte_count = 0;
ctx->char_count = 0;
ctx->ext_ctx = ctx;
/* ZERO_MEM( &(ctx->flags), sizeof(struct context_flags_struct) ); */
if (check_bom(ctx)) {
rv = parse_value(ctx, 0, 0);
JSON_DEBUG("pos=%d, len=%d", ctx->pos, ctx->len);
if (rv && ctx->pos < ctx->len) {
EAT_WHITESPACE(ctx, 0);
if (ctx->pos < ctx->len) {
/* garbage at end */
SET_ERROR(ctx, "syntax error - garbage at end of JSON");
rv = 0;
}
}
}
ctx->line = ctx->cur_line;
ctx->byte_count = ctx->cur_byte_pos;
ctx->char_count = ctx->cur_char_pos;
return rv;
}
void
jsonevt_get_version(uint *major, uint *minor, uint *patch) {
if (major) {
*major = JSON_EVT_MAJOR_VERSION;
}
if (minor) {
*minor = JSON_EVT_MINOR_VERSION;
}
if (patch) {
*patch = JSON_EVT_PATCH_LEVEL;
}
}
int
jsonevt_parse_file(jsonevt_ctx * ext_ctx, char * file) {
int rv;
char * buf = (char *)0;
json_context ctx;
#ifdef USE_MMAP
int fd;
size_t file_size;
struct stat file_info;
/*
#if sizeof(file_info.st_size) > sizeof(file_size)
#endif
*/
ZERO_MEM((void *)&ctx, sizeof(ctx));
ctx.ext_ctx = ext_ctx;
fd = open(file, O_RDONLY, 0);
if (fd < 0) {
JSON_DEBUG("couldn't open file %s", file);
SET_ERROR(&ctx, "couldn't open input file %s", file);
return 0;
}
if (fstat(fd, &file_info)) {
JSON_DEBUG("couldn't stat %s", file);
SET_ERROR(&ctx, "couldn't stat %s", file);
close(fd);
return 0;
}
file_size = file_info.st_size;
/* MAP_FILE == 0 */
#ifndef MAP_PRIVATE
#define MAP_PRIVATE 2
#endif
buf = (char *)mmap(NULL, file_size, PROT_READ, MAP_PRIVATE /*MAP_FIXED*/, fd, 0);
if (buf == MAP_FAILED) {
JSON_DEBUG("mmap failed.");
SET_ERROR(&ctx, "mmap call failed for file %s", file);
close(fd);
return 0;
}
#else
FILE * fp;
size_t file_size;
size_t amtread;
ZERO_MEM((void *)&ctx, sizeof(ctx));
fp = fopen(file, "r");
UNLESS (fp) {
JSON_DEBUG("couldn't open input file %s", file);
SET_ERROR(&ctx, "couldn't open input file %s", file);
return 0;
}
fseek(fp, 0, SEEK_END);
file_size = ftell(fp);
fseek(fp, 0, SEEK_SET);
buf = (char *)malloc(file_size);
/* FIXME: check for int overflow in file_size (size_t vs off_t) */
amtread = fread((void *)buf, 1, file_size, fp);
if (amtread != (size_t)file_size) {
free(buf);
fclose(fp);
JSON_DEBUG("got short read while slurping input file %s", file);
SET_ERROR(&ctx, "got short read while slurping input file %s", file);
return 0;
}
#endif
rv = jsonevt_parse(ext_ctx, buf, (uint)file_size);
#ifdef USE_MMAP
if (munmap(buf, file_size)) {
JSON_DEBUG("munmap failed.\n");
SET_ERROR(&ctx, "munmap failed");
close(fd);
return 0;
}
close(fd);
#else
free(buf);
fclose(fp);
#endif
return rv;
}
JSON-DWIW-0.33/libjsonevt/utf32.c 0000644 0000764 0000764 00000003751 11173360305 014405 0 ustar don don /* Creation date: 2008-04-06T02:35:32Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/utf32.c,v 1.3 2009-02-23 17:46:55 don Exp $ */
#include "utf32.h"
#define SAFE_SET_POINTER_VAL(ptr, val) if (ptr) { *(ptr) = val; }
uint32_t
utf32_bytes_to_unicode(const uint8_t *orig_buf, uint32_t buf_len, uint32_t *ret_len,
uint32_t is_little_endian) {
const uint8_t *s = orig_buf;
if (buf_len < 4) {
/* must be at least 4 bytes in a valid utf-32 sequence*/
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
SAFE_SET_POINTER_VAL(ret_len, 4);
if (is_little_endian) {
return ( *s | (s[1] << 8) | (s[2] << 16) | (s[3] << 24) );
}
else {
return ( s[3] | (s[2] << 8) | (s[1] << 16) | (*s << 24) );
}
return 0;
}
uint32_t
utf32_unicode_to_bytes(uint32_t cp, uint8_t *out_buf, uint32_t output_little_endian) {
uint8_t *d = out_buf;
/* 0xd800 .. 0xdfff are ill-formed */
if (cp >= 0xd800 && cp <= 0xdfff) {
*d = 0;
return 0;
}
if (output_little_endian) {
*d++ = cp & 0xff;
*d++ = (cp & 0xff00) >> 8;
*d++ = (cp & 0xff0000) >> 16;
*d++ = (cp & 0xff000000) >> 24;
return 4;
}
else {
*d++ = (cp & 0xff000000) >> 24;
*d++ = (cp & 0xff0000) >> 16;
*d++ = (cp & 0xff00) >> 8;
*d++ = cp & 0xff;
return 4;
}
return 0;
}
JSON-DWIW-0.33/libjsonevt/print.h 0000644 0000764 0000764 00000000423 11173360305 014574 0 ustar don don /* Creation date: 2008-12-03T12:59:26Z
* Authors: Don
*/
#ifndef _JSONEVT_PRINT_H_INCLUDED
#define _JSONEVT_PRINT_H_INCLUDED
#include
int js_vasprintf(char **ret, const char *fmt, va_list *ap_ptr);
int js_asprintf(char ** ret, const char * fmt, ...);
#endif
JSON-DWIW-0.33/libjsonevt/utf8.h 0000644 0000764 0000764 00000002771 11173360305 014336 0 ustar don don /* Creation date: 2008-04-04T17:19:54Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*/
/* $Header: /repository/projects/libjsonevt/utf8.h,v 1.2 2009-02-23 17:46:55 don Exp $ */
#ifndef UTF8_H
#define UTF8_H
#include "uni.h"
#include "int_defs.h"
UNI_DO_CPLUSPLUS_WRAP_BEGIN
uint32_t utf8_bytes_to_unicode(const uint8_t *orig_buf, uint32_t buf_len, uint32_t *ret_len);
uint32_t utf8_unicode_to_bytes(uint32_t code_point, uint8_t *out_buf);
/* if the only set bits are in the lower 7, then the byte sequence in utf-8 is the same as ascii */
#define UTF8_BYTE_IS_INVARIANT(v) (((uint8_t)v) < 0x80)
/* a continuation byte occurs in each byte after the first in a multibyte utf-8 sequence */
#define UTF8_IS_CONTINUATION_BYTE(v) ( ((uint8_t)v) >= 0x80 && ((uint8_t)v) <= 0xbf )
/* to be the starting byte in a multi-byte utf-8 sequences, the high two bits must be set */
#define UTF8_IS_START_BYTE(v) ( ((uint8_t)v) >= 0xc2 && ((uint8_t)v) <= 0xf4 )
UNI_DO_CPLUSPLUS_WRAP_END
#endif /* UTF8_H */
JSON-DWIW-0.33/old_common.c 0000644 0000764 0000764 00000012653 11173264050 013412 0 ustar don don /* Creation date: 2008-04-15T03:00:18Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
*/
#include "old_common.h"
#include "libjsonevt/utf8.h"
/* #define UNLESS(stuff) if (! stuff) */
#define SAFE_SET_POINTER_VAL(ptr, val) if (ptr) { *(ptr) = val; }
uint32_t
common_utf8_bytes_to_unicode(const uint8_t *orig_buf, uint32_t buf_len, uint32_t *ret_len) {
uint32_t this_octet;
uint32_t code_point = 0;
uint32_t expected_len = 0;
uint32_t len = 0;
const uint8_t *buf = orig_buf;
if (buf_len == 0) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
this_octet = *buf;
if (UTF8_BYTE_IS_INVARIANT(this_octet)) {
SAFE_SET_POINTER_VAL(ret_len, 1);
return this_octet;
}
/* the first byte should not be a continuation byte */
if (UTF8_IS_CONTINUATION_BYTE(this_octet)) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
UNLESS (UTF8_IS_START_BYTE(this_octet)) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
/* compute the number of expected bytes and pull out the bits
contributing to the code point
*/
if ((this_octet & 0xf8) == 0xf0) {
expected_len = 4;
this_octet &= 0x07;
}
else if ((this_octet & 0xf0) == 0xe0) {
expected_len = 3;
this_octet &= 0x0f;
}
else if ((this_octet & 0xe0) == 0xc0) {
expected_len = 2;
this_octet &= 0x1f;
}
else {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
if (buf_len < expected_len) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
/* now need to grab the rest of the bytes */
/* grab the bits we want (mask with 0x3f) and OR it with the old value left shifted by 6 */
len = expected_len - 1;
buf++;
code_point = this_octet;
while (len--) {
UNLESS (UTF8_IS_CONTINUATION_BYTE(*buf)) {
SAFE_SET_POINTER_VAL(ret_len, 0);
return 0;
}
this_octet = *buf;
this_octet = (this_octet & 0x3f) | (code_point << 6);
/* FIXME: should check here for illegal vals? */
buf++;
code_point = this_octet;
}
SAFE_SET_POINTER_VAL(ret_len, expected_len);
return code_point;
}
uint32_t
common_utf8_unicode_to_bytes(uint32_t cp, uint8_t *out_buf) {
uint8_t *d = out_buf;
if (UNICODE_IS_INVARIANT(cp)) {
*d = cp;
return 1;
}
if (cp < 0x0800) {
/* 2 bytes */
*d++ = (cp >> 6) | 0xc0;
*d++ = (cp & 0x3f) | 0x80;
return 2;
}
if (cp < 0x010000) {
/* 3 bytes */
*d++ = (cp >> 12) | 0xe0;
*d++ = ((cp >> 6) & 0x3f) | 0x80;
*d++ = (cp & 0x3f) | 0x80;
return 3;
}
if (cp < 0x200000) {
/* 4 bytes */
*d++ = (cp >> 18) | 0xf0;
*d++ = ((cp >> 12) & 0x3f) | 0x80;
*d++ = ((cp >> 6) & 0x3f) | 0x80;
*d++ = (cp & 0x3f) | 0x80;
return 4;
}
/* invalid */
*d = 0;
return 0;
}
UV
get_bad_char_policy(HV * self_hash) {
SV ** ptr = NULL;
U8 * data_str = NULL;
STRLEN data_str_len = 0;
ptr = hv_fetch((HV *)self_hash, "bad_char_policy", 15, 0);
if (ptr && SvTRUE(*ptr)) {
data_str = (U8 *)SvPV(*ptr, data_str_len);
if (data_str && data_str_len) {
if (strnEQ("error", (char *)data_str, data_str_len)) {
return kBadCharError;
}
else if (strnEQ("convert", (char *)data_str, data_str_len)) {
return kBadCharConvert;
}
else if (strnEQ("pass_through", (char *)data_str, data_str_len)) {
return kBadCharPassThrough;
}
}
}
return kBadCharError;
}
static int g_have_big_int = kHaveModuleNotChecked;
static int g_have_big_float = kHaveModuleNotChecked;
int
have_bigint() {
SV *rv;
if (g_have_big_int != kHaveModuleNotChecked) {
if (g_have_big_int == kHaveModule) {
return 1;
}
else {
return 0;
}
}
rv = eval_pv("require Math::BigInt", 0);
if (rv && SvTRUE(rv)) {
/* module loaded successfully */
g_have_big_int = kHaveModule;
return 1;
}
else {
/* we don't have it */
g_have_big_int = kHaveModuleDontHave;
return 0;
}
return 0;
}
int
have_bigfloat() {
SV *rv;
if (g_have_big_float != kHaveModuleNotChecked) {
if (g_have_big_float == kHaveModule) {
return 1;
}
else {
return 0;
}
}
rv = eval_pv("require Math::BigFloat", 0);
if (rv && SvTRUE(rv)) {
/* module loaded successfully */
g_have_big_float = kHaveModule;
return 1;
}
else {
/* we don't have it */
g_have_big_float = kHaveModuleDontHave;
return 0;
}
return 0;
}
JSON-DWIW-0.33/lib/ 0000755 0000764 0000764 00000000000 11216640546 011665 5 ustar don don JSON-DWIW-0.33/lib/JSON/ 0000755 0000764 0000764 00000000000 11216640546 012436 5 ustar don don JSON-DWIW-0.33/lib/JSON/DWIW/ 0000755 0000764 0000764 00000000000 11216640546 013210 5 ustar don don JSON-DWIW-0.33/lib/JSON/DWIW/Boolean.pm 0000644 0000764 0000764 00000006352 11173264050 015125 0 ustar don don # Creation date: 2007-05-10 20:29:02
# Authors: don
#
# Copyright (c) 2007 Don Owens . All rights reserved.
#
# This is free software; you can redistribute it and/or modify it under
# the Perl Artistic license. You should have received a copy of the
# Artistic license with this distribution, in the file named
# "Artistic". You may also obtain a copy from
# http://regexguy.com/license/Artistic
#
# This program is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.
=pod
=head1 NAME
JSON::DWIW::Boolean - Return a true or false value when
evaluated in boolean context -- to be used
with JSON::DWIW->encode() to explicitly
specify a boolean value.`
=head1 SYNOPSIS
use JSON::DWIW;
my $val1 = JSON::DWIW->true;
my $val2 = JSON::DWIW->false;
or
use JSON::DWIW::Boolean;
my $val1 = JSON::DWIW::Boolean->new(1); # true value
my $val2 = JSON::DWIW::Boolean->new(0); # false value
=head1 DESCRIPTION
This module is not intended to be used directly. It is intended
to be used as part of JSON::DWIW to specify that a true or false
value should be output when converting to JSON, since Perl does
not have explicit values for true and false.
Overloading is used, so if a JSON::DWIW::Boolean object is
evaluated in boolean context, it will evaluate to 1 or 0,
depending on whether the object was initialized to true or false.
=cut
use strict;
use warnings;
use 5.006_00;
package JSON::DWIW::Boolean;
use overload
bool => sub { my $self = shift; my $val = $$self; return $val ? 1 : 0; },
'0+' => sub { my $self = shift; my $val = $$self; return $val ? 1 : 0; };
our $VERSION = sprintf("%d.%02d",(q$Revision: 1.4 $ =~ /\d+/g));
=pod
=head1 METHODS
=head2 new($val)
Return an object initialized with $val as its boolean value.
=cut
sub new {
my $proto = shift;
my $val = shift;
my $obj = $val;
my $self = bless \$obj, ref($proto) || $proto;
return $self;
}
=pod
=head2 true()
Class method that returns a new object initialized to a true value.
=cut
sub true {
my $proto = shift;
return $proto->new(1);
}
=pod
=head2 false()
Class method that returns a new object initialized to a false value.
=cut
sub false {
my $proto = shift;
return $proto->new(0);
}
sub as_bool {
my $self = shift;
my $val = $$self;
if ($val) {
return 1;
}
return;
}
=pod
=head1 EXAMPLES
=head1 DEPENDENCIES
=head1 AUTHOR
Don Owens
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2007 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See perlartistic.
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
=head1 SEE ALSO
=head1 VERSION
0.01
=cut
1;
# Local Variables: #
# mode: perl #
# tab-width: 4 #
# indent-tabs-mode: nil #
# cperl-indent-level: 4 #
# perl-indent-level: 4 #
# End: #
# vim:set ai si et sta ts=4 sw=4 sts=4:
JSON-DWIW-0.33/lib/JSON/DWIW.pm 0000644 0000764 0000764 00000052454 11216640370 013553 0 ustar don don # Creation date: 2007-02-19 16:54:44
# Authors: don
#
# Copyright (c) 2007-2009 Don Owens . All rights reserved.
#
# This is free software; you can redistribute it and/or modify it under
# the Perl Artistic license. You should have received a copy of the
# Artistic license with this distribution, in the file named
# "Artistic". You may also obtain a copy from
# http://regexguy.com/license/Artistic
#
# This program is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.
=pod
=head1 NAME
JSON::DWIW - JSON converter that Does What I Want
=head1 SYNOPSIS
use JSON::DWIW;
my $json_obj = JSON::DWIW->new;
my $data = $json_obj->from_json($json_str);
my $str = $json_obj->to_json($data);
my ($data, $error_string) = $json_obj->from_json($json_str);
my $data = JSON::DWIW::deserialize($json_str);
my $error_str = JSON::DWIW::get_error_string;
use JSON::DWIW qw/deserialize_json from_json/
my $data = deserialize_json($json_str);
my $error_str = JSON::DWIW::get_error_string;
my $error_string = $json_obj->get_error_string;
my $error_data = $json_obj->get_error_data;
my $stats = $json_obj->get_stats;
my $data = $json_obj->from_json_file($file)
my $ok = $json_obj->to_json_file($data, $file);
my $data = JSON::DWIW->from_json($json_str);
my $str = JSON:DWIW->to_json($data);
my $data = JSON::DWIW->from_json($json_str, \%options);
my $str = JSON::DWIW->to_json($data, \%options);
my $true_value = JSON::DWIW->true;
my $false_value = JSON::DWIW->false;
my $data = { var1 => "stuff", var2 => $true_value,
var3 => $false_value, };
my $str = JSON::DWIW->to_json($data);
=head1 DESCRIPTION
Other JSON modules require setting several parameters before
calling the conversion methods to do what I want. This module
does things by default that I think should be done when working
with JSON in Perl. This module also encodes and decodes faster
than JSON.pm and JSON::Syck in my benchmarks.
This means that any piece of data in Perl (assuming it's valid
unicode) will get converted to something in JSON instead of
throwing an exception. It also means that output will be strict
JSON, while accepted input will be flexible, without having to
set any options.
=head2 Encoding
Perl objects get encoded as their underlying data structure, with
the exception of Math::BigInt and Math::BigFloat, which will be
output as numbers, and JSON::DWIW::Boolean, which will get output
as a true or false value (see the true() and false() methods).
For example, a blessed hash ref will be represented as an object
in JSON, a blessed array will be represented as an array. etc. A
reference to a scalar is dereferenced and represented as the
scalar itself. Globs, Code refs, etc., get stringified, and
undef becomes null.
Scalars that have been used as both a string and a number will be
output as a string. A reference to a reference is currently
output as an empty string, but this may change.
You may notice there is a deserialize function, but not a
serialize one. The deserialize function was written as a full
rewrite (the parsing is in a separate, event-based library now)
of from_json (now from_json calls deserialize). In the future,
there will be a serialize function that is a rewrite of to_json.
=head2 Decoding
Input is expected to utf-8. When decoding, null, true, and false
become undef, 1, and 0, repectively. Numbers that appear to be
too long to be supported natively are converted to Math::BigInt
or Math::BigFloat objects, if you have them installed.
Otherwise, long numbers are turned into strings to prevent data
loss.
The parser is flexible in what it accepts and handles some
things not in the JSON spec:
=over 4
=item quotes
Both single and double quotes are allowed for quoting a string, e.g.,
[ "string1", 'string2' ]
=item bare keys
Object/hash keys can be bare if they look like an identifier, e.g.,
{ var1: "myval1", var2: "myval2" }
=item extra commas
Extra commas in objects/hashes and arrays are ignored, e.g.,
[1,2,3,,,4,]
becomes a 4 element array containing 1, 2, 3, and 4.
=item escape sequences
Latin1 hexadecimal escape sequences (\xHH) are accepted, as in
Javascript. Also, the vertical tab escape \v is recognized (\u000b).
=item comments
C, C++, and shell-style comments are accepted. That is
/* this is a comment */
// this is a comment
# this is also a comment
=back
=cut
use strict;
use warnings;
use 5.006_00;
use JSON::DWIW::Boolean;
package JSON::DWIW;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
require Exporter;
require DynaLoader;
@ISA = qw(DynaLoader);
@EXPORT = ( );
@EXPORT_OK = ();
%EXPORT_TAGS = (all => [ 'to_json', 'from_json', 'deserialize_json' ]);
Exporter::export_ok_tags('all');
# change in POD as well!
our $VERSION = '0.33';
JSON::DWIW->bootstrap($VERSION);
{
package JSON::DWIW::Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter);
*EXPORT = \@JSON::DWIW::EXPORT;
*EXPORT_OK = \@JSON::DWIW::EXPORT_OK;
*EXPORT_TAGS = \%JSON::DWIW::EXPORT_TAGS;
*deserialize_json = \&JSON::DWIW::deserialize_json;
sub import {
JSON::DWIW::Exporter->export_to_level(2, @_);
}
sub to_json {
return JSON::DWIW->to_json(@_);
}
sub from_json {
# return JSON::DWIW->from_json(@_);
return JSON::DWIW::deserialize(@_);
}
}
sub import {
JSON::DWIW::Exporter::import(@_);
}
{
# workaround for weird importing bug on some installations
local($SIG{__DIE__});
eval qq{
use Math::BigInt;
use Math::BigFloat;
};
}
=pod
=head1 METHODS
=head2 new(\%options)
Create a new JSON::DWIW object.
%options is an optional hash of parameters that will change the
bahavior of this module when encoding to JSON. You may also
pass these options as the second argument to to_json() and
from_json(). The following options are supported:
=head3 bare_keys
If set to a true value, keys in hashes will not be quoted when
converted to JSON if they look like identifiers. This is valid
Javascript in current browsers, but not in JSON.
=head3 use_exceptions
If set to a true value, errors found when converting to or from
JSON will result in die() being called with the error message.
The default is to not use exceptions.
=head3 bad_char_policy
This options indicates what should be done if bad characters are
found, e.g., bad utf-8 sequence. The default is to return an
error and drop all the output.
The following values for bad_char_policy are supported:
=head4 error
default action, i.e., drop any output built up and return an error
=head4 convert
Convert to a utf-8 char using the value of the byte as a code
point. This is basically the same as assuming the bad character
is in latin-1 and converting it to utf-8.
=head4 pass_through
Ignore the error and pass through the raw bytes (invalid JSON)
=head3 escape_multi_byte
If set to a true value, escape all multi-byte characters (e.g.,
\u00e9) when converting to JSON.
=head3 pretty
Add white space to the output when calling to_json() to make the
output easier for humans to read.
=head3 convert_bool
When converting from JSON, return objects for booleans so that
"true" and "false" can be maintained when encoding and decoding.
If this flag is set, then "true" becomes a JSON::DWIW::Boolean
object that evaluates to true in a boolean context, and "false"
becomes an object that evaluates to false in a boolean context.
These objects are recognized by the to_json() method, so they
will be output as "true" or "false" instead of "1" or "0".
=cut
sub new {
my $proto = shift;
my $self = bless {}, ref($proto) || $proto;
my $params = shift;
return $self unless $params;
unless (defined($params) and UNIVERSAL::isa($params, 'HASH')) {
return $self;
}
foreach my $field (qw/bare_keys use_exceptions bad_char_policy dump_vars pretty
escape_multi_byte convert_bool detect_circular_refs/) {
if (exists($params->{$field})) {
$self->{$field} = $params->{$field};
}
}
return $self;
}
=pod
=head2 to_json
Returns the JSON representation of $data (arbitrary
datastructure). See http://www.json.org/ for details.
Called in list context, this method returns a list whose first
element is the encoded JSON string and the second element is an
error message, if any. If $error_msg is defined, there was a
problem converting to JSON. You may also pass a second argument
to to_json() that is a reference to a hash of options -- see
new().
my $json_str = JSON::DWIW->to_json($data);
my ($json_str, $error_msg) = JSON::DWIW->to_json($data);
my $json_str = JSON::DWIW->to_json($data, { use_exceptions => 1 });
Aliases: toJson, toJSON, objToJson
=cut
sub to_json {
my $proto = shift;
my $data;
my $self;
if (UNIVERSAL::isa($proto, 'JSON::DWIW')) {
$data = shift;
my $options = shift;
if ($options) {
if (ref($proto) and $proto->isa('HASH')) {
if (UNIVERSAL::isa($options, 'HASH')) {
$options = { %$proto, %$options };
}
}
$self = $proto->new($options, @_);
}
else {
$self = ref($proto) ? $proto : $proto->new(@_);
}
}
else {
$data = $proto;
$self = JSON::DWIW->new(@_);
}
my $error_msg;
my $error_data;
my $stats_data = { };
my $str = _xs_to_json($self, $data, \$error_msg, \$error_data, $stats_data);
if ($stats_data) {
$JSON::DWIW::Last_Stats = $stats_data;
$self->{last_stats} = $stats_data;
}
$JSON::DWIW::LastError = $error_msg;
$self->{last_error} = $error_msg;
$JSON::DWIW::LastErrorData = $error_data;
$self->{last_error_data} = $error_data;
if (defined($error_msg) and $self->{use_exceptions}) {
die $error_msg;
}
return wantarray ? ($str, $error_msg) : $str;
}
{
no warnings 'once';
*toJson = \&to_json;
*toJSON = \&to_json;
*objToJson = \&to_json;
}
sub serialize {
my $data = shift;
my $options = shift || { };
my $error_msg;
my $error_data;
my $stats_data = { };
my $str = _xs_to_json($options, $data, \$error_msg, \$error_data, $stats_data);
if ($stats_data) {
$JSON::DWIW::Last_Stats = $stats_data;
}
$JSON::DWIW::LastError = $error_msg;
$JSON::DWIW::LastErrorData = $error_data;
return $str;
}
=pod
=head2 deserialize($json_str, \%options)
Returns the Perl data structure for the given JSON string. The
value for true becomes 1, false becomes 0, and null gets
converted to undef.
This function should not be called as a method (for performance
reasons). Unlike from_json(), it returns a single value, the
data structure resulting from the conversion. If the return
value is undef, check the result of the get_error_string()
function/method to see if an error is defined.
=head2 deserialize_file($file, \%options)
Same as deserialize, except that it takes a file as an argument.
On Unix, this mmap's the file, so it does not load a big file
into memory all at once, and does less buffer copying.
=cut
=pod
=head2 from_json
Similar to deserialize(), but expects to be called as a method.
Called in list context, this method returns a list whose first
element is the data and the second element is the error message,
if any. If $error_msg is defined, there was a problem parsing
the JSON string, and $data will be undef. You may also pass a
second argument to from_json() that is a reference to a hash of
options -- see new().
my $data = from_json($json_str)
my ($data, $error_msg) = from_json($json_str)
Aliases: fromJson, fromJSON, jsonToObj
=cut
sub from_json {
my $proto = shift;
my $json;
my $self;
if (UNIVERSAL::isa($proto, 'JSON::DWIW')) {
$json = shift;
my $options = shift;
if ($options) {
if (ref($proto) and $proto->isa('HASH')) {
if (UNIVERSAL::isa($options, 'HASH')) {
$options = { %$proto, %$options };
}
}
$self = $proto->new($options, @_);
}
else {
$self = ref($proto) ? $proto : $proto->new(@_);
}
}
else {
$json = $proto;
$self = JSON::DWIW->new(@_);
}
my $data;
if (%$self) {
$data = JSON::DWIW::deserialize($json, $self);
}
else {
$data = JSON::DWIW::deserialize($json);
}
$self->{last_error} = $JSON::DWIW::LastError;
$self->{last_error_data} = $JSON::DWIW::LastErrorData;
$self->{last_stats} = $JSON::DWIW::Last_Stats;
if (defined($JSON::DWIW::LastError) and $self->{use_exceptions}) {
die $JSON::DWIW::LastError;
}
return wantarray ? ($data, $JSON::DWIW::LastError) : $data;
}
{
no warnings 'once';
*jsonToObj = \&from_json;
*fromJson = \&from_json;
*fromJSON = \&from_json;
}
=pod
=head2 from_json_file
Similar to deserialize_file(), except that it expects to be
called a a method, and it also returns the error, if any, when called
in list context.
my ($data, $error_msg) = $json->from_json_file($file, \%options)
=cut
sub from_json_file {
my $proto = shift;
my $file;
my $self;
if (UNIVERSAL::isa($proto, 'JSON::DWIW')) {
$file = shift;
my $options = shift;
if ($options) {
if (ref($proto) and $proto->isa('HASH')) {
if (UNIVERSAL::isa($options, 'HASH')) {
$options = { %$proto, %$options };
}
}
$self = $proto->new($options, @_);
}
else {
$self = ref($proto) ? $proto : $proto->new(@_);
}
}
else {
$file = $proto;
$self = JSON::DWIW->new(@_);
}
my $data;
if (%$self) {
$data = JSON::DWIW::deserialize_file($file, $self);
}
else {
$data = JSON::DWIW::deserialize_file($file);
}
$self->{last_error} = $JSON::DWIW::LastError;
$self->{last_error_data} = $JSON::DWIW::LastErrorData;
$self->{last_stats} = $JSON::DWIW::Last_Stats;
if (defined($JSON::DWIW::LastError) and $self->{use_exceptions}) {
die $JSON::DWIW::LastError;
}
return wantarray ? ($data, $JSON::DWIW::LastError) : $data;
}
=pod
=head2 to_json_file
Converts $data to JSON and writes the result to the file $file.
Currently, this is simply a convenience routine that converts
the data to a JSON string and then writes it to the file.
my ($ok, $error) = $json->to_json_file($data, $file, \%options);
=cut
sub to_json_file {
my $proto = shift;
my $file;
my $data;
my $self;
if (UNIVERSAL::isa($proto, 'JSON::DWIW')) {
$data = shift;
$file = shift;
my $options = shift;
if ($options) {
if (ref($proto) and $proto->isa('HASH')) {
if (UNIVERSAL::isa($options, 'HASH')) {
$options = { %$proto, %$options };
}
}
$self = $proto->new($options, @_);
}
else {
$self = ref($proto) ? $proto : $proto->new(@_);
}
}
else {
$data = $proto;
$file = shift;
$self = JSON::DWIW->new(@_);
}
my $out_fh;
unless (open($out_fh, '>', $file)) {
my $msg = "JSON::DWIW v$VERSION - couldn't open output file $file";
if ($self->{use_exceptions}) {
die $msg;
} else {
return wantarray ? ( undef, $msg ) : undef;
}
}
if ($] >= 5.008) {
binmode($out_fh, 'utf8');
}
my $error_msg;
my $error_data;
my $stats_data = { };
my $str = _xs_to_json($self, $data, \$error_msg, \$error_data, $stats_data);
if ($stats_data) {
$JSON::DWIW::Last_Stats = $stats_data;
$self->{last_stats} = $stats_data;
}
$JSON::DWIW::LastError = $error_msg;
$self->{last_error} = $error_msg;
$JSON::DWIW::LastErrorData = $error_data;
$self->{last_error_data} = $error_data;
if (defined($error_msg) and $self->{use_exceptions}) {
die $error_msg;
}
if ($error_msg) {
return wantarray ? (undef, $error_msg) : undef;
}
print $out_fh $str;
close $out_fh;
return wantarray ? (1, $error_msg) : 1;
}
sub parse_mmap_file {
my $proto = shift;
my $file = shift;
my $error_msg;
my $self = $proto->new;
my $data = _parse_mmap_file($self, $file, \$error_msg);
if ($error_msg) {
return wantarray ? (undef, $error_msg) : undef;
}
}
=pod
=head2 get_error_string
Returns the error message from the last call, if there was one, e.g.,
my $data = JSON::DWIW->from_json($json_str)
or die "JSON error: " . JSON::DWIW->get_error_string;
my $data = $json_obj->from_json($json_str)
or die "JSON error: " . $json_obj->get_error_string;
Aliases: get_err_str(), errstr()
=cut
sub get_error_string {
my $self = shift;
if (ref($self)) {
return $self->{last_error};
}
return $JSON::DWIW::LastError;
}
*get_err_str = \&get_error_string;
*errstr = \&get_error_string;
=pod
=head2 get_error_data
Returns the error details from the last call, in a hash ref, e.g.,
$error_data = {
'byte' => 23,
'byte_col' => 23,
'col' => 22,
'char' => 22,
'version' => '0.15a',
'line' => 1
};
This is really only useful when decoding JSON.
Aliases: get_error(), error()
=cut
sub get_error_data {
my $self = shift;
if (ref($self)) {
return $self->{last_error_data};
}
return $JSON::DWIW::LastErrorData;
}
*get_error = \&get_error_data;
*error = \&get_error_data;
=pod
=head2 get_stats
Returns statistics from the last method called to encode or
decode. E.g., for an encoding (to_json() or to_json_file()),
$stats = {
'bytes' => 78,
'nulls' => 1,
'max_string_bytes' => 5,
'max_depth' => 2,
'arrays' => 1,
'numbers' => 6,
'lines' => 1,
'max_string_chars' => 5,
'strings' => 6,
'bools' => 1,
'chars' => 78,
'hashes' => 1
};
=cut
sub get_stats {
my $self = shift;
if (ref($self)) {
return $self->{last_stats};
}
return $JSON::DWIW::Last_Stats;
}
*stats = \&get_stats;
=pod
=head2 true
Returns an object that will get output as a true value when encoding to JSON.
=cut
sub true {
return JSON::DWIW::Boolean->true;
}
=pod
=head2 false
Returns an object that will get output as a false value when encoding to JSON.
=cut
sub false {
return JSON::DWIW::Boolean->false;
}
=pod
=head1 Utilities
Following are some methods I use for debugging and testing.
=head2 flagged_as_utf8($str)
Returns true if the given string is flagged as utf-8.
=head2 flag_as_utf8($str)
Flags the given string as utf-8.
=head2 unflag_as_utf8($str)
Clears the flag that tells Perl the string is utf-8.
=head2 is_valid_utf8($str);
Returns true if the given string is valid utf-8 (regardless of the flag).
=head2 upgrade_to_utf8($str)
Converts the string to utf-8, assuming it is latin1. This effects $str itself in place, but also returns $str.
=head2 code_point_to_utf8_str($cp)
Returns a utf8 string containing the byte sequence for the given code point.
=head2 code_point_to_hex_bytes($cp)
Returns a string representing the byte sequence for $cp encoding in utf-8. E.g.,
my $hex_bytes = JSON::DWIW->code_point_to_hex_bytes(0xe9);
print "$hex_bytes\n"; # \xc3\xa9
=head2 bytes_to_code_points($str)
Returns a reference to an array of code points from the given string, assuming the string is encoded in utf-8.
=head2 peak_scalar($scalar)
Dumps the internal structure of the given scalar.
=head1 BENCHMARKS
Need new benchmarks here.
=head1 DEPENDENCIES
Perl 5.6 or later
=head1 BUGS/LIMITATIONS
If you find a bug, please file a tracker request at
.
When decoding a JSON string, it is a assumed to be utf-8 encoded.
The module should detect whether the input is utf-8, utf-16, or
utf-32.
=head1 AUTHOR
Don Owens
=head1 ACKNOWLEDGEMENTS
Thanks to Asher Blum for help with testing.
Thanks to Nigel Bowden for helping with compilation on Windows.
Thanks to Robert Peters for discovering and tracking down the source of a number parsing bug.
Thanks to Mark Phillips for helping with a bug under Solaris on Sparc.
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it
under the same terms as Perl itself. See perlartistic.
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
=head1 SEE ALSO
The JSON home page: L
The JSON spec: L
The JSON-RPC spec: L
L
L (included in L)
=head1 VERSION
0.32
=cut
1;
# Local Variables: #
# mode: perl #
# tab-width: 4 #
# indent-tabs-mode: nil #
# cperl-indent-level: 4 #
# perl-indent-level: 4 #
# End: #
# vim:set ai si et sta ts=4 sw=4 sts=4:
JSON-DWIW-0.33/INSTALL 0000644 0000764 0000764 00000000246 11173264050 012144 0 ustar don don Copyright (c) 2007 Don Owens
See the COPYRIGHT section in DWIW.pm for usage and distribution
rights.
INSTALLATION
perl Makefile.PL
make
make test
make install
JSON-DWIW-0.33/README 0000644 0000764 0000764 00000031130 11216640546 011775 0 ustar don don NAME
JSON::DWIW - JSON converter that Does What I Want
SYNOPSIS
use JSON::DWIW;
my $json_obj = JSON::DWIW->new;
my $data = $json_obj->from_json($json_str);
my $str = $json_obj->to_json($data);
my ($data, $error_string) = $json_obj->from_json($json_str);
my $data = JSON::DWIW::deserialize($json_str);
my $error_str = JSON::DWIW::get_error_string;
use JSON::DWIW qw/deserialize_json from_json/
my $data = deserialize_json($json_str);
my $error_str = JSON::DWIW::get_error_string;
my $error_string = $json_obj->get_error_string;
my $error_data = $json_obj->get_error_data;
my $stats = $json_obj->get_stats;
my $data = $json_obj->from_json_file($file)
my $ok = $json_obj->to_json_file($data, $file);
my $data = JSON::DWIW->from_json($json_str);
my $str = JSON:DWIW->to_json($data);
my $data = JSON::DWIW->from_json($json_str, \%options);
my $str = JSON::DWIW->to_json($data, \%options);
my $true_value = JSON::DWIW->true;
my $false_value = JSON::DWIW->false;
my $data = { var1 => "stuff", var2 => $true_value,
var3 => $false_value, };
my $str = JSON::DWIW->to_json($data);
DESCRIPTION
Other JSON modules require setting several parameters before calling the
conversion methods to do what I want. This module does things by default
that I think should be done when working with JSON in Perl. This module
also encodes and decodes faster than JSON.pm and JSON::Syck in my
benchmarks.
This means that any piece of data in Perl (assuming it's valid unicode)
will get converted to something in JSON instead of throwing an
exception. It also means that output will be strict JSON, while accepted
input will be flexible, without having to set any options.
Encoding
Perl objects get encoded as their underlying data structure, with the
exception of Math::BigInt and Math::BigFloat, which will be output as
numbers, and JSON::DWIW::Boolean, which will get output as a true or
false value (see the true() and false() methods). For example, a blessed
hash ref will be represented as an object in JSON, a blessed array will
be represented as an array. etc. A reference to a scalar is dereferenced
and represented as the scalar itself. Globs, Code refs, etc., get
stringified, and undef becomes null.
Scalars that have been used as both a string and a number will be output
as a string. A reference to a reference is currently output as an empty
string, but this may change.
You may notice there is a deserialize function, but not a serialize one.
The deserialize function was written as a full rewrite (the parsing is
in a separate, event-based library now) of from_json (now from_json
calls deserialize). In the future, there will be a serialize function
that is a rewrite of to_json.
Decoding
Input is expected to utf-8. When decoding, null, true, and false become
undef, 1, and 0, repectively. Numbers that appear to be too long to be
supported natively are converted to Math::BigInt or Math::BigFloat
objects, if you have them installed. Otherwise, long numbers are turned
into strings to prevent data loss.
The parser is flexible in what it accepts and handles some things not in
the JSON spec:
quotes
Both single and double quotes are allowed for quoting a string,
e.g.,
[ "string1", 'string2' ]
bare keys
Object/hash keys can be bare if they look like an identifier, e.g.,
{ var1: "myval1", var2: "myval2" }
extra commas
Extra commas in objects/hashes and arrays are ignored, e.g.,
[1,2,3,,,4,]
becomes a 4 element array containing 1, 2, 3, and 4.
escape sequences
Latin1 hexadecimal escape sequences (\xHH) are accepted, as in
Javascript. Also, the vertical tab escape \v is recognized (\u000b).
comments
C, C++, and shell-style comments are accepted. That is
/* this is a comment */
// this is a comment
# this is also a comment
METHODS
new(\%options)
Create a new JSON::DWIW object.
%options is an optional hash of parameters that will change the bahavior
of this module when encoding to JSON. You may also pass these options as
the second argument to to_json() and from_json(). The following options
are supported:
bare_keys
If set to a true value, keys in hashes will not be quoted when
converted to JSON if they look like identifiers. This is valid
Javascript in current browsers, but not in JSON.
use_exceptions
If set to a true value, errors found when converting to or from JSON
will result in die() being called with the error message. The default is
to not use exceptions.
bad_char_policy
This options indicates what should be done if bad characters are found,
e.g., bad utf-8 sequence. The default is to return an error and drop all
the output.
The following values for bad_char_policy are supported:
error
default action, i.e., drop any output built up and return an error
convert
Convert to a utf-8 char using the value of the byte as a code point.
This is basically the same as assuming the bad character is in latin-1
and converting it to utf-8.
pass_through
Ignore the error and pass through the raw bytes (invalid JSON)
escape_multi_byte
If set to a true value, escape all multi-byte characters (e.g., \u00e9)
when converting to JSON.
pretty
Add white space to the output when calling to_json() to make the output
easier for humans to read.
convert_bool
When converting from JSON, return objects for booleans so that "true"
and "false" can be maintained when encoding and decoding. If this flag
is set, then "true" becomes a JSON::DWIW::Boolean object that evaluates
to true in a boolean context, and "false" becomes an object that
evaluates to false in a boolean context. These objects are recognized by
the to_json() method, so they will be output as "true" or "false"
instead of "1" or "0".
to_json
Returns the JSON representation of $data (arbitrary datastructure). See
http://www.json.org/ for details.
Called in list context, this method returns a list whose first element
is the encoded JSON string and the second element is an error message,
if any. If $error_msg is defined, there was a problem converting to
JSON. You may also pass a second argument to to_json() that is a
reference to a hash of options -- see new().
my $json_str = JSON::DWIW->to_json($data);
my ($json_str, $error_msg) = JSON::DWIW->to_json($data);
my $json_str = JSON::DWIW->to_json($data, { use_exceptions => 1 });
Aliases: toJson, toJSON, objToJson
deserialize($json_str, \%options)
Returns the Perl data structure for the given JSON string. The value for
true becomes 1, false becomes 0, and null gets converted to undef.
This function should not be called as a method (for performance
reasons). Unlike from_json(), it returns a single value, the data
structure resulting from the conversion. If the return value is undef,
check the result of the get_error_string() function/method to see if an
error is defined.
deserialize_file($file, \%options)
Same as deserialize, except that it takes a file as an argument. On
Unix, this mmap's the file, so it does not load a big file into memory
all at once, and does less buffer copying.
from_json
Similar to deserialize(), but expects to be called as a method.
Called in list context, this method returns a list whose first element
is the data and the second element is the error message, if any. If
$error_msg is defined, there was a problem parsing the JSON string, and
$data will be undef. You may also pass a second argument to from_json()
that is a reference to a hash of options -- see new().
my $data = from_json($json_str)
my ($data, $error_msg) = from_json($json_str)
Aliases: fromJson, fromJSON, jsonToObj
from_json_file
Similar to deserialize_file(), except that it expects to be called a a
method, and it also returns the error, if any, when called in list
context.
my ($data, $error_msg) = $json->from_json_file($file, \%options)
to_json_file
Converts $data to JSON and writes the result to the file $file.
Currently, this is simply a convenience routine that converts the data
to a JSON string and then writes it to the file.
my ($ok, $error) = $json->to_json_file($data, $file, \%options);
get_error_string
Returns the error message from the last call, if there was one, e.g.,
my $data = JSON::DWIW->from_json($json_str)
or die "JSON error: " . JSON::DWIW->get_error_string;
my $data = $json_obj->from_json($json_str)
or die "JSON error: " . $json_obj->get_error_string;
Aliases: get_err_str(), errstr()
get_error_data
Returns the error details from the last call, in a hash ref, e.g.,
$error_data = {
'byte' => 23,
'byte_col' => 23,
'col' => 22,
'char' => 22,
'version' => '0.15a',
'line' => 1
};
This is really only useful when decoding JSON.
Aliases: get_error(), error()
get_stats
Returns statistics from the last method called to encode or decode.
E.g., for an encoding (to_json() or to_json_file()),
$stats = {
'bytes' => 78,
'nulls' => 1,
'max_string_bytes' => 5,
'max_depth' => 2,
'arrays' => 1,
'numbers' => 6,
'lines' => 1,
'max_string_chars' => 5,
'strings' => 6,
'bools' => 1,
'chars' => 78,
'hashes' => 1
};
true
Returns an object that will get output as a true value when encoding to
JSON.
false
Returns an object that will get output as a false value when encoding to
JSON.
Utilities
Following are some methods I use for debugging and testing.
flagged_as_utf8($str)
Returns true if the given string is flagged as utf-8.
flag_as_utf8($str)
Flags the given string as utf-8.
unflag_as_utf8($str)
Clears the flag that tells Perl the string is utf-8.
is_valid_utf8($str);
Returns true if the given string is valid utf-8 (regardless of the
flag).
upgrade_to_utf8($str)
Converts the string to utf-8, assuming it is latin1. This effects $str
itself in place, but also returns $str.
code_point_to_utf8_str($cp)
Returns a utf8 string containing the byte sequence for the given code
point.
code_point_to_hex_bytes($cp)
Returns a string representing the byte sequence for $cp encoding in
utf-8. E.g.,
my $hex_bytes = JSON::DWIW->code_point_to_hex_bytes(0xe9);
print "$hex_bytes\n"; # \xc3\xa9
bytes_to_code_points($str)
Returns a reference to an array of code points from the given string,
assuming the string is encoded in utf-8.
peak_scalar($scalar)
Dumps the internal structure of the given scalar.
BENCHMARKS
Need new benchmarks here.
DEPENDENCIES
Perl 5.6 or later
BUGS/LIMITATIONS
If you find a bug, please file a tracker request at
.
When decoding a JSON string, it is a assumed to be utf-8 encoded. The
module should detect whether the input is utf-8, utf-16, or utf-32.
AUTHOR
Don Owens
ACKNOWLEDGEMENTS
Thanks to Asher Blum for help with testing.
Thanks to Nigel Bowden for helping with compilation on Windows.
Thanks to Robert Peters for discovering and tracking down the source of
a number parsing bug.
Thanks to Mark Phillips for helping with a bug under Solaris on Sparc.
LICENSE AND COPYRIGHT
Copyright (c) 2007-2009 Don Owens . All rights
reserved.
This is free software; you can redistribute it and/or modify it under
the same terms as Perl itself. See perlartistic.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
SEE ALSO
The JSON home page: L
The JSON spec: L
The JSON-RPC spec: L
L
L (included in L)
VERSION
0.32
JSON-DWIW-0.33/WhatsNew 0000644 0000764 0000764 00000012303 11216640445 012577 0 ustar don don Version 0.33
* Fixed memory leak -- the stack was getting allocated in
init_cbs(), but never deallocated.
Version 0.32
* Fixed segfault on Solaris 10 (on Sparc) when compiled with Sun
Studio. It was a 64-bit versus 32-bit bug on my part, but
apparently GCC catches this and does the right thing.
Version 0.30
* Added _GNU_SOURCE define to pull in asprintf on some platforms
Version 0.29
* Fixed another segfault problem on 64-bit Linux (in vset_error).
Version 0.28
* Fixed segfault problem on 64-bit Linux (rt.cpan.org #40879)
* Fixed test problem on Solaris (rt.cpan.org #41129)
Version 0.27
* Documented the is_valid_utf8() method
* Added the upgrade_to_utf8() method
* Added shell-style comment support to the from_json() method
* Documented comment support
Version 0.26
* Fixed number parsing bug (rt.cpan.org #37541)
* Documented utility functions
Version 0.25
* Fixed mmap failure on Linux
* Fixed (hopefully) another compilation problem on Solaris (rt.cpan.org #35040)
Version 0.24 Tue 2008-04-14
* Fixed compilation problem on Solaris (rt.cpan.org #35040)
* Some code cleanup
* Implemented utf-8 encoding/decoding from scratch when used by
deserialize(). Previously used Perl's implementation.
* Implemented utf-16 and utf-32 encoding and decoding, although it
is not used yet.
Version 0.23
* Fixed illegal memory access and warnings from glibc (rt.cpan.org #33121)
* Now accept \xHH escape as in Javascript (rt.cpan.org #34285)
* Accept $ in bare keys (rt.cpan.org #34320). This should probably be
expanded to take identifiers as defined in the ECMAScript spec
* Added vertical tab (\v) to the list of recognized escape
sequences when parsing -- this is in the ECMAScript spec
Version 0.21
* Fix compile problem where I left a custom OPTIMIZE entry in
Makefile.PL when testing
Version 0.20
* Added deserialize() function and documented it
* Added deserialize_file() function, but left it undocumented and
skip its tests
Version 0.19
* Added fix for compiling on hpux
Version 0.18
* Fixed compilation problem on Windows by removing calls to bzero()
Version 0.17
* Fixed bug where unnecessary header files were being included,
breaking the build on Windows
Version 0.16
* Added get_stats() method
* Added get_error_string() method
* Added get_error_data() method
Version 0.15
* Added from_json_file() method
* Added to_json_file() method
* Fixed bug where, in Perl version >= 5.8, hash keys with
multibyte utf-8 chars were not handled correctly
* Changed error messages to include the module name and version,
fixed error messages that did not specify where the error
occurred, and added line number, character offset, and character
column to parse error messages.
Version 0.14
* Fixed problem with escaping '\' when decoding
* Made some optimizations
* Now recognize more whitespace characters
The full list of whitespace characters recognized is:
case 0x20: /* space */
case 0x09: /* tab */
case 0x0b: /* vertical tab */
case 0x0c: /* form feed */
case 0x0d: /* carriage return */
case 0x00a0: /* NSBP - non-breaking space */
case 0x200b: /* ZWSP - zero width space */
case 0x2029: /* PS - paragraph separator */
case 0x2060: /* WJ - word joiner */
case 0x0a: /* newline */
case 0x0085: /* NEL - next line */
case 0x2028: /* LS - line separator */
Version 0.13
* Fixed problem where array elements may be missing when the
"pretty" option is turned on
Version 0.12
* Fixed assertion failure in perl 5.8.5 when finding a tied scalar
in a hash value
Version 0.11
* Changed the way null gets converted to undef when converting
from JSON. Instead of returning &PL_sv_undef, it now gets
returned as a new, unitialized SV. This keeps Data::Dumper from
outputing undef as an alias to another undef value in the data
structure.
Version 0.10
* Add methods true() and false() to return objects that will get
encoded as true and false, respectively, when converting to
JSON.
Version 0.09
* Fixed the bad_char_policy option -- it was being ignored
Version 0.08
* Fixed problem encoding scalars that have been used as both
strings and numbers (types SVt_PVN, SVt_PVIV)
Version 0.07
* Fixed more problems with Math::BigInt and Math::BigFloat objects
Version 0.06
* Fixed problems with tests using Math::BigInt and Math::BigFloat objects
Version 0.05
* Bad utf-8 sequences now cause an error unless you pass an option
indicating otherwise
* Added options for how to react to bad utf8 data
* Added option to throw an exception on error
* Added option to pretty-print output
* Fixed some compilation problems on Windows
Version 0.04
* Fixed bug where empty strings got encoded incorrectly
Version 0.03
* Fixed bug where parsing an empty array would sometimes cause an error
Version 0.02
* Speed optimizations
* Fixed a memory leak
* Added support for spurious commas in hashes and arrays
JSON-DWIW-0.33/Makefile.PL 0000755 0000764 0000764 00000011726 11216636261 013102 0 ustar don don #!/usr/bin/env perl
# Creation date: 2007-02-19 16:49:01
# Authors: don
use strict;
use 5.006_00;
use ExtUtils::MakeMaker;
use File::Spec;
my $src_dir = 'libjsonevt';
my $on_windows;
# for stuff to skip/change on Windows
if ($^O =~ /MSWin/) {
$on_windows = 1;
# $use_jsonevt = 0;
}
my @utf_files = qw/utf8 utf16 utf32/;
my @utf_headers = map { "$_.h" } @utf_files;
# my $obj_str = join(' ', map { "$_\$(OBJ_EXT)" } @utf_files, 'evt', 'jsonevt', 'json_writer',
# 'print', 'old_parse', 'old_common');
my $obj_str = join(' ', map { "$_\$(OBJ_EXT)" } @utf_files, 'evt', 'jsonevt', 'json_writer',
'print', 'old_common');
sub MY::postamble {
my ($self) = @_;
my $stuff = '';
my $exec_output_name = sub { my ($name) = @_;
if ($on_windows and $self->{CC}
and $self->{CC} =~ /\Acl(?:\.exe)?\Z/) {
return "/Fe$name";
}
else {
return "-o $name";
}
};
my $cc = '$(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) ';
my $cc_main = '$(CC) $(PASTHRU_INC) $(INC) $(CCFLAGS) $(OPTIMIZE) $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ';
my $config_h = File::Spec->catfile($src_dir, 'jsonevt_config.h');
$stuff .= "\$(INST_DYNAMIC): $obj_str $config_h\n\n";
$stuff .= "evt\$(OBJ_EXT): evt.c\n\n";
# $stuff .= "old_parse\$(OBJ_EXT): old_parse.c old_parse.h old_common.h\n\n";
$stuff .= "old_common\$(OBJ_EXT): old_common.c old_common.h\n\n";
# $stuff .= "DWIW\$(OBJ_EXT): DWIW.h old_parse.h old_common.h $config_h\n\n";
$stuff .= "DWIW\$(OBJ_EXT): DWIW.h old_common.h $config_h\n\n";
my $make_conf = File::Spec->catfile($src_dir, 'make_config');
my $exec_make_conf = File::Spec->rel2abs($make_conf);
$exec_make_conf .= " $config_h ./check_config " . $cc_main . ' ' . $exec_output_name->('check_config');
my $add_evt_obj = sub {
my ($name, @extra_headers) = @_;
my $rv = '';
$rv .= "$name\$(OBJ_EXT): ";
$rv .= join(' ', map { File::Spec->catfile($src_dir, $_) }
('jsonevt.h', 'jsonevt_private.h', @utf_headers, 'uni.h',
"$name.c", @extra_headers));
$rv .= "\n";
$rv .= "\t$cc " . File::Spec->catfile($src_dir, "$name.c") . "\n";
$rv .= "\n";
return $rv;
};
$stuff .= "$obj_str: $config_h\n\n";
$stuff .= "$config_h: $make_conf\n\t$exec_make_conf\n\n";
$stuff .= "$make_conf: $make_conf.c\n\t$cc_main " . $exec_output_name->($make_conf)
. " $make_conf.c\n\n";
$stuff .= $add_evt_obj->('jsonevt');
$stuff .= $add_evt_obj->('json_writer');
$stuff .= $add_evt_obj->('print', 'print.h');
foreach my $file (@utf_files) {
$stuff .= "$file\$(OBJ_EXT): ";
$stuff .= join(' ', map { File::Spec->catfile($src_dir, $_) }
("$file.c", "$file.h", 'uni.h'));
$stuff .= "\n";
$stuff .= "\t" . '$(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) ';
$stuff .= File::Spec->catfile($src_dir, "$file.c") . "\n";
$stuff .= "\n";
}
return $stuff;
}
sub MY::post_constants {
my ($self) = @_;
my @updates;
my $optimize = $self->{OPTIMIZE};
$optimize = '' unless $optimize;
if ($ENV{DEVEL_JSON_DWIW}) {
$optimize .= ' -Wall' unless $optimize =~ /-Wall/;
$optimize .= ' -Werror' unless $optimize =~ /-Werror/;
}
if ($ENV{DEBUG_JSON_DWIW}) {
$optimize .= ' -DDO_DEBUG';
$optimize .= ' -g' unless $optimize =~ /-g/;
}
push @updates, "OPTIMIZE = $optimize";
return join("\n", @updates);
}
my $clean_str = join(' ', map { File::Spec->catfile('libjsonevt', $_) }
('*.a', '*.so', '*$(OBJ_EXT)', 'jsonevt_config.h', 'make_config'));
my $args = {
NAME => 'JSON::DWIW',
DISTNAME => 'JSON-DWIW',
VERSION_FROM => 'lib/JSON/DWIW.pm',
ABSTRACT => 'JSON converter that does what I want',
AUTHOR => 'DON OWENS ',
PM => { 'lib/JSON/DWIW.pm' => '$(INST_LIBDIR)/DWIW.pm',
'lib/JSON/DWIW/Boolean.pm' => '$(INST_LIBDIR)/DWIW/Boolean.pm',
},
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz' },
DIR => [],
EXE_FILES => [],
PREREQ_PM => {
},
clean => { FILES => $clean_str },
# OPTIMIZE => '-Wall -O3 -fno-non-lvalue-assign -g',
# OPTIMIZE => '-O2 -g -Wall',
# OPTIMIZE => '-Wall -O3 -Werror',
};
$args->{DEFINE} = "-DHAVE_JSONEVT -DNO_VERSION_IN_ERROR";
$args->{LDFROM} = "\$(OBJECT) $obj_str";
$args->{INC} = "-I$src_dir";
WriteMakefile(%$args);
JSON-DWIW-0.33/old_common.h 0000644 0000764 0000764 00000004745 11175362561 013432 0 ustar don don /* Creation date: 2008-04-06T19:58:22Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
*/
#ifndef OLD_COMMON_H
#define OLD_COMMON_H
#include "DWIW.h"
#include "libjsonevt/int_defs.h"
#include "libjsonevt/utf8.h"
#define kCommasAreWhitespace 1
/* a single set of flags for json_context and self_context */
#define kUseExceptions 1
#define kDumpVars (1 << 1)
#define kPrettyPrint (1 << 2)
#define kEscapeMultiByte (1 << 3)
#define kConvertBool (1 << 4)
#define kBadCharError 0
#define kBadCharConvert 1
#define kBadCharPassThrough 2
/* for converting to JSON */
typedef struct {
SV * error;
SV * error_data;
int bare_keys;
UV bad_char_policy;
int use_exceptions;
int flags;
unsigned int string_count;
unsigned int longest_string_bytes;
unsigned int longest_string_chars;
unsigned int number_count;
unsigned int bool_count;
unsigned int null_count;
unsigned int hash_count;
unsigned int array_count;
unsigned int deepest_level;
HV * ref_track;
} self_context;
#define kHaveModuleNotChecked 0
#define kHaveModule 1
#define kHaveModuleDontHave 2
UV get_bad_char_policy(HV * self_hash);
int have_bigint();
int have_bigfloat();
uint32_t common_utf8_bytes_to_unicode(const uint8_t *orig_buf, uint32_t buf_len, uint32_t *ret_len);
uint32_t common_utf8_unicode_to_bytes(uint32_t code_point, uint8_t *out_buf);
/*
#define convert_uv_to_utf8(buf, uv) common_utf8_unicode_to_bytes((uint32_t)(uv), (uint8_t *)(buf));
*/
#ifdef IS_PERL_5_6
#define convert_utf8_to_uv(utf8, len_ptr) utf8_to_uv_simple(utf8, len_ptr)
#else
#define convert_utf8_to_uv(utf8, len_ptr) utf8_to_uvuni(utf8, len_ptr)
#endif
#ifdef IS_PERL_5_6
#define convert_uv_to_utf8(buf, uv) uv_to_utf8(buf, uv)
#else
#define convert_uv_to_utf8(buf, uv) uvuni_to_utf8(buf, uv)
#endif
#define UPDATE_CUR_LEVEL(ctx, cur_level) (cur_level > ctx->deepest_level ? (ctx->deepest_level = cur_level) : cur_level )
#define PSTRL(val) ( (UV)val )
#define STRLuf UVuf
#endif /* OLD_COMMON_H */
JSON-DWIW-0.33/META.yml 0000664 0000764 0000764 00000000623 11216640546 012373 0 ustar don don --- #YAML:1.0
name: JSON-DWIW
version: 0.33
abstract: JSON converter that does what I want
license: ~
author:
- DON OWENS
generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
JSON-DWIW-0.33/DWIW.h 0000644 0000764 0000764 00000004465 11173264050 012045 0 ustar don don /* Creation date: 2008-04-06T20:25:24Z
* Authors: Don
*/
/*
Copyright (c) 2007-2009 Don Owens . All rights reserved.
This is free software; you can redistribute it and/or modify it under
the Perl Artistic license. You should have received a copy of the
Artistic license with this distribution, in the file named
"Artistic". You may also obtain a copy from
http://regexguy.com/license/Artistic
This program is distributed in the hope that it will be
useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
PURPOSE.
*/
/* $Header: /repository/owens_lib/cpan/JSON/DWIW/DWIW.h,v 1.3 2009-04-11 02:18:37 don Exp $ */
#ifndef DWIW_H
#define DWIW_H
#ifdef __cplusplus
extern "C" {
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef __cplusplus
}
#endif
#if PERL_VERSION >= 8
#define IS_PERL_5_8
#else
#if PERL_VERSION <= 5
#error "This module requires at least Perl 5.6"
#else
#define IS_PERL_5_6
#endif
#endif
#define DEBUG_UTF8 0
#define JSON_DO_DEBUG 0
#define JSON_DO_TRACE 0
#define JSON_DUMP_OPTIONS 0
#define JSON_DO_EXTENDED_ERRORS 0
#include
#define MAYBE_USE_MMAP 0
#if MAYBE_USE_MMAP
#ifdef HAS_MMAP
#define USE_MMAP 1
#else
#define USE_MMAP 0
#endif
#else
#define USE_MMAP 0
#endif
#if USE_MMAP
#include
#include
#include
#endif
#ifdef HAVE_JSONEVT
#include "evt.h"
#endif
#define debug_level 9
#ifndef PERL_MAGIC_tied
#define PERL_MAGIC_tied 'P' /* Tied array or hash */
#endif
#define MOD_NAME "JSON::DWIW"
#define MOD_VERSION VERSION
#ifdef JSONEVT_HAVE_FULL_VARIADIC_MACROS
#if JSON_DO_DEBUG
#define JSON_DEBUG(...) printf("%s (%d) - ", __FILE__, __LINE__); printf(__VA_ARGS__); printf("\n"); fflush(stdout)
#else
#define JSON_DEBUG(...)
#endif
#if JSON_DO_TRACE
#define JSON_TRACE(...) printf("%s (%d) - ", __FILE__, __LINE__); printf(__VA_ARGS__); printf("\n"); fflush(stdout)
#else
#define JSON_TRACE(...)
#endif
#else
void JSON_DEBUG(char *fmt, ...);
void JSON_TRACE(char *fmt, ...);
#endif /* JSONEVT_HAVE_FULL_VARIADIC_MACROS */
#ifndef UTF8_IS_INVARIANT
#define UTF8_IS_INVARIANT(c) (((UV)c) < 0x80)
#endif
#define UNLESS(stuff) if (! (stuff))
#define MEM_EQ(buf1, buf2, len) ( memcmp((void *)buf1, (void *)buf2, len) == 0 )
#endif /* DWIW_H */
JSON-DWIW-0.33/Artistic 0000644 0000764 0000764 00000013737 11173264050 012631 0 ustar don don
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End