improve behavior of preload.perl for custom lib dirs not ending in lib
This commit is contained in:
parent
c07e5bf3eb
commit
26cc8ad9df
2 changed files with 70 additions and 81 deletions
|
|
@ -17,6 +17,7 @@
|
|||
- fixed: Anonymous registration form produces invalid html
|
||||
- fixed: DEmote in toolbar menu has PROmote url
|
||||
- fixed: EMS purge now functions correctly
|
||||
- improve behavior of preload.perl for custom lib dirs not ending in lib
|
||||
|
||||
7.5.18
|
||||
- fixed: Collateral Image Manager broken in Firefox 3
|
||||
|
|
|
|||
|
|
@ -1,112 +1,100 @@
|
|||
my $webguiRoot;
|
||||
my $customLibs;
|
||||
|
||||
BEGIN {
|
||||
$webguiRoot = "/data/WebGUI";
|
||||
unshift (@INC, $webguiRoot."/lib");
|
||||
@{$customLibs} = ();
|
||||
open(FILE,"<".$webguiRoot."/sbin/preload.custom");
|
||||
while (my $line = <FILE>) {
|
||||
chomp $line;
|
||||
next unless $line;
|
||||
next if $line =~ /^#/;
|
||||
if (!-d $line) {
|
||||
print "WARNING: Not adding lib directory '$line' from $webguiRoot/sbin/preload.custom: Directory does not exist.\n";
|
||||
next;
|
||||
}
|
||||
push(@{$customLibs}, $line);
|
||||
}
|
||||
close(FILE);
|
||||
foreach my $lib (@{$customLibs}) {
|
||||
unshift @INC, $lib;
|
||||
}
|
||||
}
|
||||
|
||||
$|=1;
|
||||
|
||||
use strict;
|
||||
print "\nStarting WebGUI ".$WebGUI::VERSION."\n";
|
||||
|
||||
my $webguiRoot = '/data/WebGUI';
|
||||
|
||||
my @webguiLibs = ($webguiRoot."/lib");
|
||||
|
||||
# add custom lib directories to library search path
|
||||
for my $libDir (readLines($webguiRoot."/sbin/preload.custom")) {
|
||||
if (!-d $libDir) {
|
||||
warn "WARNING: Not adding lib directory '$libDir' from $webguiRoot/sbin/preload.custom: Directory does not exist.\n";
|
||||
next;
|
||||
}
|
||||
push @webguiLibs, $libDir;
|
||||
}
|
||||
unshift @INC, @webguiLibs;
|
||||
|
||||
#----------------------------------------
|
||||
# Logger
|
||||
#----------------------------------------
|
||||
use Log::Log4perl;
|
||||
Log::Log4perl->init( $webguiRoot."/etc/log.conf" );
|
||||
|
||||
require Log::Log4perl;
|
||||
Log::Log4perl->init( $webguiRoot."/etc/log.conf" );
|
||||
|
||||
#----------------------------------------
|
||||
# Database connectivity.
|
||||
#----------------------------------------
|
||||
#use Apache::DBI (); # Uncomment if you want to enable connection pooling. Not recommended on servers with many sites, or those using db slaves.
|
||||
use Log::Log4perl ();
|
||||
use DBI ();
|
||||
#require Apache::DBI; # Uncomment if you want to enable connection pooling. Not recommended on servers with many sites, or those using db slaves.
|
||||
require DBI;
|
||||
DBI->install_driver("mysql"); # Change to match your database driver.
|
||||
|
||||
|
||||
|
||||
#----------------------------------------
|
||||
# WebGUI modules.
|
||||
#----------------------------------------
|
||||
use WebGUI ();
|
||||
require WebGUI;
|
||||
|
||||
require File::Find;
|
||||
|
||||
use WebGUI::Utility ();
|
||||
use File::Find ();
|
||||
my @modules = ();
|
||||
# these modules should always be skipped
|
||||
my @excludes = qw(WebGUI::i18n::English::Automated_Information WebGUI::PerformanceProfiler);
|
||||
open(FILE,"<".$webguiRoot."/sbin/preload.exclude");
|
||||
while (my $line = <FILE>) {
|
||||
next if $line =~ m/^#/;
|
||||
chomp $line;
|
||||
push(@excludes, $line);
|
||||
}
|
||||
close(FILE);
|
||||
my @folders = ($webguiRoot."/lib/WebGUI");
|
||||
foreach my $lib (@{$customLibs}) {
|
||||
push(@folders, $lib."/WebGUI");
|
||||
}
|
||||
File::Find::find(\&getWebGUIModules, @folders);
|
||||
foreach my $package (@modules) {
|
||||
next if (WebGUI::Utility::isIn($package,@excludes));
|
||||
(my $file = "$package.pm") =~ s{::|'}{/}g;
|
||||
if (!eval { require $file; 1 }) {
|
||||
warn "Error loading $package! - $@";
|
||||
}
|
||||
push @excludes, readLines($webguiRoot."/sbin/preload.exclude");
|
||||
|
||||
foreach my $libDir (@webguiLibs) {
|
||||
File::Find::find({
|
||||
no_chdir => 1,
|
||||
wanted => sub {
|
||||
my $module = $_;
|
||||
return
|
||||
unless $module =~ m/\.pm$/;
|
||||
# clip off library path
|
||||
$module =~ s{^\Q$libDir\E/?}{};
|
||||
my $package = $module;
|
||||
$package =~ s{\.pm$}{};
|
||||
$package =~ s{/}{::}g;
|
||||
if (grep { $package eq $_ } @excludes) {
|
||||
next;
|
||||
}
|
||||
if (!eval { require $module; 1 }) {
|
||||
warn "Error loading $package! - $@";
|
||||
}
|
||||
},
|
||||
}, "$libDir/WebGUI");
|
||||
}
|
||||
|
||||
use Apache2::ServerUtil ();
|
||||
{
|
||||
# Add WebGUI to Apache version tokens
|
||||
my $server = Apache2::ServerUtil->server;
|
||||
my $sub = sub {
|
||||
$server->add_version_component("WebGUI/".$WebGUI::VERSION);
|
||||
};
|
||||
$server->push_handlers(PerlPostConfigHandler => $sub);
|
||||
}
|
||||
require APR::Request::Apache2;
|
||||
require Apache2::Cookie;
|
||||
require Apache2::ServerUtil;
|
||||
|
||||
# Add WebGUI to Apache version tokens
|
||||
my $server = Apache2::ServerUtil->server;
|
||||
$server->push_handlers(PerlPostConfigHandler => sub {
|
||||
$server->add_version_component("WebGUI/".$WebGUI::VERSION);
|
||||
});
|
||||
|
||||
use APR::Request::Apache2 ();
|
||||
use Apache2::Cookie ();
|
||||
$| = 1;
|
||||
|
||||
print "\nStarting WebGUI ".$WebGUI::VERSION."\n";
|
||||
|
||||
#----------------------------------------
|
||||
# Preload all site configs.
|
||||
#----------------------------------------
|
||||
WebGUI::Config->loadAllConfigs($webguiRoot);
|
||||
|
||||
|
||||
print "WebGUI Started!\n";
|
||||
|
||||
|
||||
#----------------------------------------
|
||||
sub getWebGUIModules {
|
||||
my $filename = $File::Find::dir."/".$_;
|
||||
return unless $filename =~ m/\.pm$/;
|
||||
my $package = $filename;
|
||||
$package =~ s/.*\/lib\/(.*)\.pm$/$1/;
|
||||
$package =~ s/\//::/g;
|
||||
push(@modules,$package);
|
||||
# reads lines from into an array, trimming white space and ignoring commented lines
|
||||
sub readLines {
|
||||
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;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue