File Coverage

blib/lib/Net/ACME/HTTP/Response.pm
Criterion Covered Total %
statement 34 34 100.0
branch 4 4 100.0
condition 3 3 100.0
subroutine 9 9 100.0
pod 0 3 0.0
total 50 53 94.3


line stmt bran cond sub pod time code
1             package Net::ACME::HTTP::Response;
2              
3 8     8   84105 use strict;
  8         11  
  8         173  
4 8     8   26 use warnings;
  8         7  
  8         185  
5              
6 8     8   26 use parent qw( HTTP::Tiny::UA::Response );
  8         9  
  8         39  
7              
8 8     8   5405 use Call::Context ();
  8         934  
  8         98  
9 8     8   25 use JSON ();
  8         8  
  8         87  
10              
11 8     8   382 use Net::ACME::X ();
  8         12  
  8         1584  
12              
13             sub die_because_unexpected {
14 4     4 0 547 my ($self) = @_;
15              
16 4         85 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 10     10 0 8881 my ($self) = @_;
30              
31 10         190 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 8     8 0 1833 my ($self) = @_;
46              
47 8         32 Call::Context::must_be_list();
48              
49 8         131 my $links_ar = $self->header('link');
50 8 100       61 if ( !ref $links_ar ) {
51 5   100     20 $links_ar = [ $links_ar || () ];
52             }
53              
54 8         11 my @resp;
55              
56 8         19 for my $l (@$links_ar) {
57 8 100       42 $l =~ m/\A<([^>]+)>;rel="([^"]+)"\z/ or do {
58 1         19 warn "Unrecognized link: “$l”";
59 1         5 next;
60             };
61              
62 7         25 push @resp, $2, $1;
63             }
64              
65 8         81 return @resp;
66             }
67              
68             1;