File Coverage

blib/lib/Plack/App/Hostname.pm
Criterion Covered Total %
statement 54 55 98.1
branch 9 12 75.0
condition 10 14 71.4
subroutine 10 10 100.0
pod 5 5 100.0
total 88 96 91.6


line stmt bran cond sub pod time code
1 1     1   14723 use 5.006;
  1         3  
  1         30  
2 1     1   4 use strict;
  1         1  
  1         37  
3 1     1   3 use warnings;
  1         2  
  1         52  
4              
5             package Plack::App::Hostname;
6             $Plack::App::Hostname::VERSION = '1.000';
7             # ABSTRACT: Run multiple apps dispatched by the request Host header
8              
9 1     1   446 use parent 'Plack::Component';
  1         281  
  1         4  
10 1     1   10846 use Plack::Util::Accessor qw( custom_matcher missing_header_app default_app );
  1         190  
  1         6  
11              
12             sub map_hosts_to {
13 5     5 1 1474 my $self = shift;
14 5         8 my $app = shift;
15 5         12 @{ $self->{'_app_for_host'} }{ map { lc } @_ } = ( $app ) x @_;
  5         69  
  10         18  
16 5         13 $self->{'_num_wildcards'} += grep { /\A\*\*\./ } @_;
  10         18  
17 5         15 return $self;
18             }
19              
20             sub unmap_host {
21 2     2 1 810 my $self = shift;
22 2         6 delete @{ $self->{'_app_for_host'} }{ map { lc } @_ };
  2         10  
  4         9  
23 2         6 $self->{'_num_wildcards'} -= grep { /\A\*\*\./ } @_;
  4         9  
24 2         4 return $self;
25             }
26              
27             sub unmap_app {
28 1     1 1 402 my $self = shift;
29 1   50     5 my $map = $self->{'_app_for_host'} ||= {};
30 1         6 while ( my ( $host, $host_app ) = each %$map ) {
31 6 50       7 next if not grep { $host_app == $_ } @_;
  6         13  
32 6         5 delete $map->{ $host };
33 6 50       18 --$self->{'_num_wildcards'} if $host =~ /\A\*\*\./;
34             }
35 1         3 return $self;
36             }
37              
38             sub matching {
39 20     20 1 19 my $self = shift;
40 20         22 my $host = lc $_[0];
41              
42 20         28 my $map = $self->{'_app_for_host'};
43              
44 20   66     94 return $_ for $map->{ $host } || ();
45              
46 10 100       24 if ( $self->{'_num_wildcards'} ) {
47 3         10 my @part = split /\./, $host, 16;
48 3         8 for my $pattern ( map { shift @part; join '.', '**', @part } 1 .. $#part ) {
  7         6  
  7         27  
49 4   66     19 return $_ for $map->{ $pattern } || ();
50             }
51             }
52              
53 8 50       22 return undef unless my $cb = $self->custom_matcher;
54              
55 0         0 return scalar $cb->() for $host;
56             }
57              
58             our $sadtrombone = [
59             400,
60             [qw( Content-Type text/html )],
61             ['Bad Request

Bad Request

Unknown host or domain'],

62             ];
63              
64             sub call {
65 23     23 1 39361 my $self = shift;
66 23         31 my ( $env ) = @_;
67              
68 23         27 my $host = $env->{'HTTP_HOST'};
69              
70             my $app = defined $host
71 23 100 100     47 ? $self->matching( map { s/:$env->{'SERVER_PORT'}\z//; $_ } $host ) || $self->default_app
72             : $self->missing_header_app;
73              
74 23 100 66     176 return 'CODE' eq ref $app ? &$app : $app || $sadtrombone;
75             }
76              
77             1;
78              
79             __END__