Added preloading
Removed evil overload Removed references to Apache2:: from codebase Attempted to remove circular references
This commit is contained in:
parent
30a2c09a36
commit
4d703ffd47
7 changed files with 68 additions and 13 deletions
9
app.psgi
9
app.psgi
|
|
@ -5,6 +5,7 @@ use WebGUI;
|
||||||
|
|
||||||
my $root = '/data/WebGUI';
|
my $root = '/data/WebGUI';
|
||||||
my $wg = WebGUI->new( root => $root, site => 'dev.localhost.localdomain.conf' );
|
my $wg = WebGUI->new( root => $root, site => 'dev.localhost.localdomain.conf' );
|
||||||
|
my $config = $wg->config;
|
||||||
|
|
||||||
builder {
|
builder {
|
||||||
|
|
||||||
|
|
@ -17,17 +18,17 @@ builder {
|
||||||
# For PassThru, use Plack::Builder::mount
|
# For PassThru, use Plack::Builder::mount
|
||||||
|
|
||||||
# Extras fallback (you should be using something else to serve static files in production)
|
# Extras fallback (you should be using something else to serve static files in production)
|
||||||
my ($extrasURL, $extrasPath) = ( $wg->config->get('extrasURL'), $wg->config->get('extrasPath') );
|
my ($extrasURL, $extrasPath) = ( $config->get('extrasURL'), $config->get('extrasPath') );
|
||||||
enable 'Static', root => "$extrasPath/", path => sub { s{^$extrasURL/}{} };
|
enable 'Static', root => "$extrasPath/", path => sub { s{^$extrasURL/}{} };
|
||||||
|
|
||||||
# Open/close the WebGUI::Session at the outer-most onion layer
|
# Open/close the WebGUI::Session at the outer-most onion layer
|
||||||
enable '+WebGUI::Middleware::Session',
|
enable '+WebGUI::Middleware::Session',
|
||||||
config => $wg->config,
|
config => $config,
|
||||||
error_docs => { 500 => "$root/www/maintenance.html" };
|
error_docs => { 500 => "$root/www/maintenance.html" };
|
||||||
|
|
||||||
# This one uses the Session object, so it comes after WebGUI::Middleware::Session
|
# This one uses the Session object, so it comes after WebGUI::Middleware::Session
|
||||||
enable '+WebGUI::Middleware::WGAccess', config => $wg->config;
|
enable '+WebGUI::Middleware::WGAccess', config => $config;
|
||||||
|
|
||||||
# Return the app
|
# Return the app
|
||||||
$wg;
|
$wg->psgi_app;
|
||||||
};
|
};
|
||||||
|
|
|
||||||
|
|
@ -74,8 +74,6 @@ sub BUILD {
|
||||||
$self->config($config);
|
$self->config($config);
|
||||||
}
|
}
|
||||||
|
|
||||||
use overload q(&{}) => sub { shift->psgi_app }, fallback => 1;
|
|
||||||
|
|
||||||
sub psgi_app {
|
sub psgi_app {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
return $self->{psgi_app} ||= $self->compile_psgi_app;
|
return $self->{psgi_app} ||= $self->compile_psgi_app;
|
||||||
|
|
@ -84,6 +82,10 @@ sub psgi_app {
|
||||||
sub compile_psgi_app {
|
sub compile_psgi_app {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
|
# Preload all modules in the master (parent) thread before the Server does any
|
||||||
|
# child forking. This should save a lot of memory in copy-on-write friendly environments.
|
||||||
|
$self->preload;
|
||||||
|
|
||||||
# WebGUI is a PSGI app is a Perl code reference. Let's create one.
|
# WebGUI is a PSGI app is a Perl code reference. Let's create one.
|
||||||
# Each web request results in a call to this sub
|
# Each web request results in a call to this sub
|
||||||
return sub {
|
return sub {
|
||||||
|
|
@ -138,7 +140,58 @@ sub compile_psgi_app {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub preload {
|
||||||
|
my $self = shift;
|
||||||
|
my $debug = shift;
|
||||||
|
|
||||||
|
warn 'Preloading modules..' if $debug;
|
||||||
|
my $modules = sub {
|
||||||
|
require Module::Versions;
|
||||||
|
my $m = Module::Versions->HASH;
|
||||||
|
$_ = $_->{VERSION} for values %$m;
|
||||||
|
return $m;
|
||||||
|
} if $debug;
|
||||||
|
my $pre = $modules->() if $debug;
|
||||||
|
|
||||||
|
# The following is taken from preload.perl
|
||||||
|
my $readlines = sub {
|
||||||
|
my $file = shift;
|
||||||
|
my @lines;
|
||||||
|
if (open(my $fh, '<', $file)) {
|
||||||
|
while (my $line = <$fh>) {
|
||||||
|
$line =~ s/#.*//;
|
||||||
|
$line =~ s/^\s+//;
|
||||||
|
$line =~ s/\s+$//;
|
||||||
|
next if !$line;
|
||||||
|
push @lines, $line;
|
||||||
|
}
|
||||||
|
close $fh;
|
||||||
|
}
|
||||||
|
return @lines;
|
||||||
|
};
|
||||||
|
|
||||||
|
my @excludes = $readlines->($self->root . '/sbin/preload.exclude');
|
||||||
|
|
||||||
|
use DBI;
|
||||||
|
DBI->install_driver("mysql");
|
||||||
|
WebGUI::Pluggable::findAndLoad( "WebGUI",
|
||||||
|
{
|
||||||
|
exclude => \@excludes,
|
||||||
|
onLoadFail => sub { die 'Error loading %s: %s', @_ },
|
||||||
|
}
|
||||||
|
);
|
||||||
|
|
||||||
|
if ($debug) {
|
||||||
|
my $post = $modules->();
|
||||||
|
my @new;
|
||||||
|
for my $k (keys %$post) {
|
||||||
|
push @new, $k unless $pre->{$k};
|
||||||
|
}
|
||||||
|
warn join "\n", sort @new;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
sub handle {
|
sub handle {
|
||||||
my ( $session ) = @_;
|
my ( $session ) = @_;
|
||||||
|
|
|
||||||
|
|
@ -20,7 +20,6 @@ use WebGUI::International;
|
||||||
use WebGUI::Storage;
|
use WebGUI::Storage;
|
||||||
use WebGUI::Asset::Wobject::HttpProxy::Parse;
|
use WebGUI::Asset::Wobject::HttpProxy::Parse;
|
||||||
use WebGUI::Macro;
|
use WebGUI::Macro;
|
||||||
use Apache2::Upload;
|
|
||||||
use Tie::IxHash;
|
use Tie::IxHash;
|
||||||
|
|
||||||
use Moose;
|
use Moose;
|
||||||
|
|
|
||||||
|
|
@ -19,7 +19,6 @@ package WebGUI::Macro::UsersOnline;
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
use strict;
|
use strict;
|
||||||
use Apache2::ServerRec;
|
|
||||||
use Net::DNS;
|
use Net::DNS;
|
||||||
use WebGUI::Asset::Template;
|
use WebGUI::Asset::Template;
|
||||||
use WebGUI::International;
|
use WebGUI::International;
|
||||||
|
|
|
||||||
|
|
@ -9,6 +9,7 @@ use Plack::Middleware::Debug;
|
||||||
use WebGUI::Middleware::HTTPExceptions;
|
use WebGUI::Middleware::HTTPExceptions;
|
||||||
use Plack::Middleware::ErrorDocument;
|
use Plack::Middleware::ErrorDocument;
|
||||||
use Plack::Middleware::SimpleLogger;
|
use Plack::Middleware::SimpleLogger;
|
||||||
|
use Scalar::Util qw(weaken);
|
||||||
|
|
||||||
use Plack::Util::Accessor qw( config error_docs );
|
use Plack::Util::Accessor qw( config error_docs );
|
||||||
|
|
||||||
|
|
@ -33,6 +34,8 @@ sub call {
|
||||||
my ( $self, $env ) = @_;
|
my ( $self, $env ) = @_;
|
||||||
|
|
||||||
my $app = $self->app;
|
my $app = $self->app;
|
||||||
|
weaken $self->{config};
|
||||||
|
|
||||||
my $config = $self->config or die 'Mandatory config parameter missing';
|
my $config = $self->config or die 'Mandatory config parameter missing';
|
||||||
|
|
||||||
# Logger fallback
|
# Logger fallback
|
||||||
|
|
@ -59,6 +62,9 @@ sub call {
|
||||||
return [ 500, [ 'Content-Type' => 'text/plain' ], [ 'Internal Server Error' ] ];
|
return [ 500, [ 'Content-Type' => 'text/plain' ], [ 'Internal Server Error' ] ];
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
# Perhaps I'm being paranoid..
|
||||||
|
weaken $session->{_config};
|
||||||
|
|
||||||
my $debug = $session->log->canShowDebug;
|
my $debug = $session->log->canShowDebug;
|
||||||
if ($debug) {
|
if ($debug) {
|
||||||
|
|
|
||||||
|
|
@ -363,8 +363,6 @@ sub addFileFromFormPost {
|
||||||
my $session = $self->session;
|
my $session = $self->session;
|
||||||
return ""
|
return ""
|
||||||
if ($self->session->http->getStatus eq '413');
|
if ($self->session->http->getStatus eq '413');
|
||||||
require Apache2::Request;
|
|
||||||
require Apache2::Upload;
|
|
||||||
my $filename;
|
my $filename;
|
||||||
my $attachmentCount = 1;
|
my $attachmentCount = 1;
|
||||||
foreach my $upload ($session->request->upload($formVariableName)) {
|
foreach my $upload ($session->request->upload($formVariableName)) {
|
||||||
|
|
|
||||||
|
|
@ -21,7 +21,6 @@ use HTTP::Request;
|
||||||
use HTTP::Request::Common qw(POST);
|
use HTTP::Request::Common qw(POST);
|
||||||
use LWP::UserAgent;
|
use LWP::UserAgent;
|
||||||
use Digest::MD5;
|
use Digest::MD5;
|
||||||
use Apache2::ServerUtil;
|
|
||||||
|
|
||||||
=head1 NAME
|
=head1 NAME
|
||||||
|
|
||||||
|
|
@ -80,7 +79,7 @@ sub execute {
|
||||||
my $stats = {
|
my $stats = {
|
||||||
webguiVersion => $WebGUI::VERSION,
|
webguiVersion => $WebGUI::VERSION,
|
||||||
perlVersion => sprintf("%vd", $^V),
|
perlVersion => sprintf("%vd", $^V),
|
||||||
apacheVersion => Apache2::ServerUtil::get_server_version(),
|
apacheVersion => 'X',
|
||||||
osType => $^O,
|
osType => $^O,
|
||||||
siteId => Digest::MD5::md5_base64($self->session->config->get("sitename")->[0]), # only here to identify the site if the user submits their info a second time
|
siteId => Digest::MD5::md5_base64($self->session->config->get("sitename")->[0]), # only here to identify the site if the user submits their info a second time
|
||||||
userCount => $db->quickScalar("select count(*) from users"),
|
userCount => $db->quickScalar("select count(*) from users"),
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue