File Coverage

blib/lib/WJSON.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package WJSON;
2              
3 1     1   15546 use Moose;
  0            
  0            
4             use JSON;
5             use Encode;
6             use Tie::IxHash;
7             no warnings 'uninitialized';
8              
9             our $VERSION = '0.08';
10              
11             has 'json' => (
12             is => 'ro',
13             isa => 'ArrayRef',
14             default => sub {
15             []
16             }
17             );
18              
19             has 'reference' => (
20             is => 'ro',
21             isa => 'HashRef',
22             default => sub {
23             {}
24             }
25             );
26              
27             has 'tmp' => (
28             is => 'rw',
29             isa => 'Str'
30             );
31              
32             has 'encoding' => (
33             is => 'rw',
34             isa => 'Str',
35             default => 'utf-8'
36             );
37              
38             has 'variable' => (
39             is => 'rw',
40             isa => 'Str'
41             );
42              
43             has 'ordering' => (
44             is => 'rw',
45             isa => 'Str',
46             default => 0
47             );
48              
49             sub Open {
50             my ($self, $value) = @_;
51            
52             if ($value) {
53             if($self->tmp){
54             my $tmp = $self->tmp;
55             unless (scalar(@{$self->reference->{$self->tmp}})) {
56             my %hash;
57             tie %hash, 'Tie::IxHash' if $self->ordering;
58             $self->Object(\%hash);
59             }
60             $tmp .= '/' . $value;
61             $self->tmp($tmp);
62             }else{
63             $self->tmp('/' . $value);
64             }
65             $self->reference->{$self->tmp} = [];
66             }
67             }
68              
69             sub Close {
70             my ($self, $type) = @_;
71            
72             my $tmp = $self->tmp;
73             $tmp =~ m!/([\w]*?)$!s;
74             my $key = $1;
75             $tmp =~ s/\/[\w]*?$//;
76             $self->tmp($tmp);
77             if ($self->tmp) {
78             my $total = @{$self->reference->{$self->tmp}} || 1;
79             if (scalar(@{$self->reference->{$tmp.'/'.$key}}) == 1) {
80             my $result = $self->reference->{$tmp.'/'.$key}[0];
81             if (ref($self->reference->{$self->tmp}[$total - 1]) eq 'HASH') {
82             if ($type == 1) {
83             push(@{$self->reference->{$self->tmp}}, {$key => $result});
84             }elsif($type == 2) {
85             $self->reference->{$self->tmp}[$total - 1]{$key} = [$result];
86             }elsif($type == 3) {
87             push(@{$self->reference->{$self->tmp}}, {$key => [$result]});
88             }else{
89             $self->reference->{$self->tmp}[$total - 1]{$key} = $result;
90             }
91             }else{
92             my $t = 1;
93             if ($self->reference->{$self->tmp}[$total - 1]) {
94             $t = scalar(@{$self->reference->{$self->tmp}[$total - 1]}) || 1;
95             }
96             if ($type == 1) {
97             push(@{$self->reference->{$self->tmp}[$total - 1]}, {$key => $result});
98             }elsif($type == 2) {
99             $self->reference->{$self->tmp}[$total - 1][$t - 1]{$key} = [$result];
100             }elsif($type == 3) {
101             push(@{$self->reference->{$self->tmp}[$total - 1]}, {$key => [$result]});
102             }else{
103             if ($self->reference->{$self->tmp}[$total - 1][$t - 1]) {
104             $self->reference->{$self->tmp}[$total - 1][$t]{$key} = $result;
105             }else{
106             $self->reference->{$self->tmp}[$total - 1][$t - 1]{$key} = $result;
107             }
108             }
109             }
110             }else{
111             my $result = $self->reference->{$tmp.'/'.$key};
112             $result = [$result] if scalar(@{$result}) <= 1 && $type =~ /(2|3)/;
113             if (ref($self->reference->{$self->tmp}[$total - 1]) eq 'HASH') {
114             if ($type == 1) {
115             push(@{$self->reference->{$self->tmp}}, {$key => $result});
116             }elsif($type == 2) {
117             $self->reference->{$self->tmp}[$total - 1]{$key} = $result;
118             }elsif($type == 3) {
119             push(@{$self->reference->{$self->tmp}}, {$key => $result});
120             }else{
121             $self->reference->{$self->tmp}[$total - 1]{$key} = $result;
122             }
123             }else{
124             my $t = 1;
125             if ($self->reference->{$self->tmp}[$total - 1]) {
126             $t = scalar(@{$self->reference->{$self->tmp}[$total - 1]}) || 1;
127             }
128             if ($type == 1) {
129             push(@{$self->reference->{$self->tmp}[$total - 1]}, {$key => $result});
130             }elsif($type == 2) {
131             $self->reference->{$self->tmp}[$total - 1][$t - 1]{$key} = $result;
132             }elsif($type == 3) {
133             push(@{$self->reference->{$self->tmp}[$total - 1]}, {$key => $result});
134             }else{
135             $self->reference->{$self->tmp}[$total - 1][$t - 1]{$key} = $result;
136             }
137             }
138             }
139             }else{
140             my $total = scalar(@{$self->json}) || 1;
141             if (scalar(@{$self->reference->{$tmp.'/'.$key}}) == 1) {
142             my $result = $self->reference->{$tmp.'/'.$key}[0];
143             if (ref($self->json->[$total - 1]) eq 'HASH') {
144             if ($type == 1) {
145             push(@{$self->json}, {$key => $result});
146             }elsif($type == 2) {
147             $self->json->[$total - 1]{$key} = [$result];
148             }elsif($type == 3) {
149             push(@{$self->json}, {$key => [$result]});
150             }else{
151             $self->json->[$total - 1]{$key} = $result;
152             }
153             }else{
154             my $t = 1;
155             if ($self->json->[$total - 1]) {
156             $t = scalar(@{$self->json->[$total - 1]}) || 1;
157             }
158             if ($type == 1) {
159             push(@{$self->json->[$total - 1]}, {$key => $result});
160             }elsif($type == 2) {
161             $self->json->[$total - 1][$t - 1]{$key} = [$result];
162             }elsif($type == 3) {
163             push(@{$self->json->[$total - 1]}, {$key => [$result]});
164             }else{
165             $self->json->[$total - 1][$t - 1]{$key} = $result;
166             }
167             }
168             }else{
169             my $result = $self->reference->{$tmp.'/'.$key};
170             $result = [$result] if scalar(@{$result}) <= 1 && $type =~ /(2|3)/;
171             if (ref($self->json->[$total - 1]) eq 'HASH') {
172             if ($type == 1) {
173             push(@{$self->json}, {$key => $result});
174             }elsif($type == 2) {
175             $self->json->[$total - 1]{$key} = $result;
176             }elsif($type == 3) {
177             $result = [$result] if scalar(@{$result}) <= 1;
178             push(@{$self->json}, {$key => $result});
179             }else{
180             $self->json->[$total - 1]{$key} = $result;
181             }
182             }else{
183             my $t = 1;
184             if ($self->json->[$total - 1]) {
185             $t = scalar(@{$self->json->[$total - 1]}) || 1;
186             }
187             if ($type == 1) {
188             push(@{$self->json}, {$key => $result});
189             }elsif($type == 2) {
190             $self->json->[$total - 1]{$key} = $result;
191             }elsif($type == 3) {
192             push(@{$self->json}, {$key => $result});
193             }else{
194             $self->json->[$total - 1]{$key} = $result;
195             }
196             }
197             }
198             }
199             delete($self->reference->{$tmp.'/'.$key});
200             }
201              
202             sub Array {
203             my ($self, @values) = @_;
204            
205             if ($self->tmp) {
206             push(@{$self->reference->{$self->tmp}}, [@values]);
207             }else{
208             push(@{$self->json}, [@values]);
209             }
210             }
211              
212             sub Object {
213             my ($self, @values) = @_;
214            
215             if (ref($values[0]) eq 'HASH') {
216             $self->HashObject(@values);
217             }else{
218             if (ref($self->reference->{$self->tmp}[0]) eq 'ARRAY') {
219             my %hash;
220             tie %hash, 'Tie::IxHash' if $self->ordering;
221             %hash = \@values;
222             push(@{$self->reference->{$self->tmp}[0]}, \%hash);
223             }else{
224             if ($self->tmp) {
225             my %hash;
226             tie %hash, 'Tie::IxHash' if $self->ordering;
227             %hash = @values;
228             push(@{$self->reference->{$self->tmp}}, \%hash);
229             }else{
230             my %hash;
231             tie %hash, 'Tie::IxHash' if $self->ordering;
232             if (ref(\@values) eq 'ARRAY') {
233             my $n = 0;
234             $n % 2 == 0 ? $hash{$values[$n]} = $values[$n+1] : undef, $n++ for (@values);
235             push(@{$self->json}, \%hash);
236             }else{
237             %hash = \@values;
238             push(@{$self->json}, \%hash);
239             }
240             }
241             }
242             }
243             }
244              
245             sub HashObject {
246             my ($self, @values) = @_;
247             unless (ref($values[0]) eq 'HASH') {
248             $self->Object(@values);
249             }else{
250             foreach my $row (@values){
251             if ($self->reference->{$self->tmp}[0]) {
252             if (ref($self->reference->{$self->tmp}[0]) eq 'ARRAY') {
253             push(@{$self->reference->{$self->tmp}[0]}, $row);
254             }else{
255             push(@{$self->reference->{$self->tmp}}, $row);
256             }
257             }else{
258             if ($self->tmp) {
259             push(@{$self->reference->{$self->tmp}}, $row);
260             }else{
261             push(@{$self->json}, $row);
262             }
263             }
264             }
265             }
266             }
267              
268             sub Header {
269             return "application/json";
270             }
271              
272             sub HeaderJS {
273             return "application/javascript";
274             }
275              
276             sub HeaderCGI {
277             return "Content-type: application/json\n\n";
278             }
279              
280             sub HeaderJSCGI {
281             return "Content-type: application/javascript\n\n";
282             }
283              
284              
285             sub Print {
286             my ($self, $type) = @_;
287            
288             my $result = undef;
289             if (scalar(@{$self->json}) <= 1) {
290             if (ref($self->json->[0]) eq 'ARRAY') {
291             if (scalar(@{$self->json->[0]}) <= 1) {
292             $result = ${$self->json}[0][0];
293             }else{
294             $result = ${$self->json}[0];
295             }
296             }else{
297             $result = ${$self->json}[0];
298             }
299             }else{
300             $result = $self->json;
301             }
302            
303             $result = [$result] if $type;
304            
305             if ($self->variable) {
306             return 'var ' . $self->variable . ' = ' . encode $self->encoding, JSON->new->encode($result) . ';';
307             }else{
308             return $result ? encode $self->encoding, JSON->new->encode($result) : '';
309             }
310             }
311              
312             1;
313              
314             __END__