File Coverage

blib/lib/Web/Request/Role/AbsoluteUriFor.pm
Criterion Covered Total %
statement 23 23 100.0
branch 2 2 100.0
condition 4 5 80.0
subroutine 4 4 100.0
pod 1 1 100.0
total 34 35 97.1


line stmt bran cond sub pod time code
1             package Web::Request::Role::AbsoluteUriFor;
2              
3             # ABSTRACT: Construct an absolute URI honoring script_name
4              
5             our $VERSION = '1.004'; # VERSION
6              
7 1     1   3285 use 5.010;
  1         3  
8 1     1   5 use Moose::Role;
  1         2  
  1         7  
9 1     1   5148 use Plack::Response;
  1         7212  
  1         178  
10              
11             sub absolute_uri_for {
12 60     60 1 385977 my ( $self, $uri_for, $base_uri ) = @_;
13              
14 60         92 my $url;
15 60 100       144 if ( ref($uri_for) eq 'HASH' ) {
16 20         50 $url = $self->uri_for($uri_for);
17             }
18             else {
19 40         63 $url = $uri_for;
20             }
21              
22 60   100     2272 my $script_name = $self->script_name || '';
23 60   66     1757 $base_uri ||= $self->base_uri;
24              
25 60         16561 $base_uri=~s{/+$}{};
26 60         509 $script_name=~s{/+$}{};
27 60         125 $script_name=~s{^/+}{};
28 60         368 $base_uri=~s{/*$script_name/*$}{}g;
29 60         284 $url=~s{^/}{};
30 60         209 $url=~s{^/*$script_name/*}{};
31              
32 60         108 return join( '/', grep {$_ } $base_uri, $script_name, $url );
  180         411  
33             }
34              
35             1;
36              
37             __END__
38              
39             =pod
40              
41             =encoding UTF-8
42              
43             =head1 NAME
44              
45             Web::Request::Role::AbsoluteUriFor - Construct an absolute URI honoring script_name
46              
47             =head1 VERSION
48              
49             version 1.004
50              
51             =head1 SYNOPSIS
52              
53             # Create a request handler
54             package My::App::Request;
55             use Moose;
56             extends 'Web::Request';
57             with 'Web::Request::Role::AbsoluteUriFor';
58              
59             # Make sure your app uses your request handler, e.g. using OX:
60             package My::App::OX;
61             sub request_class {'My::App::Request'}
62              
63             # in some controller action:
64              
65             # redirect
66             $req->absolute_uri_for({ controller=>'foo', action=>'bar' });
67             # https://yoursite.com/mountpoint/foo/bar
68              
69             # don't use the base-uri from $req by passing an explit additional value
70             $req->absolute_uri_for({ controller=>'foo', action=>'bar' }, 'https://example.com');
71             # https://example.com/mountpoint/foo/bar
72              
73             =head1 DESCRIPTION
74              
75             C<Web::Request::Role::AbsoluteUriFor> provides a method to calculate the absolute URI of a given controller/action, including the host name and handling various issues with C<SCRIPTNAME> and reverse proxies.
76              
77             =head2 METHODS
78              
79             =head3 absolute_uri_for
80              
81             $req->absolute_uri_for( '/some/path' );
82             $req->absolute_uri_for( $ref_uri_for );
83             $req->absolute_uri_for( '/some/path', $base-url );
84              
85             Construct an absolute URI out of C<base_uri>, C<script_name> and the
86             passed in string. You can also pass a ref, which will be resolved by
87             calling C<uri_for> on the request object.
88              
89             If you pass a second argument, this value will be used as the base-uri
90             instead of extracting it from the request. This can make sense when
91             you for exampel host a white lable service and need to generate
92             different links based on some value inside your app.
93              
94             =head1 THANKS
95              
96             Thanks to
97              
98             =over
99              
100             =item *
101              
102             L<validad.com|https://www.validad.com/> for supporting Open Source.
103              
104             =back
105              
106             =head1 AUTHOR
107              
108             Thomas Klausner <domm@plix.at>
109              
110             =head1 COPYRIGHT AND LICENSE
111              
112             This software is copyright (c) 2017 - 2021 by Thomas Klausner.
113              
114             This is free software; you can redistribute it and/or modify it under
115             the same terms as the Perl 5 programming language system itself.
116              
117             =cut