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   701 use strict;
  1         2  
  1         28  
8 1     1   5 use warnings;
  1         43  
  1         37  
9              
10 1     1   7 use base qw(Metabrik);
  1         1  
  1         530  
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             require_modules => {
24             'JSON::XS' => [ ],
25             },
26             };
27             }
28              
29             sub encode {
30 0     0 0   my $self = shift;
31 0           my ($data) = @_;
32              
33 0 0         $self->brik_help_run_undef_arg('encode', $data) or return;
34 0 0         $self->brik_help_run_invalid_arg('encode', $data, 'ARRAY', 'HASH')
35             or return;
36              
37 0           $self->log->debug("encode: data[$data]");
38              
39 0           my $encoded = '';
40 0           eval {
41 0           my $j = JSON::XS->new;
42 0           $j->relaxed(1);
43 0           $j->utf8(1);
44 0           $encoded = $j->encode($data);
45             };
46 0 0         if ($@) {
47 0           chomp($@);
48 0           return $self->log->error("encode: unable to encode JSON: $@");
49             }
50              
51 0           return $encoded;
52             }
53              
54             sub decode {
55 0     0 0   my $self = shift;
56 0           my ($data) = @_;
57              
58 0 0         $self->brik_help_run_undef_arg('decode', $data) or return;
59              
60 0           $self->log->debug("decode: data[$data]");
61              
62 0           my $decoded = '';
63 0           eval {
64 0           my $j = JSON::XS->new;
65 0           $j->relaxed(1);
66 0           $j->utf8(1);
67 0           $decoded = $j->decode($data);
68             };
69 0 0         if ($@) {
70 0           chomp($@);
71 0           return $self->log->error("decode: unable to decode JSON: $@");
72             }
73              
74 0           return $decoded;
75             }
76              
77             sub is_valid {
78 0     0 0   my $self = shift;
79 0           my ($data) = @_;
80              
81 0 0         $self->brik_help_run_undef_arg('is_valid', $data) or return;
82              
83 0           $self->log->debug("is_valid: data[$data]");
84              
85 0           eval {
86 0           $self->decode($data);
87             };
88 0 0         if ($@) {
89 0           return 0;
90             }
91              
92 0           return 1;
93             }
94              
95             1;
96              
97             __END__