File Coverage

blib/lib/Net/ACME/HTTP/Response.pm
Criterion Covered Total %
statement 33 34 97.0
branch 3 4 75.0
condition 0 3 0.0
subroutine 9 9 100.0
pod 0 3 0.0
total 45 53 84.9


line stmt bran cond sub pod time code
1             package Net::ACME::HTTP::Response;
2              
3 1     1   59894 use strict;
  1         1  
  1         66  
4 1     1   5 use warnings;
  1         1  
  1         27  
5              
6 1     1   3 use parent qw( HTTP::Tiny::UA::Response );
  1         1  
  1         4  
7              
8 1     1   3441 use Call::Context ();
  1         181  
  1         13  
9 1     1   3 use JSON ();
  1         1  
  1         9  
10              
11 1     1   343 use Net::ACME::X ();
  1         2  
  1         185  
12              
13             sub die_because_unexpected {
14 1     1 0 427 my ($self) = @_;
15              
16 1         26 die Net::ACME::X::create(
17             'UnexpectedResponse',
18             {
19             uri => $self->url(),
20             status => $self->status(),
21             reason => $self->reason(),
22             headers => $self->headers(),
23             },
24             );
25             }
26              
27             #Useful for everything but certificate issuance, apparently?
28             sub content_struct {
29 1     1 0 8166 my ($self) = @_;
30              
31 1         35 return JSON::decode_json( $self->content() );
32             }
33              
34             #A “poor man’s Link header parser” that only knows how to handle
35             #these values as described in the ACME protocol spec:
36             #a single “rel” parameter, and no extra whitespace.
37             #
38             #This returns key/value pairs. They should probably go into a hash,
39             #but I don’t see anything in the spec that says the same “rel”
40             #parameter can’t occur twice.
41             #
42             #If we need something more robust down the line,
43             #HTTP::Link::Parser::parse_single_link() may do the trick.
44             sub links {
45 1     1 0 1251 my ($self) = @_;
46              
47 1         6 Call::Context::must_be_list();
48              
49 1         22 my $links_ar = $self->header('link');
50 1 50       14 if ( !ref $links_ar ) {
51 0   0     0 $links_ar = [ $links_ar || () ];
52             }
53              
54 1         1 my @resp;
55              
56 1         3 for my $l (@$links_ar) {
57 3 100       13 $l =~ m/\A<([^>]+)>;rel="([^"]+)"\z/ or do {
58 1         14 warn "Unrecognized link: “$l”";
59 1         6 next;
60             };
61              
62 2         5 push @resp, $2, $1;
63             }
64              
65 1         7 return @resp;
66             }
67              
68             1;