File Coverage

blib/lib/JSON/Lines.pm
Criterion Covered Total %
statement 100 112 89.2
branch 30 50 60.0
condition 4 6 66.6
subroutine 18 19 94.7
pod 10 10 100.0
total 162 197 82.2


line stmt bran cond sub pod time code
1             package JSON::Lines;
2 8     8   475222 use 5.006; use strict; use warnings; our $VERSION = '0.03';
  8     8   134  
  8     8   39  
  8         13  
  8         190  
  8         50  
  8         13  
  8         362  
3 8     8   4815 use JSON; use base 'Import::Export';
  8     8   88870  
  8         35  
  8         1061  
  8         16  
  8         3157  
4              
5             our ($JSON, $LINES, %EX);
6             BEGIN {
7 8     8   122453 $JSON = JSON->new;
8 8         44 $LINES = qr{ ([\[\{] (?: (?> [^\[\]\{\}]+ ) | (??{ $LINES }) )* [\]\}]) }x;
9 8         9412 %EX = (
10             jsonl => [qw/all/]
11             );
12             }
13              
14             sub jsonl {
15 4 50   4 1 2881 my %args = (scalar @_ == 1 ? %{$_[0]} : @_);
  0         0  
16 4         17 my $self = __PACKAGE__->new(%args);
17             return $args{file}
18             ? $self->encode_file($args{file}, $args{data})
19             : $self->encode($args{data})
20 4 50       18 if ($args{encode});
    100          
21             return $args{file}
22             ? $self->decode_file($args{file})
23             : $self->decode($args{data})
24 2 50       9 if ($args{decode});
    50          
25             }
26              
27             sub new {
28 10 50   10 1 545 my ($pkg, %args) = (shift, scalar @_ == 1 ? %{$_[0]} : @_);
  0         0  
29 10         39 my $self = bless { headers => [] }, $pkg;
30 10   66     136 exists $args{$_} && $JSON->$_($args{$_}) for qw/json pretty canonical/;
31 10         79 $self->{$_} = $args{$_} for qw/parse_headers error_cb success_cb/;
32 10         31 $self;
33             }
34              
35             sub encode {
36 11 100   11 1 2216 my ($self, @data) = (shift, scalar @_ == 1 ? @{$_[0]} : @_);
  7         18  
37             @data = $self->_parse_headers(@data)
38 11 100       36 if ($self->{parse_headers});
39 11         14 my $stream;
40 11         27 for (@data) {
41 28         40 my $json = eval { $JSON->encode($_) };
  28         194  
42 28 50       93 if ($@) {
43 0 0       0 if ($self->{error_cb}) {
44 0         0 $self->{error_cb}->($@, $_);
45             } else {
46 0         0 die $@;
47             }
48             } else {
49 28 50       64 $self->{success_cb}->($json, $_) if $self->{success_cb};
50 28 100       137 $stream .= $json . ($json =~ m/\n$/ ? "" : "\n");
51             }
52             }
53 11         63 return $self->{stream} = $stream;
54             }
55              
56             sub encode_file {
57 1     1 1 19 my ($self, $file) = (shift, shift);
58 1         110 open my $fh, '>', $file;
59 1         8 print $fh $self->encode(@_);
60 1         63 close $fh;
61 1         9 return $file;
62             }
63              
64             sub decode {
65 9     9 1 4088 my ($self, $string) = @_;
66 9         27 my @lines;
67             push @lines, $self->_decode_line($_)
68 9         103 for ($string =~ m/$LINES/g);
69             @lines = $self->_deparse_headers(@lines)
70 9 100       38 if ($self->{parse_headers});
71 9 100       56 return wantarray ? @lines : \@lines;
72             }
73              
74             sub decode_file {
75 1     1 1 792 my ($self, $file) = (shift, shift);
76 1         38 open my $fh, '<', $file;
77 1         4 my $content = do { local $/; <$fh> };
  1         4  
  1         33  
78 1         10 close $fh;
79 1         7 return $self->decode($content);
80             }
81              
82             sub add_line {
83 2     2 1 1060 my ($self, $line, $fh) = @_;
84 2 50       11 if (defined $fh) {
85 0         0 print $fh $self->encode([$line]);
86             } else {
87 2         3 my $stream = $self->{stream};
88 2         7 my $add = $self->encode([$line]);
89 2         5 $self->{stream} = $stream . $add;
90 2         6 $self->{stream};
91             }
92             }
93              
94             sub clear_stream {
95 0     0 1 0 $_[0]->{stream} = '';
96             }
97              
98             sub get_lines {
99 1     1 1 1076 my ($self, $fh, $lines) = @_;
100 1         3 my @lines;
101 1         4 for (1 .. $lines) {
102 3         7 my $line = $self->get_line($fh);
103 3         7 push @lines, $line;
104 3 100       21 last if eof($fh);
105             }
106 1 50       8 return wantarray ? @lines : \@lines;
107             }
108              
109             sub get_line {
110 6     6 1 4057 my ($self, $fh) = @_;
111 6         9 my $line = '';
112 6   66     381 $line .= <$fh> while ($line !~ m/^$LINES/ && !eof($fh));
113 6         22 return $self->_decode_line($line);
114             }
115              
116             sub _decode_line {
117 32     32   69 my ($self, $line) = @_;
118 32         42 my $struct = eval { $JSON->decode($line) };
  32         203  
119 32 50       74 if ($@) {
120 0 0       0 if ($self->{error_cb}) {
121 0         0 return $self->{error_cb}->($@, $line);
122             } else {
123 0         0 die $@;
124             }
125             }
126 32 50       67 return $self->{success_cb}->($struct, $line) if $self->{success_cb};
127 32         80 return $struct;
128             }
129              
130             sub _parse_headers {
131 1     1   4 my ($self, @data) = @_;
132 1         2 my @headers = @{ $self->{headers} };
  1         3  
133 1 50       4 unless (@headers) {
134 1 50       3 if (ref $data[0] eq 'ARRAY') {
135 0         0 @headers = @{ shift @data };
  0         0  
136             } else {
137 1         2 @headers = sort keys %{ $data[0] };
  1         14  
138             }
139 1         12 $self->{headers} = \@headers;
140             }
141 1         7 my @body;
142 1         3 for my $d (@data) {
143             push @body, (ref $d eq 'ARRAY')
144             ? $d
145             : [
146             map {
147 2 50       8 $d->{$_}
  6         12  
148             } @headers
149             ];
150             }
151             return (
152 1         4 \@headers,
153             @body
154             );
155             }
156              
157             sub _deparse_headers {
158 1     1   4 my ($self, @data) = @_;
159 1 50       4 return @data unless ref $data[0] eq 'ARRAY';
160 1         2 my @headers = @{ shift @data };
  1         4  
161 1         2 my @body;
162 1         3 for my $d (@data) {
163 2         3 my $i = 0;
164             push @body, (ref $d eq 'HASH')
165             ? $d
166             : {
167             map {
168 2 50       7 $_ => $d->[$i++]
  6         50  
169             } @headers
170             };
171             }
172 1         8 return @body;
173             }
174              
175             1;
176              
177             __END__