Revision 80711e19
Von Sven Schöling vor mehr als 4 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
|
}
|
||
|
|
||
|
sub create_http_response {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my $self = shift;
|
||
|
my %params = @_;
|
||
|
|
||
|
my $session_cookie;
|
||
|
if (defined $main::auth) {
|
||
|
if (defined $::auth) {
|
||
|
my $uri = $self->_get_request_uri;
|
||
|
my @segments = $uri->path_segments;
|
||
|
pop @segments;
|
||
|
$uri->path_segments(@segments);
|
||
|
|
||
|
my $session_cookie_value = $main::auth->get_session_id();
|
||
|
|
||
|
if ($session_cookie_value) {
|
||
|
$session_cookie = $::request->cgi->cookie('-name' => $main::auth->get_session_cookie_name(),
|
||
|
'-value' => $session_cookie_value,
|
||
|
'-path' => $uri->path,
|
||
|
'-expires' => '+' . $::auth->{session_timeout} . 'm',
|
||
|
'-secure' => $::request->is_https);
|
||
|
if ($::auth->get_session_id) {
|
||
|
$::request->cgi->add_cookie(
|
||
|
$::auth->get_session_cookie_name,
|
||
|
$::auth->get_session_id,
|
||
|
path => $uri->path,
|
||
|
secure => $::request->is_https,
|
||
|
explires => '+' . $::auth->{session_timeout} . 'm',
|
||
|
);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
my %cgi_params = ('-type' => $params{content_type});
|
||
|
$cgi_params{'-charset'} = $params{charset} if ($params{charset});
|
||
|
$cgi_params{'-cookie'} = $session_cookie if ($session_cookie);
|
||
|
|
||
|
map { $cgi_params{'-' . $_} = $params{$_} if exists $params{$_} } qw(content_disposition content_length status);
|
||
|
|
||
|
my $output = $::request->cgi->header(%cgi_params);
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return $output;
|
||
|
$::request->cgi->header(%params);
|
||
|
}
|
||
|
|
||
|
sub header {
|
||
| ... | ... | |
|
}
|
||
|
|
||
|
sub ajax_response_header {
|
||
|
$main::lxdebug->enter_sub();
|
||
|
|
||
|
my ($self) = @_;
|
||
|
|
||
|
my $output = $::request->cgi->header('-charset' => 'UTF-8');
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
|
|
||
|
return $output;
|
||
|
$::request->cgi->header(charset => 'UTF-8');
|
||
|
}
|
||
|
|
||
|
sub redirect_header {
|
||
| ... | ... | |
|
die "Headers already sent" if $self->{header};
|
||
|
$self->{header} = 1;
|
||
|
|
||
|
return $::request->cgi->redirect($new_uri);
|
||
|
$::request->cgi->redirect($new_uri);
|
||
|
}
|
||
|
|
||
|
sub set_standard_title {
|
||
| ... | ... | |
|
seek IN, 0, 0;
|
||
|
|
||
|
} else {
|
||
|
my %headers = ('-type' => $mimeType,
|
||
|
'-connection' => 'close',
|
||
|
'-charset' => 'UTF-8');
|
||
|
my %headers = (content_type => $mimeType,
|
||
|
connection => 'close',
|
||
|
charset => 'UTF-8');
|
||
|
|
||
|
$self->{attachment_filename} ||= $self->generate_attachment_filename;
|
||
|
|
||
|
if ($self->{attachment_filename}) {
|
||
|
%headers = (
|
||
|
%headers,
|
||
|
'-attachment' => $self->{attachment_filename},
|
||
|
'-content-length' => $numbytes,
|
||
|
'-charset' => '',
|
||
|
attachment => $self->{attachment_filename},
|
||
|
content_length => $numbytes,
|
||
|
charset => '',
|
||
|
);
|
||
|
}
|
||
|
|
||
| SL/Request.pm | ||
|---|---|---|
|
|
||
|
use parent qw(Rose::Object);
|
||
|
|
||
|
use CGI qw(-no_xhtml);
|
||
|
use List::Util qw(first max min sum);
|
||
|
use List::MoreUtils qw(all any apply);
|
||
|
use Exporter qw(import);
|
||
| ... | ... | |
|
use SL::MoreCommon qw(uri_encode uri_decode);
|
||
|
use SL::Layout::None;
|
||
|
use SL::Presenter;
|
||
|
use SL::Response;
|
||
|
use SL::Util qw(trim);
|
||
|
|
||
|
our @EXPORT_OK = qw(flatten unflatten);
|
||
| ... | ... | |
|
);
|
||
|
|
||
|
sub init_cgi {
|
||
|
return CGI->new({});
|
||
|
return SL::Response->new;
|
||
|
}
|
||
|
|
||
|
sub init_layout {
|
||
| bin/mozilla/am.pl | ||
|---|---|---|
|
use SL::DB::Language;
|
||
|
use SL::DB::Default;
|
||
|
use SL::DBUtils qw(selectall_array_query conv_dateq);
|
||
|
use CGI;
|
||
|
|
||
|
require "bin/mozilla/common.pl";
|
||
|
|
||
| bin/mozilla/sepa.pl | ||
|---|---|---|
|
|
||
|
my $xml = $sepa_xml->to_xml();
|
||
|
|
||
|
print $::request->cgi->header('-type' => 'application/octet-stream',
|
||
|
'-content-disposition' => 'attachment; filename="SEPA_' . $message_id . ($vc eq 'customer' ? '.cdd' : '.cct') . '"',
|
||
|
'-content-length' => length $xml);
|
||
|
print $::request->cgi->header(
|
||
|
type => 'application/octet-stream',
|
||
|
attachment => "SEPA_${message_id}" . ($vc eq 'customer' ? '.cdd' : '.cct'),
|
||
|
content_length => length $xml,
|
||
|
);
|
||
|
print $xml;
|
||
|
|
||
|
$main::lxdebug->leave_sub();
|
||
Auch abrufbar als: Unified diff
Response in $::request->cgi benutzt und calls angepasst auf neue API