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   186487 use strict;
  10         29  
  10         240  
4 10     10   42 use warnings;
  10         17  
  10         180  
5 10     10   907 use URI;
  10         7773  
  10         4607  
6              
7             # ABSTRACT: App container class for Test2::Tools::HTTP
8             our $VERSION = '0.10'; # VERSION
9              
10              
11             {
12             my $self;
13             sub new
14             {
15 106   100 106 1 5531 $self ||= bless {
16             psgi => {},
17             base_url => undef,
18             }, __PACKAGE__;
19             }
20             }
21              
22              
23             sub uri_key
24             {
25 156     156 1 265 my(undef, $uri) = @_;
26 156 100       403 $uri = URI->new($uri) unless ref $uri;
27 156         20093 join ':', map { $uri->$_ } qw( scheme host port );
  468         6061  
28             }
29              
30              
31             sub add_psgi
32             {
33 22     22 1 50 my($self, $uri, $app) = @_;
34 22         51 my $key = $self->uri_key($uri);
35 22         615 $self->{psgi}->{$key} = {
36             app => $app,
37             };
38             }
39              
40              
41             sub del_psgi
42             {
43 13     13 1 25 my($self, $uri) = @_;
44 13         26 my $key = $self->uri_key($uri);
45 13         338 delete $self->{psgi}->{$key};
46             }
47              
48              
49             sub base_url
50             {
51 179     179 1 280 my($self, $new) = @_;
52              
53 179 100       332 if($new)
54             {
55 3 50       17 $self->{base_url} = ref $new ? $new : URI->new($new);
56             }
57              
58 179 100       1243 unless(defined $self->{base_url})
59             {
60 6         31 $self->{base_url} = URI->new('http://localhost/');
61 6         20550 require IO::Socket::INET;
62 6         70436 $self->{base_url}->port(IO::Socket::INET->new(Listen => 5, LocalAddr => "127.0.0.1")->sockport);
63             }
64              
65 179         3310 $self->{base_url};
66             }
67              
68              
69             sub uri_to_app
70             {
71 84     84 1 555 my($self, $uri) = @_;
72 84         155 my $url = URI->new_abs($uri, $self->base_url);
73 84         7790 my $key = $self->uri_key($url);
74 84         2118 $self->{psgi}->{$key}->{app};
75             }
76              
77              
78             sub uri_to_tester
79             {
80 37     37 1 298 my($self, $uri) = @_;
81 37         76 my $url = URI->new_abs($uri, $self->base_url);
82 37         3067 my $key = $self->uri_key($url);
83 37         807 my $app = $self->{psgi}->{$key}->{app};
84 37 50       85 return unless $app;
85              
86 37   66     134 $self->{psgi}->{$key}->{tester} ||= do {
87 20         2292 require Plack::Test;
88 20         2666 Plack::Test->create($app);
89             };
90             }
91              
92             1;
93              
94             __END__