Merge branch 'WebGUI8' of github.com:plainblack/webgui into 8
Conflicts: lib/WebGUI.pm lib/WebGUI/Auth/WebGUI.pm sbin/findBrokenAssets.pl sbin/testEnvironment.pl
This commit is contained in:
Doug Bell
commit
677ac978b6
89 changed files with 1064 additions and 448 deletions
|
|
@ -33,6 +33,9 @@ Package WebGUI::Session::Http
|
|||
|
||||
This package allows the manipulation of HTTP protocol information.
|
||||
|
||||
*** This module is deprecated in favor of L<WebGUI::Session::Request> and
|
||||
L<WebGUI::Session::Response>.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use WebGUI::Session::Http;
|
||||
|
|
@ -53,89 +56,6 @@ These methods are available from this package:
|
|||
|
||||
=cut
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getCacheControl ( )
|
||||
|
||||
Returns the cache control setting from this object.
|
||||
|
||||
=cut
|
||||
|
||||
sub getCacheControl {
|
||||
my $self = shift;
|
||||
return $self->{_http}{cacheControl} || 1;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getCookies ( )
|
||||
|
||||
Retrieves the cookies from the HTTP header and returns a hash reference containing them.
|
||||
|
||||
=cut
|
||||
|
||||
sub getCookies {
|
||||
my $self = shift;
|
||||
_deprecated('Request::cookies');
|
||||
return $self->session->request->cookies;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getLastModified ( )
|
||||
|
||||
Returns the stored epoch date when the page as last modified.
|
||||
|
||||
=cut
|
||||
|
||||
sub getLastModified {
|
||||
my $self = shift;
|
||||
return $self->{_http}{lastModified};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getNoHeader ( )
|
||||
|
||||
Returns whether or not a HTTP header will be printed.
|
||||
|
||||
=cut
|
||||
|
||||
sub getNoHeader {
|
||||
my $self = shift;
|
||||
return $self->{_http}{noHeader};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getStreamedFile ( ) {
|
||||
|
||||
Returns the location of a file to be streamed thru mod_perl, if one has been set.
|
||||
|
||||
=cut
|
||||
|
||||
sub getStreamedFile {
|
||||
my $self = shift;
|
||||
return $self->{_http}{streamlocation} || undef;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 isRedirect ( )
|
||||
|
||||
Returns a boolean value indicating whether the current page will redirect to some other location.
|
||||
|
||||
=cut
|
||||
|
||||
sub isRedirect {
|
||||
my $self = shift;
|
||||
my $status = $self->session->response->status;
|
||||
return $status == 302 || $status == 301;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 new ( session )
|
||||
|
|
@ -156,76 +76,6 @@ sub new {
|
|||
return $self;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 sendHeader ( )
|
||||
|
||||
Generates and sends HTTP headers for a response.
|
||||
|
||||
=cut
|
||||
|
||||
sub sendHeader {
|
||||
my $self = shift;
|
||||
return undef if ($self->{_http}{noHeader});
|
||||
return $self->_sendMinimalHeader unless defined $self->session->db(1);
|
||||
|
||||
my $session = $self->session;
|
||||
my ($request, $response, $config) = $session->quick(qw(request response config ));
|
||||
return undef unless $request;
|
||||
my $userId = $session->get("userId");
|
||||
|
||||
# send webgui session cookie
|
||||
my $cookieName = $config->getCookieName;
|
||||
$self->setCookie($cookieName, $session->getId, $config->getCookieTTL, $config->get("cookieDomain")) unless $session->getId eq $request->cookies->{$cookieName};
|
||||
|
||||
$self->setNoHeader(1);
|
||||
my %params;
|
||||
if (!$self->isRedirect()) {
|
||||
my $cacheControl = $self->getCacheControl;
|
||||
my $date = ($userId eq "1") ? HTTP::Date::time2str($self->getLastModified) : HTTP::Date::time2str();
|
||||
# under these circumstances, don't allow caching
|
||||
if ($userId ne "1" || $cacheControl eq "none" || $self->session->setting->get("preventProxyCache")) {
|
||||
$response->header(
|
||||
"Cache-Control" => "private, max-age=1",
|
||||
"Pragma" => "no-cache",
|
||||
"Cache-Control" => "no-cache",
|
||||
);
|
||||
}
|
||||
# in all other cases, set cache, but tell it to ask us every time so we don't mess with recently logged in users
|
||||
else {
|
||||
if ( $cacheControl eq "none" ) {
|
||||
$response->header("Cache-Control" => "private, max-age=1");
|
||||
}
|
||||
else {
|
||||
$response->header(
|
||||
'Last-Modified' => $date,
|
||||
'Cache-Control' => "must-revalidate, max-age=" . $cacheControl,
|
||||
);
|
||||
}
|
||||
# do an extra incantation if the HTTP protocol is really old
|
||||
if ($request->protocol =~ /(\d\.\d)/ && $1 < 1.1) {
|
||||
my $date = HTTP::Date::time2str(time() + $cacheControl);
|
||||
$response->header( 'Expires' => $date );
|
||||
}
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub _sendMinimalHeader {
|
||||
my $self = shift;
|
||||
my $response = $self->session->response;
|
||||
$response->content_type('text/html; charset=UTF-8');
|
||||
$response->header(
|
||||
'Cache-Control' => 'private',
|
||||
"Pragma" => "no-cache",
|
||||
"Cache-Control" => "no-cache",
|
||||
);
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 session ( )
|
||||
|
|
@ -239,6 +89,106 @@ sub session {
|
|||
return $self->{_session};
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getCacheControl ( )
|
||||
|
||||
Returns the cache control setting from this object.
|
||||
|
||||
=cut
|
||||
|
||||
sub getCacheControl {
|
||||
my $self = shift;
|
||||
return $self->session->response->getCacheControl;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getCookies ( )
|
||||
|
||||
Retrieves the cookies from the HTTP header and returns a hash reference containing them.
|
||||
|
||||
=cut
|
||||
|
||||
sub getCookies {
|
||||
my $self = shift;
|
||||
_deprecated('Session::Request::cookies');
|
||||
return $self->session->request->cookies;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getLastModified ( )
|
||||
|
||||
Returns the stored epoch date when the page as last modified.
|
||||
|
||||
=cut
|
||||
|
||||
sub getLastModified {
|
||||
my $self = shift;
|
||||
return $self->session->response->getLastModified;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getNoHeader ( )
|
||||
|
||||
Returns whether or not a HTTP header will be printed.
|
||||
|
||||
=cut
|
||||
|
||||
sub getNoHeader {
|
||||
my $self = shift;
|
||||
return $self->session->response->getNoHeader;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getStreamedFile ( ) {
|
||||
|
||||
Returns the location of a file to be streamed thru mod_perl, if one has been set.
|
||||
|
||||
=cut
|
||||
|
||||
sub getStreamedFile {
|
||||
my $self = shift;
|
||||
_deprecated('Session::Response::getStreamedFile');
|
||||
return $self->session->response->getStreamedFile;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 isRedirect ( )
|
||||
|
||||
Returns a boolean value indicating whether the current page will redirect to some other location.
|
||||
|
||||
=cut
|
||||
|
||||
sub isRedirect {
|
||||
my $self = shift;
|
||||
_deprecated('Session::Response::isRedirect');
|
||||
return $self->session->response->isRedirect;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head3 sendHeader
|
||||
|
||||
Moved to L<WebGUI::Session::Response>.
|
||||
|
||||
=cut
|
||||
|
||||
sub sendHeader {
|
||||
my $self = shift;
|
||||
_deprecated('Session::Response::sendHeader');
|
||||
$self->session->response->sendHeader(@_);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 setCacheControl ( timeout )
|
||||
|
|
@ -253,49 +203,20 @@ Either the number of seconds until the cache expires, or the word "none" to disa
|
|||
|
||||
sub setCacheControl {
|
||||
my $self = shift;
|
||||
my $timeout = shift;
|
||||
$self->{_http}{cacheControl} = $timeout;
|
||||
_deprecated('Session::Response::setCacheControl');
|
||||
$self->session->response->setCacheControl(@_);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 setCookie ( name, value [ , timeToLive, domain ] )
|
||||
|
||||
Sends a cookie to the browser.
|
||||
|
||||
=head3 name
|
||||
|
||||
The name of the cookie to set. Must be unique from all other cookies from this domain or it will overwrite that cookie.
|
||||
|
||||
=head3 value
|
||||
|
||||
The value to set.
|
||||
|
||||
=head3 timeToLive
|
||||
|
||||
The time that the cookie should remain in the browser. Defaults to "+10y" (10 years from now).
|
||||
This may be "session" to indicate that the cookie is for the current browser session only.
|
||||
|
||||
=head3 domain
|
||||
|
||||
Explicitly set the domain for this cookie.
|
||||
|
||||
=cut
|
||||
Moved to L<WebGUI::Session::Response>.
|
||||
|
||||
sub setCookie {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $value = shift;
|
||||
my $ttl = shift;
|
||||
my $domain = shift;
|
||||
$ttl = (defined $ttl ? $ttl : '+10y');
|
||||
|
||||
$self->session->response->cookies->{$name} = {
|
||||
value => $value,
|
||||
path => '/',
|
||||
expires => $ttl ne 'session' ? $ttl : undef,
|
||||
domain => $domain,
|
||||
};
|
||||
_deprecated('Session::Request');
|
||||
$self->session->response->setCookie(@_);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -311,8 +232,8 @@ The epoch date when the page was last modified.
|
|||
|
||||
sub setLastModified {
|
||||
my $self = shift;
|
||||
my $epoch = shift;
|
||||
$self->{_http}{lastModified} = $epoch;
|
||||
_deprecated('Session::Response::setLastModified');
|
||||
$self->session->response->setLastModified(@_);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
|
@ -330,36 +251,22 @@ Any value other than 0 will disable header printing.
|
|||
|
||||
sub setNoHeader {
|
||||
my $self = shift;
|
||||
$self->{_http}{noHeader} = shift;
|
||||
_deprecated('Session::Response::setNoHeader');
|
||||
$self->session->response->setNoHeader(@_);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 setRedirect ( url, [ type ] )
|
||||
|
||||
Sets the necessary information in the HTTP header to redirect to another URL.
|
||||
|
||||
=head3 url
|
||||
|
||||
The URL to redirect to. To prevent infinite loops, no redirect will be set if
|
||||
url is the same as the current page, as found through $session->url->page.
|
||||
|
||||
=head3 type
|
||||
|
||||
Defaults to 302 (temporary redirect), but you can optionally set 301 (permanent redirect).
|
||||
Moved to L<WebGUI::Session::Response>.
|
||||
|
||||
=cut
|
||||
|
||||
sub setRedirect {
|
||||
my $self = shift;
|
||||
my $url = shift;
|
||||
my $type = shift || 302;
|
||||
my @params = $self->session->form->param;
|
||||
return undef if ($url eq $self->session->url->page() && scalar(@params) < 1); # prevent redirecting to self
|
||||
$self->session->log->info("Redirecting to $url");
|
||||
$self->session->response->location($url);
|
||||
$self->session->response->status($type);
|
||||
$self->session->style->setMeta({"http-equiv"=>"refresh",content=>"0; URL=".$url});
|
||||
_deprecated('Session::Response');
|
||||
$self->session->response->setRedirect(@_);
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -373,7 +280,8 @@ Set a file to be streamed thru mod_perl.
|
|||
|
||||
sub setStreamedFile {
|
||||
my $self = shift;
|
||||
$self->{_http}{streamlocation} = shift;
|
||||
_deprecated('Session::Response');
|
||||
$self->session->response->setStreamedFile(@_);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,14 @@
|
|||
package WebGUI::Session::Response;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use parent qw(Plack::Response);
|
||||
|
||||
use IO::File::WithPath;
|
||||
use Class::C3;
|
||||
use LWP::MediaTypes;
|
||||
|
||||
use Plack::Util::Accessor qw(session streaming writer streamer);
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
|
@ -18,6 +25,10 @@ is created.
|
|||
|
||||
=cut
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 stream
|
||||
|
||||
=cut
|
||||
|
|
@ -28,6 +39,10 @@ sub stream {
|
|||
$self->streaming(1);
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 stream_write
|
||||
|
||||
=cut
|
||||
|
|
@ -41,4 +56,385 @@ sub stream_write {
|
|||
$self->writer->write(@_);
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 sendHeader ( )
|
||||
|
||||
Generates and sends HTTP headers for a response.
|
||||
|
||||
=cut
|
||||
|
||||
sub sendHeader {
|
||||
my $self = shift;
|
||||
return undef if $self->{_http}{noHeader};
|
||||
return $self->_sendMinimalHeader unless defined $self->session->db(1);
|
||||
|
||||
no warnings 'uninitialized';
|
||||
|
||||
my $session = $self->session;
|
||||
my ($request, $config) = $session->quick(qw(request config ));
|
||||
return undef unless $request;
|
||||
my $userId = $session->get("userId");
|
||||
|
||||
# send webgui session cookie
|
||||
my $cookieName = $config->getCookieName;
|
||||
$self->setCookie($cookieName, $session->getId, $config->getCookieTTL, $config->get("cookieDomain")) unless $session->getId eq $request->cookies->{$cookieName};
|
||||
|
||||
$self->setNoHeader(1);
|
||||
my %params;
|
||||
if (!$self->isRedirect()) {
|
||||
my $cacheControl = $self->getCacheControl;
|
||||
my $date = ($userId eq "1") ? HTTP::Date::time2str($self->getLastModified) : HTTP::Date::time2str();
|
||||
# under these circumstances, don't allow caching
|
||||
if ($userId ne "1" || $cacheControl eq "none" || $self->session->setting->get("preventProxyCache")) {
|
||||
$self->header(
|
||||
"Cache-Control" => "private, max-age=1",
|
||||
"Pragma" => "no-cache",
|
||||
"Cache-Control" => "no-cache",
|
||||
);
|
||||
}
|
||||
# in all other cases, set cache, but tell it to ask us every time so we don't mess with recently logged in users
|
||||
else {
|
||||
if ( $cacheControl eq "none" ) {
|
||||
$self->header("Cache-Control" => "private, max-age=1");
|
||||
}
|
||||
else {
|
||||
$self->header(
|
||||
'Last-Modified' => $date,
|
||||
'Cache-Control' => "must-revalidate, max-age=" . $cacheControl,
|
||||
);
|
||||
}
|
||||
# do an extra incantation if the HTTP protocol is really old
|
||||
if ($request->protocol =~ /(\d\.\d)/ && $1 < 1.1) {
|
||||
my $date = HTTP::Date::time2str(time() + $cacheControl);
|
||||
$self->header( 'Expires' => $date );
|
||||
}
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub _sendMinimalHeader {
|
||||
my $self = shift;
|
||||
$self->content_type('text/html; charset=UTF-8');
|
||||
$self->header(
|
||||
'Cache-Control' => 'private',
|
||||
"Pragma" => "no-cache",
|
||||
"Cache-Control" => "no-cache",
|
||||
);
|
||||
return undef;
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 setCookie ( name, value [ , timeToLive, domain ] )
|
||||
|
||||
Sends a cookie to the browser.
|
||||
|
||||
=head3 name
|
||||
|
||||
The name of the cookie to set. Must be unique from all other cookies from this domain or it will overwrite that cookie.
|
||||
|
||||
=head3 value
|
||||
|
||||
The value to set.
|
||||
|
||||
=head3 timeToLive
|
||||
|
||||
The time that the cookie should remain in the browser. Defaults to "+10y" (10 years from now).
|
||||
This may be "session" to indicate that the cookie is for the current browser session only.
|
||||
|
||||
=head3 domain
|
||||
|
||||
Explicitly set the domain for this cookie.
|
||||
|
||||
=cut
|
||||
|
||||
sub setCookie {
|
||||
my $self = shift;
|
||||
my $name = shift;
|
||||
my $value = shift;
|
||||
my $ttl = shift;
|
||||
my $domain = shift;
|
||||
$ttl = (defined $ttl ? $ttl : '+10y');
|
||||
|
||||
$self->cookies->{$name} = {
|
||||
value => $value,
|
||||
path => '/',
|
||||
expires => $ttl ne 'session' ? $ttl : undef,
|
||||
domain => $domain,
|
||||
};
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 setRedirect ( url, [ type ] )
|
||||
|
||||
Sets the necessary information in the HTTP header to redirect to another URL.
|
||||
|
||||
=head3 url
|
||||
|
||||
The URL to redirect to. To prevent infinite loops, no redirect will be set if
|
||||
url is the same as the current page, as found through $session->url->page.
|
||||
|
||||
=head3 type
|
||||
|
||||
Defaults to 302 (temporary redirect), but you can optionally set 301 (permanent redirect).
|
||||
|
||||
=cut
|
||||
|
||||
sub setRedirect {
|
||||
my $self = shift;
|
||||
my $url = shift || '';
|
||||
my $type = shift || 302;
|
||||
my @params = $self->session->form->param;
|
||||
return undef if ($url eq $self->session->url->page() && scalar(@params) < 1); # prevent redirecting to self
|
||||
$self->session->log->info("Redirecting to $url");
|
||||
$self->location($url);
|
||||
$self->status($type);
|
||||
$self->session->style->setMeta({"http-equiv"=>"refresh",content=>"0; URL=".$url});
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 getLastModified ( )
|
||||
|
||||
Returns the stored epoch date when the page as last modified.
|
||||
|
||||
=cut
|
||||
|
||||
sub getLastModified {
|
||||
my $self = shift;
|
||||
return $self->{_http}{lastModified};
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 setLastModified ( epoch )
|
||||
|
||||
=head3 epoch
|
||||
|
||||
The epoch date when the page was last modified.
|
||||
|
||||
=cut
|
||||
|
||||
sub setLastModified {
|
||||
my $self = shift;
|
||||
my $epoch = shift;
|
||||
$self->{_http}{lastModified} = $epoch;
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 getNoHeader ( )
|
||||
|
||||
Returns whether or not a HTTP header will be printed.
|
||||
|
||||
=cut
|
||||
|
||||
sub getNoHeader {
|
||||
my $self = shift;
|
||||
return $self->{_http}{noHeader};
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 setNoHeader ( boolean )
|
||||
|
||||
Disables the printing of a HTTP header. Useful in situations when content is not
|
||||
returned to a browser (export to disk for example).
|
||||
|
||||
=head3 boolean
|
||||
|
||||
Any value other than 0 will disable header printing.
|
||||
|
||||
=cut
|
||||
|
||||
sub setNoHeader {
|
||||
my $self = shift;
|
||||
$self->{_http}{noHeader} = shift;
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 isRedirect ( )
|
||||
|
||||
Returns a boolean value indicating whether the current page will redirect to some other location.
|
||||
|
||||
=cut
|
||||
|
||||
sub isRedirect {
|
||||
my $self = shift;
|
||||
my $status = $self->status;
|
||||
return $status == 302 || $status == 301;
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 getStreamedFile ( ) {
|
||||
|
||||
Returns the location of a file to be streamed thru mod_perl, if one has been set.
|
||||
|
||||
=cut
|
||||
|
||||
sub getStreamedFile {
|
||||
my $self = shift;
|
||||
return $self->{_http}{streamlocation} || undef;
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 setStreamedFile ( ) {
|
||||
|
||||
Set a file to be streamed through mod_perl.
|
||||
Rrequires that C<enableStreamingUploads> be set in the config file and then
|
||||
some middleware or reverse-proxy in front of L<WebGUI> to catch the X-Sendfile
|
||||
headers and replace that with the file to be sent.
|
||||
|
||||
=cut
|
||||
|
||||
sub setStreamedFile {
|
||||
my $self = shift;
|
||||
my $fn = shift;
|
||||
|
||||
if( ! defined $fn or ! length $fn ) {
|
||||
# t/Session/Http.t tests that it can call this with '' as an arg
|
||||
# really, it looks like it is testing implementation rather than behavior but I don't know what behavior it's getting at so, voodoo
|
||||
$self->body(undef);
|
||||
$self->{_http}{streamlocation} = undef;
|
||||
return;
|
||||
}
|
||||
|
||||
$self->{_http}{streamlocation} = $fn;
|
||||
|
||||
# return undef unless $self->session->config->get('enableStreamingUploads'); # throw an error? handle gracefully? XX
|
||||
|
||||
my $fh = eval { IO::File::WithPath->new( $fn ) } or WebGUI::Error::InvalidFile->throw(
|
||||
error => "Couldn't create an IO::File::WithPath object: $@ $!",
|
||||
brokenFile => $fn,
|
||||
);
|
||||
|
||||
$self->body( $fh );
|
||||
|
||||
1;
|
||||
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 sendFile ( ) {
|
||||
|
||||
Either redirect (C<setRedirect()>) or trigger a stream (C<setStreamedFile()>) depending on how L<WebGUI> is configured.
|
||||
If C<enableStreamingUploads> is set in the config file, C<setStreamedFile()> is used.
|
||||
|
||||
=cut
|
||||
|
||||
# $session->response->sendFile($self->getStorageLocation, $self->filename);
|
||||
|
||||
|
||||
sub sendFile {
|
||||
my $self = shift;
|
||||
my $storage = shift;
|
||||
my $filename = shift;
|
||||
if( $self->session->config->get('enableStreamingUploads') ) {
|
||||
$self->setStreamedFile( $storage->getPath($filename) );
|
||||
}
|
||||
else {
|
||||
$self->setRedirect( $storage->getUrl($filename) );
|
||||
}
|
||||
1;
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 setCacheControl ( timeout )
|
||||
|
||||
Sets the cache control headers.
|
||||
|
||||
=head3 timeout
|
||||
|
||||
Either the number of seconds until the cache expires, or the word "none" to disable cache completely for this request.
|
||||
|
||||
=cut
|
||||
|
||||
sub setCacheControl {
|
||||
my $self = shift;
|
||||
my $timeout = shift;
|
||||
$self->{_http}{cacheControl} = $timeout;
|
||||
}
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
=head2 getCacheControl ( )
|
||||
|
||||
Returns the cache control setting from this object.
|
||||
|
||||
=cut
|
||||
|
||||
sub getCacheControl {
|
||||
my $self = shift;
|
||||
return $self->{_http}{cacheControl} || 1;
|
||||
}
|
||||
|
||||
=head2 finalize ( )
|
||||
|
||||
Subclasses Plack::Response C<finalize()>, doing L<WebGUI> specific finalization chores.
|
||||
|
||||
=cut
|
||||
|
||||
#
|
||||
#
|
||||
#
|
||||
|
||||
sub finalize {
|
||||
|
||||
my $self = shift;
|
||||
|
||||
my $filename = $self->getStreamedFile();
|
||||
if (defined $filename and $self->session->config->get("enableStreamingUploads") ) {
|
||||
# at this point, $request->body contains an IO::File::WithPath object, and that's all Plack needs
|
||||
my $ct = LWP::MediaTypes::guess_media_type($filename);
|
||||
$self->content_type($ct);
|
||||
}
|
||||
|
||||
# in the future, sendHeader's logic should be moved into here and sendHeader should vanish.
|
||||
# the rest of WebGUI should essentially never need to call sendHeader explicitly but should
|
||||
# just call methods in here to configure the response and then return back up to the top where
|
||||
# WebGUI.pm calls finalize and returns the response object back to Plack.
|
||||
# for now, I've added this extra (harmless) call to sendHeader to get started on removing the
|
||||
# others.
|
||||
|
||||
$self->sendHeader(); # doesn't send the header, only fixes the response up based on options set
|
||||
|
||||
$self->next::method(@_);
|
||||
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -242,7 +242,7 @@ if ($self->session->user->isRegistered || $self->session->setting->get("preventP
|
|||
<meta http-equiv="Cache-Control" content="no-cache, must-revalidate, max-age=0, private" />
|
||||
<meta http-equiv="Expires" content="0" />
|
||||
';
|
||||
$self->session->http->setCacheControl("none");
|
||||
$self->session->response->setCacheControl("none");
|
||||
} else {
|
||||
$var{'head.tags'} .= '<meta http-equiv="Cache-Control" content="must-revalidate" />'
|
||||
}
|
||||
|
|
@ -559,7 +559,7 @@ The content to be wrappered.
|
|||
sub userStyle {
|
||||
my $self = shift;
|
||||
my $output = shift;
|
||||
$self->session->http->setCacheControl("none");
|
||||
$self->session->response->setCacheControl("none");
|
||||
if (defined $output) {
|
||||
return $self->process($output,$self->session->setting->get("userFunctionStyleId"));
|
||||
} else {
|
||||
|
|
|
|||
|
|
@ -288,7 +288,7 @@ is not passed in, it will attempt to get one from the L<page> method, or finally
|
|||
sub forceSecureConnection {
|
||||
my $self = shift;
|
||||
my $url = shift;
|
||||
my ($conf, $http) = $self->session->quick(qw(config http));
|
||||
my ($conf, $response) = $self->session->quick(qw(config response));
|
||||
|
||||
if ($conf->get("sslEnabled") && ! $self->session->request->secure){
|
||||
|
||||
|
|
@ -305,7 +305,7 @@ sub forceSecureConnection {
|
|||
}
|
||||
if($url =~ /^http/i) {
|
||||
$url =~ s/^https?/https/i;
|
||||
$http->setRedirect($url);
|
||||
$response->setRedirect($url);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue