| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Ark::View::JSON; | 
| 2 | 1 |  |  | 1 |  | 546 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 31 |  | 
| 3 | 1 |  |  | 1 |  | 4 | use warnings; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 23 |  | 
| 4 | 1 |  |  | 1 |  | 4 | use Ark 'View'; | 
|  | 1 |  |  |  |  | 1 |  | 
|  | 1 |  |  |  |  | 8 |  | 
| 5 | 1 |  |  | 1 |  | 11 | use JSON; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 9 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 |  |  |  |  |  |  | has allow_callback => ( | 
| 8 |  |  |  |  |  |  | is      => 'rw', | 
| 9 |  |  |  |  |  |  | isa     => 'Bool', | 
| 10 |  |  |  |  |  |  | default => 0, | 
| 11 |  |  |  |  |  |  | ); | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | has callback_param => ( | 
| 14 |  |  |  |  |  |  | is      => 'rw', | 
| 15 |  |  |  |  |  |  | isa     => 'Str', | 
| 16 |  |  |  |  |  |  | default => 'callback', | 
| 17 |  |  |  |  |  |  | ); | 
| 18 |  |  |  |  |  |  |  | 
| 19 |  |  |  |  |  |  | has expose_stash => ( | 
| 20 |  |  |  |  |  |  | is => 'rw', | 
| 21 |  |  |  |  |  |  | ); | 
| 22 |  |  |  |  |  |  |  | 
| 23 |  |  |  |  |  |  | has json_driver => ( | 
| 24 |  |  |  |  |  |  | is      => 'rw', | 
| 25 |  |  |  |  |  |  | isa     => 'Object', | 
| 26 |  |  |  |  |  |  | lazy    => 1, | 
| 27 |  |  |  |  |  |  | default => sub { | 
| 28 |  |  |  |  |  |  | my $self = shift; | 
| 29 |  |  |  |  |  |  | JSON->new->utf8->allow_nonref; | 
| 30 |  |  |  |  |  |  | }, | 
| 31 |  |  |  |  |  |  | ); | 
| 32 |  |  |  |  |  |  |  | 
| 33 |  |  |  |  |  |  | has json_dumper => ( | 
| 34 |  |  |  |  |  |  | is      => 'rw', | 
| 35 |  |  |  |  |  |  | isa     => 'CodeRef', | 
| 36 |  |  |  |  |  |  | lazy    => 1, | 
| 37 |  |  |  |  |  |  | default => sub { | 
| 38 |  |  |  |  |  |  | my $self = shift; | 
| 39 |  |  |  |  |  |  | sub { $self->json_driver->encode(@_) }; | 
| 40 |  |  |  |  |  |  | }, | 
| 41 |  |  |  |  |  |  | ); | 
| 42 |  |  |  |  |  |  |  | 
| 43 |  |  |  |  |  |  | has status_code_field => ( | 
| 44 |  |  |  |  |  |  | is  => 'ro', | 
| 45 |  |  |  |  |  |  | isa => "Str", | 
| 46 |  |  |  |  |  |  | ); | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | has status_code_header => ( | 
| 49 |  |  |  |  |  |  | is      => 'ro', | 
| 50 |  |  |  |  |  |  | isa     => "Str", | 
| 51 |  |  |  |  |  |  | default => 'X-API-Status', | 
| 52 |  |  |  |  |  |  | ); | 
| 53 |  |  |  |  |  |  |  | 
| 54 |  |  |  |  |  |  | # steal code from Catalyst::View::JSON | 
| 55 |  |  |  |  |  |  | sub process { | 
| 56 | 2 |  |  | 2 | 0 | 5 | my ($self, $c) = @_; | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | # get the response data from stash | 
| 59 | 2 |  |  | 0 |  | 8 | my $cond = sub { 1 }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 60 |  |  |  |  |  |  |  | 
| 61 | 2 |  |  |  |  | 4 | my $single_key; | 
| 62 | 2 | 50 |  |  |  | 10 | if (my $expose = $self->expose_stash) { | 
| 63 | 2 | 50 |  |  |  | 12 | if (ref($expose) eq 'Regexp') { | 
|  |  | 50 |  |  |  |  |  | 
|  |  | 50 |  |  |  |  |  | 
| 64 | 0 |  |  | 0 |  | 0 | $cond = sub { $_[0] =~ $expose }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 65 |  |  |  |  |  |  | } elsif (ref($expose) eq 'ARRAY') { | 
| 66 | 0 |  |  |  |  | 0 | my %match = map { $_ => 1 } @$expose; | 
|  | 0 |  |  |  |  | 0 |  | 
| 67 | 0 |  |  | 0 |  | 0 | $cond = sub { $match{$_[0]} }; | 
|  | 0 |  |  |  |  | 0 |  | 
| 68 |  |  |  |  |  |  | } elsif (!ref($expose)) { | 
| 69 | 2 |  |  |  |  | 5 | $single_key = $expose; | 
| 70 |  |  |  |  |  |  | } else { | 
| 71 | 0 |  |  |  |  | 0 | $c->log( warn => "expose_stash should be an array referernce or Regexp object."); | 
| 72 |  |  |  |  |  |  | } | 
| 73 |  |  |  |  |  |  | } | 
| 74 |  |  |  |  |  |  |  | 
| 75 | 2 |  |  |  |  | 3 | my $data; | 
| 76 | 2 | 50 |  |  |  | 5 | if ($single_key) { | 
| 77 | 2 |  |  |  |  | 6 | $data = $c->stash->{$single_key}; | 
| 78 |  |  |  |  |  |  | } else { | 
| 79 | 0 | 0 |  |  |  | 0 | $data = { map { $cond->($_) ? ($_ => $c->stash->{$_}) : () } | 
|  | 0 |  |  |  |  | 0 |  | 
| 80 | 0 |  |  |  |  | 0 | keys %{$c->stash} }; | 
| 81 |  |  |  |  |  |  | } | 
| 82 |  |  |  |  |  |  |  | 
| 83 | 2 | 50 | 0 |  |  | 13 | my $cb_param = $self->allow_callback | 
| 84 |  |  |  |  |  |  | ? ($self->callback_param || 'callback') : undef; | 
| 85 | 2 | 50 |  |  |  | 5 | my $cb = $cb_param ? $c->req->param($cb_param) : undef; | 
| 86 | 2 | 50 |  |  |  | 7 | $self->validate_callback_param($cb) if $cb; | 
| 87 |  |  |  |  |  |  |  | 
| 88 | 2 |  |  |  |  | 26 | my $json = $self->json_dumper->($data); | 
| 89 |  |  |  |  |  |  |  | 
| 90 | 2 | 50 | 50 |  |  | 19 | if (($c->req->user_agent || '') =~ /Opera/) { | 
| 91 | 0 |  |  |  |  | 0 | $c->res->content_type('application/x-javascript; charset=utf-8'); | 
| 92 |  |  |  |  |  |  | } else { | 
| 93 | 2 |  |  |  |  | 295 | $c->res->content_type('application/json; charset=utf-8'); | 
| 94 |  |  |  |  |  |  | } | 
| 95 |  |  |  |  |  |  |  | 
| 96 | 2 | 50 |  |  |  | 163 | if (defined (my $status_code_field = $self->status_code_field)) { | 
| 97 | 2 | 100 |  |  |  | 7 | if (exists $data->{$status_code_field}) { | 
| 98 | 1 |  |  |  |  | 13 | $c->res->header($self->status_code_header => $data->{$status_code_field}); | 
| 99 |  |  |  |  |  |  | } | 
| 100 |  |  |  |  |  |  | } | 
| 101 |  |  |  |  |  |  |  | 
| 102 | 2 |  |  |  |  | 46 | my $output; | 
| 103 |  |  |  |  |  |  |  | 
| 104 |  |  |  |  |  |  | ## add UTF-8 BOM if the client is Safari ### XXXX | 
| 105 | 2 | 0 | 0 |  |  | 10 | if ($self->allow_callback and | 
|  |  |  | 33 |  |  |  |  | 
|  |  |  | 0 |  |  |  |  | 
|  |  |  | 33 |  |  |  |  | 
| 106 |  |  |  |  |  |  | ($c->req->user_agent || '') =~ m/Safari/ and | 
| 107 |  |  |  |  |  |  | ($c->req->user_agent || '') !~ m/Chrome/) { | 
| 108 | 0 |  |  |  |  | 0 | $output = "\xEF\xBB\xBF"; | 
| 109 |  |  |  |  |  |  | } | 
| 110 |  |  |  |  |  |  |  | 
| 111 | 2 | 50 |  |  |  | 6 | $output .= "$cb(" if $cb; | 
| 112 | 2 |  |  |  |  | 5 | $output .= $json; | 
| 113 | 2 | 50 |  |  |  | 4 | $output .= ");"   if $cb; | 
| 114 |  |  |  |  |  |  |  | 
| 115 | 2 |  |  |  |  | 33 | $c->res->body($output); | 
| 116 |  |  |  |  |  |  | } | 
| 117 |  |  |  |  |  |  |  | 
| 118 |  |  |  |  |  |  | __PACKAGE__->meta->make_immutable; | 
| 119 |  |  |  |  |  |  |  |