Revision 80711e19
Von Sven Schöling vor etwa 4 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
| 349 | 349 |
} |
| 350 | 350 |
|
| 351 | 351 |
sub create_http_response {
|
| 352 |
$main::lxdebug->enter_sub(); |
|
| 353 |
|
|
| 354 | 352 |
my $self = shift; |
| 355 | 353 |
my %params = @_; |
| 356 | 354 |
|
| 357 |
my $session_cookie; |
|
| 358 |
if (defined $main::auth) {
|
|
| 355 |
if (defined $::auth) {
|
|
| 359 | 356 |
my $uri = $self->_get_request_uri; |
| 360 | 357 |
my @segments = $uri->path_segments; |
| 361 | 358 |
pop @segments; |
| 362 | 359 |
$uri->path_segments(@segments); |
| 363 | 360 |
|
| 364 |
my $session_cookie_value = $main::auth->get_session_id();
|
|
| 365 |
|
|
| 366 |
if ($session_cookie_value) {
|
|
| 367 |
$session_cookie = $::request->cgi->cookie('-name' => $main::auth->get_session_cookie_name(),
|
|
| 368 |
'-value' => $session_cookie_value,
|
|
| 369 |
'-path' => $uri->path,
|
|
| 370 |
'-expires' => '+' . $::auth->{session_timeout} . 'm',
|
|
| 371 |
'-secure' => $::request->is_https);
|
|
| 361 |
if ($::auth->get_session_id) {
|
|
| 362 |
$::request->cgi->add_cookie( |
|
| 363 |
$::auth->get_session_cookie_name,
|
|
| 364 |
$::auth->get_session_id,
|
|
| 365 |
path => $uri->path,
|
|
| 366 |
secure => $::request->is_https,
|
|
| 367 |
explires => '+' . $::auth->{session_timeout} . 'm',
|
|
| 368 |
); |
|
| 372 | 369 |
} |
| 373 | 370 |
} |
| 374 | 371 |
|
| 375 |
my %cgi_params = ('-type' => $params{content_type});
|
|
| 376 |
$cgi_params{'-charset'} = $params{charset} if ($params{charset});
|
|
| 377 |
$cgi_params{'-cookie'} = $session_cookie if ($session_cookie);
|
|
| 378 |
|
|
| 379 |
map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length status);
|
|
| 380 |
|
|
| 381 |
my $output = $::request->cgi->header(%cgi_params); |
|
| 382 |
|
|
| 383 |
$main::lxdebug->leave_sub(); |
|
| 384 |
|
|
| 385 |
return $output; |
|
| 372 |
$::request->cgi->header(%params); |
|
| 386 | 373 |
} |
| 387 | 374 |
|
| 388 | 375 |
sub header {
|
| ... | ... | |
| 483 | 470 |
} |
| 484 | 471 |
|
| 485 | 472 |
sub ajax_response_header {
|
| 486 |
$main::lxdebug->enter_sub(); |
|
| 487 |
|
|
| 488 |
my ($self) = @_; |
|
| 489 |
|
|
| 490 |
my $output = $::request->cgi->header('-charset' => 'UTF-8');
|
|
| 491 |
|
|
| 492 |
$main::lxdebug->leave_sub(); |
|
| 493 |
|
|
| 494 |
return $output; |
|
| 473 |
$::request->cgi->header(charset => 'UTF-8'); |
|
| 495 | 474 |
} |
| 496 | 475 |
|
| 497 | 476 |
sub redirect_header {
|
| ... | ... | |
| 504 | 483 |
die "Headers already sent" if $self->{header};
|
| 505 | 484 |
$self->{header} = 1;
|
| 506 | 485 |
|
| 507 |
return $::request->cgi->redirect($new_uri);
|
|
| 486 |
$::request->cgi->redirect($new_uri); |
|
| 508 | 487 |
} |
| 509 | 488 |
|
| 510 | 489 |
sub set_standard_title {
|
| ... | ... | |
| 1088 | 1067 |
seek IN, 0, 0; |
| 1089 | 1068 |
|
| 1090 | 1069 |
} else {
|
| 1091 |
my %headers = ('-type' => $mimeType,
|
|
| 1092 |
'-connection' => 'close',
|
|
| 1093 |
'-charset' => 'UTF-8');
|
|
| 1070 |
my %headers = (content_type => $mimeType,
|
|
| 1071 |
connection => 'close',
|
|
| 1072 |
charset => 'UTF-8');
|
|
| 1094 | 1073 |
|
| 1095 | 1074 |
$self->{attachment_filename} ||= $self->generate_attachment_filename;
|
| 1096 | 1075 |
|
| 1097 | 1076 |
if ($self->{attachment_filename}) {
|
| 1098 | 1077 |
%headers = ( |
| 1099 | 1078 |
%headers, |
| 1100 |
'-attachment' => $self->{attachment_filename},
|
|
| 1101 |
'-content-length' => $numbytes,
|
|
| 1102 |
'-charset' => '',
|
|
| 1079 |
attachment => $self->{attachment_filename},
|
|
| 1080 |
content_length => $numbytes,
|
|
| 1081 |
charset => '',
|
|
| 1103 | 1082 |
); |
| 1104 | 1083 |
} |
| 1105 | 1084 |
|
| SL/Request.pm | ||
|---|---|---|
| 4 | 4 |
|
| 5 | 5 |
use parent qw(Rose::Object); |
| 6 | 6 |
|
| 7 |
use CGI qw(-no_xhtml); |
|
| 8 | 7 |
use List::Util qw(first max min sum); |
| 9 | 8 |
use List::MoreUtils qw(all any apply); |
| 10 | 9 |
use Exporter qw(import); |
| ... | ... | |
| 14 | 13 |
use SL::MoreCommon qw(uri_encode uri_decode); |
| 15 | 14 |
use SL::Layout::None; |
| 16 | 15 |
use SL::Presenter; |
| 16 |
use SL::Response; |
|
| 17 | 17 |
use SL::Util qw(trim); |
| 18 | 18 |
|
| 19 | 19 |
our @EXPORT_OK = qw(flatten unflatten); |
| ... | ... | |
| 25 | 25 |
); |
| 26 | 26 |
|
| 27 | 27 |
sub init_cgi {
|
| 28 |
return CGI->new({});
|
|
| 28 |
return SL::Response->new;
|
|
| 29 | 29 |
} |
| 30 | 30 |
|
| 31 | 31 |
sub init_layout {
|
| bin/mozilla/am.pl | ||
|---|---|---|
| 53 | 53 |
use SL::DB::Language; |
| 54 | 54 |
use SL::DB::Default; |
| 55 | 55 |
use SL::DBUtils qw(selectall_array_query conv_dateq); |
| 56 |
use CGI; |
|
| 57 | 56 |
|
| 58 | 57 |
require "bin/mozilla/common.pl"; |
| 59 | 58 |
|
| bin/mozilla/sepa.pl | ||
|---|---|---|
| 598 | 598 |
|
| 599 | 599 |
my $xml = $sepa_xml->to_xml(); |
| 600 | 600 |
|
| 601 |
print $::request->cgi->header('-type' => 'application/octet-stream',
|
|
| 602 |
'-content-disposition' => 'attachment; filename="SEPA_' . $message_id . ($vc eq 'customer' ? '.cdd' : '.cct') . '"', |
|
| 603 |
'-content-length' => length $xml); |
|
| 601 |
print $::request->cgi->header( |
|
| 602 |
type => 'application/octet-stream', |
|
| 603 |
attachment => "SEPA_${message_id}" . ($vc eq 'customer' ? '.cdd' : '.cct'),
|
|
| 604 |
content_length => length $xml, |
|
| 605 |
); |
|
| 604 | 606 |
print $xml; |
| 605 | 607 |
|
| 606 | 608 |
$main::lxdebug->leave_sub(); |
Auch abrufbar als: Unified diff
Response in $::request->cgi benutzt und calls angepasst auf neue API