File Coverage

blib/lib/Plack/Middleware/JSONP/Headers.pm
Criterion Covered Total %
statement 88 89 98.8
branch 19 26 73.0
condition 1 3 33.3
subroutine 18 18 100.0
pod 2 4 50.0
total 128 140 91.4


line stmt bran cond sub pod time code
1             package Plack::Middleware::JSONP::Headers;
2             {
3             $Plack::Middleware::JSONP::Headers::VERSION = '0.11';
4             }
5             #ABSTRACT: Wraps JSON response with HTTP headers in JSONP
6 2     2   21479 use strict;
  2         4  
  2         78  
7              
8 2     2   801 use parent qw(Plack::Middleware);
  2         296  
  2         14  
9              
10 2     2   18060 use Plack::Util;
  2         8  
  2         37  
11 2     2   682 use Plack::Builder;
  2         3817  
  2         144  
12 2     2   772 use URI::Escape ();
  2         1310  
  2         38  
13 2     2   1054 use JSON ();
  2         44862  
  2         48  
14 2     2   15 use Scalar::Util 'reftype';
  2         5  
  2         194  
15 2     2   1088 use HTTP::Headers ();
  2         15443  
  2         63  
16 2     2   16 use Plack::Util::Accessor qw(callback_key headers template);
  2         3  
  2         23  
17              
18             sub prepare_app {
19 6     6 1 11872 my $self = shift;
20              
21 6 50       18 unless (defined $self->callback_key) {
22 6         208 $self->callback_key('callback');
23             }
24            
25 6 100       45 unless (defined $self->headers) {
26 1     1   48 $self->headers( sub { 1 } );
  1         18  
27             }
28              
29 6 100       39 unless (reftype $self->headers eq 'CODE') {
30 5         36 my $headers = $self->headers;
31 5 100       27 if (ref $self->headers eq ref qr//) {
    50          
32 2     6   21 $self->headers( sub { $_[0] =~ $headers; } );
  6         59  
33             } elsif (reftype $self->headers eq 'ARRAY') {
34 3     6   52 $self->headers( sub { grep { $_[0] eq $_ } @$headers } );
  6         34  
  7         28  
35             } else {
36 0         0 die "headers must be code, array, or regexp";
37             }
38             }
39              
40 6 100       49 unless ($self->template) {
41 5         30 $self->template('{ "meta": %s, "data": %s }')
42             }
43             }
44              
45             sub wrap_json {
46 6     6 0 13 my ($self, $status, $headers, $data) = @_;
47              
48 6         16 my $meta = { status => $status };
49 6         8 my @links;
50              
51             $headers->iter( sub {
52 13     13   115 my ($key, $value) = @_;
53 13 100       34 return unless $self->headers->($key, $value);
54 5 100       41 if ($key eq 'Link') {
55 1         3 push @{$meta->{'Link'}}, $self->parse_link_header( $value );
  1         6  
56             } else {
57 4         18 $meta->{$key} = $value; # just ignores repeatable headers
58             }
59 6         40 });
60            
61 6 50       51 $meta->{Link} = \@links if @links;
62 6         95 $meta = JSON->new->encode( $meta );
63              
64 6         45 sprintf $self->template, $meta, $data;
65             }
66              
67             sub parse_link_header {
68 1     1 0 4 my ($self, $link) = @_;
69              
70 1         2 my @links;
71              
72 1         7 while( $link =~ /^(\s*<([^>]*)>\s*[;,]?\s*)/) {
73 2         4 my $url = $2;
74 2         6 $link = substr($link, length($1));
75 2         4 my %attr = ();
76 2         13 while ($link =~ /^((\/|[a-z0-9-]+\*?)\s*\=\s*("[^"]*"|[^\s\"\;\,]+)\s*[;,]?\s*)/i) {
77 3         7 $link = substr($link, length($1));
78 3         8 my $key = lc $2;
79 3         5 my $val = $3;
80 3 50       24 $val =~ s/(^"|"$)//g if ($val =~ /^".*"$/);
81 3         16 $attr{$key} = $val;
82             }
83 2         12 push @links, [ $url, \%attr ];
84             }
85              
86 1         7 return @links;
87             }
88              
89             # Most of this method is copied from Plack::Middleware::JSONP.
90             # I found no easy way to reuse this module, so it had to be forked.
91             sub call {
92 6     6 1 30886 my($self, $env) = @_;
93 6         162 my $res = $self->app->($env);
94             $self->response_cb($res, sub {
95 6     6   87 my $res = shift;
96 6 50       23 if (defined $res->[2]) {
97 6         20 my $h = Plack::Util::headers($res->[1]);
98 6         141 my $callback_key = $self->callback_key;
99 6 50 33     57 if ($h->get('Content-Type') =~ m!/(?:json|javascript)! &&
100             $env->{QUERY_STRING} =~ /(?:^|&)$callback_key=([^&]+)/) {
101 6         308 my $cb = URI::Escape::uri_unescape($1);
102 6 50       68 if ($cb =~ /^[\w\.\[\]]+$/) {
103 6         9 my $body;
104 6         43 Plack::Util::foreach($res->[2], sub { $body .= $_[0] });
  6         52  
105            
106             # this line added
107 6         44 $body = $self->wrap_json( $res->[0], $h, $body );
108              
109 6         70 my $jsonp = "$cb($body)";
110 6         14 $res->[2] = [ $jsonp ];
111 6         56 $h->set('Content-Length', length $jsonp);
112 6         404 $h->set('Content-Type', 'text/javascript');
113             }
114             }
115             }
116 6         110 });
117             }
118              
119             1;
120              
121              
122              
123             __END__