Added preloading

Removed evil overload
Removed references to Apache2:: from codebase
Attempted to remove circular references
This commit is contained in:
Patrick Donelan 2010-04-14 19:36:41 -04:00
parent 30a2c09a36
commit 4d703ffd47
7 changed files with 68 additions and 13 deletions

View file

@ -5,6 +5,7 @@ use WebGUI;
my $root = '/data/WebGUI';
my $wg = WebGUI->new( root => $root, site => 'dev.localhost.localdomain.conf' );
my $config = $wg->config;
builder {
@ -17,17 +18,17 @@ builder {
# For PassThru, use Plack::Builder::mount
# 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/}{} };
# Open/close the WebGUI::Session at the outer-most onion layer
enable '+WebGUI::Middleware::Session',
config => $wg->config,
config => $config,
error_docs => { 500 => "$root/www/maintenance.html" };
# 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
$wg;
$wg->psgi_app;
};

View file

@ -74,8 +74,6 @@ sub BUILD {
$self->config($config);
}
use overload q(&{}) => sub { shift->psgi_app }, fallback => 1;
sub psgi_app {
my $self = shift;
return $self->{psgi_app} ||= $self->compile_psgi_app;
@ -84,6 +82,10 @@ sub psgi_app {
sub compile_psgi_app {
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.
# Each web request results in a call to this 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 {
my ( $session ) = @_;

View file

@ -20,7 +20,6 @@ use WebGUI::International;
use WebGUI::Storage;
use WebGUI::Asset::Wobject::HttpProxy::Parse;
use WebGUI::Macro;
use Apache2::Upload;
use Tie::IxHash;
use Moose;

View file

@ -19,7 +19,6 @@ package WebGUI::Macro::UsersOnline;
=cut
use strict;
use Apache2::ServerRec;
use Net::DNS;
use WebGUI::Asset::Template;
use WebGUI::International;

View file

@ -9,6 +9,7 @@ use Plack::Middleware::Debug;
use WebGUI::Middleware::HTTPExceptions;
use Plack::Middleware::ErrorDocument;
use Plack::Middleware::SimpleLogger;
use Scalar::Util qw(weaken);
use Plack::Util::Accessor qw( config error_docs );
@ -33,6 +34,8 @@ sub call {
my ( $self, $env ) = @_;
my $app = $self->app;
weaken $self->{config};
my $config = $self->config or die 'Mandatory config parameter missing';
# Logger fallback
@ -59,6 +62,9 @@ sub call {
return [ 500, [ 'Content-Type' => 'text/plain' ], [ 'Internal Server Error' ] ];
}
}
# Perhaps I'm being paranoid..
weaken $session->{_config};
my $debug = $session->log->canShowDebug;
if ($debug) {

View file

@ -363,8 +363,6 @@ sub addFileFromFormPost {
my $session = $self->session;
return ""
if ($self->session->http->getStatus eq '413');
require Apache2::Request;
require Apache2::Upload;
my $filename;
my $attachmentCount = 1;
foreach my $upload ($session->request->upload($formVariableName)) {

View file

@ -21,7 +21,6 @@ use HTTP::Request;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
use Digest::MD5;
use Apache2::ServerUtil;
=head1 NAME
@ -80,7 +79,7 @@ sub execute {
my $stats = {
webguiVersion => $WebGUI::VERSION,
perlVersion => sprintf("%vd", $^V),
apacheVersion => Apache2::ServerUtil::get_server_version(),
apacheVersion => 'X',
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
userCount => $db->quickScalar("select count(*) from users"),