File Coverage

lib/Dancer/Plugin/Swagger/Path.pm
Criterion Covered Total %
statement 54 79 68.3
branch 10 26 38.4
condition 1 10 10.0
subroutine 15 19 78.9
pod 0 5 0.0
total 80 139 57.5


line stmt bran cond sub pod time code
1             package Dancer::Plugin::Swagger::Path;
2             our $AUTHORITY = 'cpan:YANICK';
3             # ABSTRACT: Internal representation of a swagger path
4             $Dancer::Plugin::Swagger::Path::VERSION = '0.3.0';
5              
6 2     2   16 use strict;
  2         5  
  2         63  
7 2     2   11 use warnings;
  2         3  
  2         51  
8              
9 2     2   1195 use Moo;
  2         17664  
  2         11  
10              
11 2     2   4121 use MooseX::MungeHas 'is_ro';
  2         8288  
  2         16  
12              
13 2     2   1884 use Carp;
  2         5  
  2         126  
14 2     2   1154 use Hash::Merge;
  2         9699  
  2         105  
15 2     2   15 use Clone 'clone';
  2         6  
  2         115  
16 2     2   1399 use List::AllUtils qw/ first any none /;
  2         26850  
  2         225  
17 2     2   1370 use JSON;
  2         21490  
  2         16  
18 2     2   1260 use Class::Load qw/ load_class /;
  2         20847  
  2         1874  
19              
20             has route => ( handles => [ 'pattern' ] );
21              
22             has tags => ( predicate => 1 );
23              
24             has method => sub {
25 8 50   8   72 eval { $_[0]->route->method }
  8         31  
26             or croak "no route or explicit method provided to path";
27             };
28              
29             has path => sub {
30 8     8   96 dancer_pattern_to_swagger_path( $_[0]->route->pattern );
31             };
32              
33             has responses => ( predicate => 1);
34              
35             has description => ( predicate => 1 );
36              
37             has parameters =>
38             lazy => 1,
39             default => sub { [] },
40             predicate => 1,
41             ;
42              
43             # TODO allow to pass a hashref instead of an arrayref
44             sub parameter {
45 0     0 0 0 my( $self, $param, $args ) = @_;
46              
47 0   0     0 $args ||= {};
48 0   0     0 $args->{name} ||= $param;
49              
50 0     0   0 my $p = first { $_->{name} eq $param } @{ $self->parameters };
  0         0  
  0         0  
51            
52 0 0       0 push @{ $self->parameters || [] }, $p = { name => $param }
  0 0       0  
53             unless $p;
54              
55 0         0 %$p = %{Hash::Merge::merge( $p, $args )};
  0         0  
56             }
57              
58             sub dancer_pattern_to_swagger_path {
59 8     8 0 71 my $pattern = shift;
60 8         20 $pattern =~ s#(?<=/):(\w+)(?=/|$)#{$1}#g;
61 8         26 return $pattern;
62             }
63              
64             sub add_to_doc {
65 8     8 0 81 my( $self, $doc ) = @_;
66              
67 8         147 my $path = $self->path;
68 8         140 my $method = $self->method;
69              
70             # already there
71 8 50       98 next if $doc->{paths}{$path}{$method};
72              
73 8   50     50 my $m = $doc->{paths}{$path}{$method} ||= {};
74              
75 8 100       48 $m->{description} = $self->description if $self->has_description;
76 8 100       98 $m->{parameters} = $self->parameters if $self->has_parameters;
77 8 50       50 $m->{tags} = $self->tags if $self->has_tags;
78              
79 8 100       49 if( $self->has_responses ) {
80 1         18 $m->{responses} = clone $self->responses;
81              
82 1         3 for my $r ( values %{$m->{responses}} ) {
  1         5  
83 1         3 delete $r->{template};
84              
85 1 50       7 if( my $example = delete $r->{example} ) {
86 0         0 my $serializer = Dancer::engine('serializer');
87             die "Don't know content type for serializer ", ref $serializer
88 0 0   0   0 if none { $serializer->isa($_) } qw/ Dancer::Serializer::JSON Dancer::Serializer::YAML /;
  0         0  
89 0         0 $r->{examples}{$serializer->content_type} = $example;
90             }
91             }
92             }
93              
94              
95             }
96              
97             sub validate_response {
98 0     0 0 0 my( $self, $code, $data, $strict ) = @_;
99              
100 0         0 my $schema = $self->responses->{$code}{schema};
101              
102 0 0 0     0 die "no schema found for return code $code for ", join ' ' , uc($self->method), $self->path
103             unless $schema or not $strict;
104              
105 0 0       0 return unless $schema;
106              
107 0         0 my $plugin = Dancer::Plugin::Swagger->instance;
108              
109             $schema = {
110             definitions => $plugin->doc->{definitions},
111 0         0 properties => { response => $schema },
112             };
113              
114 0         0 my $result = load_class('JSON::Schema::AsType')->new( schema => $schema)->validate_explain({ response => $data });
115              
116 0 0       0 return unless $result;
117              
118 0         0 die join "\n", map { "* " . $_ } @$result;
  0         0  
119             }
120              
121             sub BUILD {
122 8     8 0 6417 my $self = shift;
123              
124 8         20 for my $param ( eval { @{ $self->route->{_params} } } ) {
  8         11  
  8         64  
125 0           $self->parameter( $param => {
126             in => 'path',
127             required => JSON::true,
128             type => "string",
129             } );
130             }
131             }
132              
133             1;
134              
135             __END__
136              
137             =pod
138              
139             =encoding UTF-8
140              
141             =head1 NAME
142              
143             Dancer::Plugin::Swagger::Path - Internal representation of a swagger path
144              
145             =head1 VERSION
146              
147             version 0.3.0
148              
149             =head1 DESCRIPTION
150              
151             Objects of this class are used by L<Dancer::Plugin::Swagger> to represent
152             a path in the Swagger document.
153              
154             =head1 AUTHOR
155              
156             Yanick Champoux <yanick@cpan.org>
157              
158             =head1 COPYRIGHT AND LICENSE
159              
160             This software is copyright (c) 2021, 2016, 2015 by Yanick Champoux.
161              
162             This is free software; you can redistribute it and/or modify it under
163             the same terms as the Perl 5 programming language system itself.
164              
165             =cut