File Coverage

blib/lib/PAGI/Middleware/Rewrite.pm
Criterion Covered Total %
statement 56 61 91.8
branch 12 16 75.0
condition 7 14 50.0
subroutine 9 9 100.0
pod 1 1 100.0
total 85 101 84.1


line stmt bran cond sub pod time code
1             package PAGI::Middleware::Rewrite;
2              
3 1     1   201696 use strict;
  1         2  
  1         33  
4 1     1   6 use warnings;
  1         5  
  1         41  
5 1     1   301 use parent 'PAGI::Middleware';
  1         307  
  1         6  
6 1     1   66 use Future::AsyncAwait;
  1         3  
  1         4  
7              
8             =head1 NAME
9              
10             PAGI::Middleware::Rewrite - URL rewriting middleware
11              
12             =head1 SYNOPSIS
13              
14             use PAGI::Middleware::Builder;
15              
16             my $app = builder {
17             enable 'Rewrite',
18             rules => [
19             { from => qr{^/old/(.*)}, to => '/new/$1' },
20             { from => '/legacy', to => '/modern' },
21             ];
22             $my_app;
23             };
24              
25             =head1 DESCRIPTION
26              
27             PAGI::Middleware::Rewrite rewrites request paths before passing to the
28             inner application. Supports both exact matches and regex patterns.
29              
30             =head1 CONFIGURATION
31              
32             =over 4
33              
34             =item * rules (required)
35              
36             Arrayref of rewrite rules. Each rule is a hashref with:
37              
38             { from => '/old-path', to => '/new-path' }
39             { from => qr{^/user/(\d+)}, to => '/users/$1' }
40              
41             =item * redirect (default: 0)
42              
43             If true, send redirect response instead of rewriting internally.
44              
45             =item * redirect_code (default: 301)
46              
47             HTTP status code for redirects.
48              
49             =back
50              
51             =cut
52              
53             sub _init {
54 4     4   7 my ($self, $config) = @_;
55              
56             $self->{rules} = $config->{rules}
57 4   50     13 // die "Rewrite middleware requires 'rules' option";
58 4   100     14 $self->{redirect} = $config->{redirect} // 0;
59 4   100     13 $self->{redirect_code} = $config->{redirect_code} // 301;
60             }
61              
62             sub wrap {
63 4     4 1 32 my ($self, $app) = @_;
64              
65 4     4   97 return async sub {
66 4         8 my ($scope, $receive, $send) = @_;
67 4 50       10 if ($scope->{type} ne 'http') {
68 0         0 await $app->($scope, $receive, $send);
69 0         0 return;
70             }
71              
72 4         13 my $path = $scope->{path};
73 4         10 my $new_path = $self->_apply_rules($path);
74              
75             # No rewrite needed
76 4 100       9 if ($new_path eq $path) {
77 1         3 await $app->($scope, $receive, $send);
78 1         86 return;
79             }
80              
81             # Redirect mode
82 3 100       6 if ($self->{redirect}) {
83 1         15 my $location = $new_path;
84 1 50 33     5 if (defined $scope->{query_string} && $scope->{query_string} ne '') {
85 0         0 $location .= '?' . $scope->{query_string};
86             }
87 1         3 await $self->_send_redirect($send, $location);
88 1         46 return;
89             }
90              
91             # Internal rewrite
92             my $new_scope = {
93             %$scope,
94             path => $new_path,
95 2   33     14 original_path => $scope->{original_path} // $path,
96             };
97              
98 2         7 await $app->($new_scope, $receive, $send);
99 4         15 };
100             }
101              
102             sub _apply_rules {
103 4     4   8 my ($self, $path) = @_;
104              
105 4         4 for my $rule (@{$self->{rules}}) {
  4         9  
106 4         6 my $from = $rule->{from};
107 4         6 my $to = $rule->{to};
108              
109 4 100       8 if (ref $from eq 'Regexp') {
110 1 50       8 if ($path =~ $from) {
111 1         4 my @captures = ($path =~ $from);
112 1         2 my $new_path = $to;
113 1         3 for my $i (0 .. $#captures) {
114 1         2 my $n = $i + 1;
115 1         18 $new_path =~ s/\$$n/$captures[$i]/g;
116             }
117 1         4 return $new_path;
118             }
119             } else {
120 3 100       7 if ($path eq $from) {
121 2         5 return $to;
122             }
123             # Also check prefix match for directory-like rules
124 1 50       23 if ($path =~ m{^\Q$from\E(/.*)?$}) {
125 0   0     0 my $suffix = $1 // '';
126 0         0 return $to . $suffix;
127             }
128             }
129             }
130              
131 1         3 return $path;
132             }
133              
134 1     1   2 async sub _send_redirect {
135 1         2 my ($self, $send, $location) = @_;
136              
137 1         2 my $status = $self->{redirect_code};
138 1         2 my $body = "Redirecting to $location";
139              
140 1         8 await $send->({
141             type => 'http.response.start',
142             status => $status,
143             headers => [
144             ['Content-Type', 'text/plain'],
145             ['Content-Length', length($body)],
146             ['Location', $location],
147             ],
148             });
149 1         43 await $send->({
150             type => 'http.response.body',
151             body => $body,
152             more => 0,
153             });
154             }
155              
156             1;
157              
158             __END__