Revision e6491c8e
Von Sven Schöling vor mehr als 3 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
| 313 | 313 |
$main::lxdebug->leave_sub(); |
| 314 | 314 |
} |
| 315 | 315 |
|
| 316 |
sub _get_request_uri {
|
|
| 317 |
my $self = shift; |
|
| 318 |
|
|
| 319 |
return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR};
|
|
| 320 |
return URI->new if !$ENV{REQUEST_URI}; # for testing
|
|
| 321 |
|
|
| 322 |
my $scheme = $::request->is_https ? 'https' : 'http'; |
|
| 323 |
my $port = $ENV{SERVER_PORT};
|
|
| 324 |
$port = undef if (($scheme eq 'http' ) && ($port == 80)) |
|
| 325 |
|| (($scheme eq 'https') && ($port == 443)); |
|
| 326 |
|
|
| 327 |
my $uri = URI->new("${scheme}://");
|
|
| 328 |
$uri->scheme($scheme); |
|
| 329 |
$uri->port($port); |
|
| 330 |
$uri->host($ENV{HTTP_HOST} || $ENV{SERVER_ADDR});
|
|
| 331 |
$uri->path_query($ENV{REQUEST_URI});
|
|
| 332 |
$uri->query('');
|
|
| 333 |
|
|
| 334 |
return $uri; |
|
| 335 |
} |
|
| 336 |
|
|
| 337 |
sub _add_to_request_uri {
|
|
| 338 |
my $self = shift; |
|
| 339 |
|
|
| 340 |
my $relative_new_path = shift; |
|
| 341 |
my $request_uri = shift || $self->_get_request_uri; |
|
| 342 |
my $relative_new_uri = URI->new($relative_new_path); |
|
| 343 |
my @request_segments = $request_uri->path_segments; |
|
| 344 |
|
|
| 345 |
my $new_uri = $request_uri->clone; |
|
| 346 |
$new_uri->path_segments(@request_segments[0..scalar(@request_segments) - 2], $relative_new_uri->path_segments); |
|
| 347 |
|
|
| 348 |
return $new_uri; |
|
| 349 |
} |
|
| 350 |
|
|
| 351 | 316 |
sub create_http_response {
|
| 352 | 317 |
my $self = shift; |
| 353 | 318 |
my %params = @_; |
| 354 | 319 |
|
| 355 | 320 |
if (defined $::auth) {
|
| 356 |
my $uri = $self->_get_request_uri;
|
|
| 321 |
my $uri = $::request->request_uri;
|
|
| 357 | 322 |
my @segments = $uri->path_segments; |
| 358 | 323 |
pop @segments; |
| 359 | 324 |
$uri->path_segments(@segments); |
| ... | ... | |
| 477 | 442 |
my $self = shift; |
| 478 | 443 |
my $new_url = shift; |
| 479 | 444 |
|
| 480 |
my $base_uri = $self->_get_request_uri;
|
|
| 445 |
my $base_uri = $::request->request_uri;
|
|
| 481 | 446 |
my $new_uri = URI->new_abs($new_url, $base_uri); |
| 482 | 447 |
|
| 483 | 448 |
die "Headers already sent" if $self->{header};
|
| SL/Request.pm | ||
|---|---|---|
| 7 | 7 |
use List::Util qw(first max min sum); |
| 8 | 8 |
use List::MoreUtils qw(all any apply); |
| 9 | 9 |
use Exporter qw(import); |
| 10 |
use URI; |
|
| 10 | 11 |
|
| 11 | 12 |
use SL::Common; |
| 12 | 13 |
use SL::JSON; |
| ... | ... | |
| 21 | 22 |
use Rose::Object::MakeMethods::Generic |
| 22 | 23 |
( |
| 23 | 24 |
scalar => [ qw(applying_database_upgrades post_data) ], |
| 24 |
'scalar --get_set_init' => [ qw(cgi layout presenter is_ajax type cookies) ], |
|
| 25 |
'scalar --get_set_init' => [ qw(cgi layout presenter is_ajax type cookies request_uri) ],
|
|
| 25 | 26 |
); |
| 26 | 27 |
|
| 27 | 28 |
sub init_cgi {
|
| ... | ... | |
| 399 | 400 |
return $target; |
| 400 | 401 |
} |
| 401 | 402 |
|
| 403 |
sub init_request_uri {
|
|
| 404 |
return URI->new($ENV{HTTP_REFERER})->canonical() if $ENV{HTTP_X_FORWARDED_FOR};
|
|
| 405 |
return URI->new if !$ENV{REQUEST_URI}; # for testing
|
|
| 406 |
|
|
| 407 |
my $scheme = $::request->is_https ? 'https' : 'http'; |
|
| 408 |
my $port = $ENV{SERVER_PORT};
|
|
| 409 |
$port = undef if (($scheme eq 'http' ) && ($port == 80)) |
|
| 410 |
|| (($scheme eq 'https') && ($port == 443)); |
|
| 411 |
|
|
| 412 |
my $uri = URI->new("${scheme}://");
|
|
| 413 |
$uri->scheme($scheme); |
|
| 414 |
$uri->port($port); |
|
| 415 |
$uri->host($ENV{HTTP_HOST} || $ENV{SERVER_ADDR});
|
|
| 416 |
$uri->path_query($ENV{REQUEST_URI});
|
|
| 417 |
$uri->query('');
|
|
| 418 |
|
|
| 419 |
return $uri; |
|
| 420 |
} |
|
| 421 |
|
|
| 402 | 422 |
1; |
| 403 | 423 |
|
| 404 | 424 |
__END__ |
Auch abrufbar als: Unified diff
Form::_get_request_uri nach SL::Request::request_uri verschoben.
Form::_add_to_request_uri ersatzlos gelöscht.