File Coverage

blib/lib/Metabrik/String/Json.pm
Criterion Covered Total %
statement 9 48 18.7
branch 0 14 0.0
condition n/a
subroutine 3 7 42.8
pod 1 4 25.0
total 13 73 17.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # string::json Brik
5             #
6             package Metabrik::String::Json;
7 1     1   852 use strict;
  1         3  
  1         29  
8 1     1   5 use warnings;
  1         2  
  1         26  
9              
10 1     1   5 use base qw(Metabrik);
  1         2  
  1         559  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable encode decode) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             commands => {
19             encode => [ qw($data_list|$data_hash) ],
20             decode => [ qw($data) ],
21             is_valid => [ qw($data) ],
22             },
23             attributes => {
24             use_utf8 => [ qw(0|1) ],
25             },
26             attributes_default => {
27             use_utf8 => 1,
28             },
29             require_modules => {
30             'JSON::XS' => [ ],
31             },
32             };
33             }
34              
35             sub encode {
36 0     0 0   my $self = shift;
37 0           my ($data) = @_;
38              
39 0 0         $self->brik_help_run_undef_arg('encode', $data) or return;
40 0 0         $self->brik_help_run_invalid_arg('encode', $data, 'ARRAY', 'HASH')
41             or return;
42              
43 0           $self->log->debug("encode: data[$data]");
44              
45 0           my $encoded = '';
46 0           eval {
47 0           my $j = JSON::XS->new;
48 0           $j->relaxed(1);
49 0           $j->utf8($self->use_utf8);
50 0           $encoded = $j->encode($data);
51             };
52 0 0         if ($@) {
53 0           chomp($@);
54 0           return $self->log->error("encode: unable to encode JSON: $@");
55             }
56              
57 0           return $encoded;
58             }
59              
60             sub decode {
61 0     0 0   my $self = shift;
62 0           my ($data) = @_;
63              
64 0 0         $self->brik_help_run_undef_arg('decode', $data) or return;
65              
66 0           $self->log->debug("decode: data[$data]");
67              
68 0           my $decoded = '';
69 0           eval {
70 0           my $j = JSON::XS->new;
71 0           $j->relaxed(1);
72 0           $j->utf8($self->use_utf8);
73 0           $decoded = $j->decode($data);
74             };
75 0 0         if ($@) {
76 0           chomp($@);
77 0           return $self->log->error("decode: unable to decode JSON: $@, data[$data]");
78             }
79              
80 0           return $decoded;
81             }
82              
83             sub is_valid {
84 0     0 0   my $self = shift;
85 0           my ($data) = @_;
86              
87 0 0         $self->brik_help_run_undef_arg('is_valid', $data) or return;
88              
89 0           $self->log->debug("is_valid: data[$data]");
90              
91 0           eval {
92 0           $self->decode($data);
93             };
94 0 0         if ($@) {
95 0           return 0;
96             }
97              
98 0           return 1;
99             }
100              
101             1;
102              
103             __END__