File Coverage

blib/lib/Plack/App/Hostname.pm
Criterion Covered Total %
statement 53 54 98.1
branch 9 12 75.0
condition 10 14 71.4
subroutine 10 10 100.0
pod 5 5 100.0
total 87 95 91.5


line stmt bran cond sub pod time code
1 1     1   13495 use 5.006;
  1         3  
2 1     1   3 use strict;
  1         2  
  1         18  
3 1     1   3 use warnings;
  1         4  
  1         46  
4              
5             package Plack::App::Hostname;
6             $Plack::App::Hostname::VERSION = '1.001';
7             # ABSTRACT: Run multiple apps dispatched by the request Host header
8              
9 1     1   415 use parent 'Plack::Component';
  1         251  
  1         4  
10 1     1   10942 use Plack::Util::Accessor qw( custom_matcher missing_header_app default_app );
  1         273  
  1         5  
11              
12             sub map_hosts_to {
13 5     5 1 1244 my $self = shift;
14 5         5 my $app = shift;
15 5         10 @{ $self->{'_app_for_host'} }{ map { lc } @_ } = ( $app ) x @_;
  5         41  
  10         14  
16 5         11 $self->{'_num_wildcards'} += grep { /\A\*\*\./ } @_;
  10         14  
17 5         8 return $self;
18             }
19              
20             sub unmap_host {
21 2     2 1 768 my $self = shift;
22 2         4 delete @{ $self->{'_app_for_host'} }{ map { lc } @_ };
  2         9  
  4         7  
23 2         2 $self->{'_num_wildcards'} -= grep { /\A\*\*\./ } @_;
  4         8  
24 2         4 return $self;
25             }
26              
27             sub unmap_app {
28 1     1 1 341 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         10  
32 6         6 delete $map->{ $host };
33 6 50       18 --$self->{'_num_wildcards'} if $host =~ /\A\*\*\./;
34             }
35 1         2 return $self;
36             }
37              
38             sub matching {
39 20     20 1 16 my $self = shift;
40 20         25 my $host = lc $_[0];
41              
42 20         26 my $map = $self->{'_app_for_host'};
43              
44 20   66     93 return $_ for $map->{ $host } || ();
45              
46 10 100       20 if ( $self->{'_num_wildcards'} ) {
47 3         10 my @part = split /\./, $host, 16;
48 3         4 for my $pattern ( map { shift @part; join '.', '**', @part } 1 .. $#part ) {
  7         6  
  7         14  
49 4   66     17 return $_ for $map->{ $pattern } || ();
50             }
51             }
52              
53 8 50       19 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 31271 my $self = shift;
66 23         24 my ( $env ) = @_;
67              
68 23         26 my $host = $env->{'HTTP_HOST'};
69              
70 23 100 100     114 my $app = defined $host
71             ? ( $host =~ s/:$env->{'SERVER_PORT'}\z//, $self->matching( $host ) || $self->default_app )
72             : $self->missing_header_app;
73              
74 23 100 66     170 return 'CODE' eq ref $app ? &$app : $app || $sadtrombone;
75             }
76              
77             1;