File Coverage

blib/lib/Metabrik/File/Json.pm
Criterion Covered Total %
statement 9 51 17.6
branch 0 26 0.0
condition 0 14 0.0
subroutine 3 10 30.0
pod 3 7 42.8
total 15 108 13.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # file::json Brik
5             #
6             package Metabrik::File::Json;
7 1     1   717 use strict;
  1         2  
  1         27  
8 1     1   5 use warnings;
  1         2  
  1         27  
9              
10 1     1   5 use base qw(Metabrik::File::Text);
  1         2  
  1         491  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             input => [ qw(file) ],
20             output => [ qw(file) ],
21             encoding => [ qw(utf8|ascii) ],
22             overwrite => [ qw(0|1) ],
23             _sj => [ qw(INTERNAL) ],
24             },
25             attributes_default => {
26             overwrite => 1,
27             },
28             commands => {
29             read => [ qw(input_file|OPTIONAL) ],
30             read_next => [ qw(input_file|OPTIONAL) ],
31             write => [ qw($json_hash output_file|OPTIONAL) ],
32             is_valid => [ qw(input_file|OPTIONAL) ],
33             },
34             require_modules => {
35             'Metabrik::File::Write' => [ ],
36             'Metabrik::String::Json' => [ ],
37             },
38             };
39             }
40              
41             sub brik_use_properties {
42 0     0 1   my $self = shift;
43              
44             return {
45 0   0       attributes_default => {
46             encoding => defined($self->global) && $self->global->encoding || 'utf8',
47             },
48             };
49             }
50              
51             sub brik_init {
52 0     0 1   my $self = shift;
53              
54 0 0         my $sj = Metabrik::String::Json->new_from_brik_init($self) or return;
55 0           $self->_sj($sj);
56              
57 0           return $self->SUPER::brik_init;
58             }
59              
60             sub read {
61 0     0 0   my $self = shift;
62 0           my ($input) = @_;
63              
64 0   0       $input ||= $self->input;
65 0 0         $self->brik_help_run_undef_arg('read', $input) or return;
66              
67 0           my $sj = $self->_sj;
68              
69 0 0         my $data = $self->SUPER::read($input) or return;
70              
71 0           return $sj->decode($data);
72             }
73              
74             sub read_next {
75 0     0 0   my $self = shift;
76 0           my ($input) = @_;
77              
78 0   0       $input ||= $self->input;
79 0 0         $self->brik_help_run_undef_arg('read_next', $input) or return;
80              
81 0           my $sj = $self->_sj;
82              
83 0 0         my $data = $self->SUPER::read_line($input) or return;
84              
85 0           return $sj->decode($data);
86             }
87              
88             sub write {
89 0     0 0   my $self = shift;
90 0           my ($json_hash, $output) = @_;
91              
92 0   0       $output ||= $self->output;
93 0 0         $self->brik_help_run_undef_arg('write', $json_hash) or return;
94 0 0         $self->brik_help_run_invalid_arg('write', $json_hash, 'ARRAY', 'HASH')
95             or return;
96 0 0         $self->brik_help_run_undef_arg('write', $output) or return;
97              
98 0           my $sj = $self->_sj;
99              
100             # Always make it an ARRAY
101 0 0         $json_hash = ref($json_hash) eq 'ARRAY' ? $json_hash : [ $json_hash ];
102              
103 0           my @data = ();
104 0           for my $this (@$json_hash) {
105 0 0         my $data = $sj->encode($this) or next;
106 0           push @data, $data;
107             }
108              
109 0 0         $self->SUPER::write(\@data, $output) or return;
110              
111 0           return $output;
112             }
113              
114             sub is_valid {
115 0     0 0   my $self = shift;
116 0           my ($input) = @_;
117              
118 0   0       $input ||= $self->input;
119 0 0         $self->brik_help_run_undef_arg('is_valid', $input) or return;
120              
121 0 0         my $data = $self->SUPER::read($input) or return;
122              
123 0           my $sj = $self->_sj;
124              
125 0           return $sj->is_valid($data);
126             }
127              
128             1;
129              
130             __END__