File Coverage

blib/lib/MVC/Neaf/View/JS.pm
Criterion Covered Total %
statement 35 35 100.0
branch 9 14 64.2
condition 9 12 75.0
subroutine 7 7 100.0
pod 2 2 100.0
total 62 70 88.5


line stmt bran cond sub pod time code
1             package MVC::Neaf::View::JS;
2              
3 25     25   80950 use strict;
  25         63  
  25         788  
4 25     25   128 use warnings;
  25         58  
  25         1108  
5              
6             our $VERSION = '0.2901';
7              
8             =head1 NAME
9              
10             MVC::Neaf::View::JS - JSON-based view for Not Even A Framework.
11              
12             =head1 SYNOPSIS
13              
14             See L.
15              
16             use MVC::Neaf;
17              
18             # define route ...
19             sub {
20             return {
21             # your data ...
22             -view => 'JS', # this is the default as of 0.20
23             -jsonp => 'my.jsonp.callback', # this is optional
24             }
25             };
26              
27             Will result in your application returning raw data in JSON/JSONP format
28             instead or rendering a template.
29              
30             =head1 METHODS
31              
32             =cut
33              
34 25     25   148 use Carp;
  25         51  
  25         1897  
35 25     25   1073 use MVC::Neaf::Util qw(JSON);
  25         68  
  25         1301  
36              
37 25     25   181 use parent qw(MVC::Neaf::View);
  25         71  
  25         169  
38              
39             my $js_id_re = qr/[A-Z_a-z][A-Z_a-z\d]*/;
40             my $jsonp_re = qr/^$js_id_re(?:\.$js_id_re)*$/;
41              
42             =head2 new( %options )
43              
44             %options may include:
45              
46             =over
47              
48             =item * want_pretty - sort keys & indent output
49              
50             =item * want_sorted - sort keys (this defaults to want_pretty)
51              
52             =item * preserve_dash - don't strip dashed options. Useful for debugging.
53              
54             =back
55              
56             =cut
57              
58             my %new_keys;
59             $new_keys{$_}++ for qw( neaf_base_dir preserve_dash want_pretty want_sorted );
60             sub new {
61 23     23 1 321 my ($class, %opt) = @_;
62              
63 23         159 my @extra = grep { !$new_keys{$_} } keys %opt;
  21         85  
64 23 50       92 croak "NEAF $class->new: unexpected keys @extra"
65             if @extra;
66              
67             $opt{want_sorted} = $opt{want_pretty}
68 23 50       123 unless defined $opt{want_sorted};
69             # No utf8 here (yet), will encode upon leaving the perimeter
70 23         145 my $codec = JSON->new->allow_blessed->convert_blessed
71             ->allow_unknown->allow_nonref;
72             $codec->pretty(1)
73 23 50       318 if $opt{want_pretty};
74             $codec->canonical(1)
75 23 50       71 if $opt{want_sorted};
76              
77 23         172 return bless {
78             %opt,
79             codec => $codec,
80             }, $class;
81             };
82              
83             =head2 render( \%data )
84              
85             Returns a scalar with JSON-encoded data.
86              
87             =cut
88              
89             sub render {
90 44     44 1 127 my ($self, $data) = @_;
91              
92 44         75 my $callback = $data->{-jsonp};
93 44         83 my $type = $data->{-type};
94              
95 44 100 66     338 if( exists $data->{-payload} || exists $data->{-serial} ) {
    50          
96 5   66     18 $data = $data->{-payload} || $data->{-serial};
97             }
98             elsif ( !$self->{preserve_dash} ) {
99             # This is the default - get rid of control keys, but
100             # don't spoil original data
101 39         65 $data = do {
102 39         60 my %shallow_copy;
103             /^-/ or $shallow_copy{$_} = $data->{$_}
104 39   66     366 for keys %$data;
105 39         117 \%shallow_copy;
106             };
107             }
108              
109 44         440 my $content = $self->{codec}->encode( $data );
110 44 100 100     332 return $callback && $callback =~ $jsonp_re
111             ? ("$callback($content);", "application/javascript; charset=utf-8")
112             : ($content, "application/json; charset=utf-8");
113             };
114              
115             =head1 LICENSE AND COPYRIGHT
116              
117             This module is part of L suite.
118              
119             Copyright 2016-2023 Konstantin S. Uvarin C.
120              
121             This program is free software; you can redistribute it and/or modify it
122             under the terms of either: the GNU General Public License as published
123             by the Free Software Foundation; or the Artistic License.
124              
125             See L for more information.
126              
127             =cut
128              
129             1;