File Coverage

blib/lib/Test2/Tools/HTTP/Apps.pm
Criterion Covered Total %
statement 40 40 100.0
branch 8 10 80.0
condition 4 5 80.0
subroutine 10 10 100.0
pod 7 7 100.0
total 69 72 95.8


line stmt bran cond sub pod time code
1             package Test2::Tools::HTTP::Apps;
2              
3 10     10   189989 use strict;
  10         28  
  10         244  
4 10     10   44 use warnings;
  10         15  
  10         199  
5 10     10   897 use URI;
  10         7639  
  10         4671  
6              
7             # ABSTRACT: App container class for Test2::Tools::HTTP
8             our $VERSION = '0.11'; # VERSION
9              
10              
11             {
12             my $self;
13             sub new
14             {
15 106   100 106 1 6008 $self ||= bless {
16             psgi => {},
17             base_url => undef,
18             }, __PACKAGE__;
19             }
20             }
21              
22              
23             sub uri_key
24             {
25 156     156 1 272 my(undef, $uri) = @_;
26 156 100       396 $uri = URI->new($uri) unless ref $uri;
27 156         19802 join ':', map { $uri->$_ } qw( scheme host port );
  468         6063  
28             }
29              
30              
31             sub add_psgi
32             {
33 22     22 1 48 my($self, $uri, $app) = @_;
34 22         48 my $key = $self->uri_key($uri);
35 22         576 $self->{psgi}->{$key} = {
36             app => $app,
37             };
38             }
39              
40              
41             sub del_psgi
42             {
43 13     13 1 23 my($self, $uri) = @_;
44 13         22 my $key = $self->uri_key($uri);
45 13         325 delete $self->{psgi}->{$key};
46             }
47              
48              
49             sub base_url
50             {
51 179     179 1 269 my($self, $new) = @_;
52              
53 179 100       343 if($new)
54             {
55 3 50       15 $self->{base_url} = ref $new ? $new : URI->new($new);
56             }
57              
58 179 100       1827 unless(defined $self->{base_url})
59             {
60 6         32 $self->{base_url} = URI->new('http://localhost/');
61 6         21298 require IO::Socket::INET;
62 6         73314 $self->{base_url}->port(IO::Socket::INET->new(Listen => 5, LocalAddr => "127.0.0.1")->sockport);
63             }
64              
65 179         3441 $self->{base_url};
66             }
67              
68              
69             sub uri_to_app
70             {
71 84     84 1 600 my($self, $uri) = @_;
72 84         153 my $url = URI->new_abs($uri, $self->base_url);
73 84         8049 my $key = $self->uri_key($url);
74 84         2090 $self->{psgi}->{$key}->{app};
75             }
76              
77              
78             sub uri_to_tester
79             {
80 37     37 1 239 my($self, $uri) = @_;
81 37         70 my $url = URI->new_abs($uri, $self->base_url);
82 37         3062 my $key = $self->uri_key($url);
83 37         790 my $app = $self->{psgi}->{$key}->{app};
84 37 50       76 return unless $app;
85              
86 37   66     150 $self->{psgi}->{$key}->{tester} ||= do {
87 20         2342 require Plack::Test;
88 20         2681 Plack::Test->create($app);
89             };
90             }
91              
92             1;
93              
94             __END__