all WebGUI::Paths subs should be methods

This commit is contained in:
Graham Knop 2010-02-22 11:02:36 -06:00
parent 7067afe8a9
commit 90d63c6713
2 changed files with 36 additions and 32 deletions

View file

@ -19,8 +19,7 @@ use Carp qw(croak);
use Cwd qw(realpath); use Cwd qw(realpath);
use File::Spec::Functions qw(catdir splitpath catpath splitpath updir catfile); use File::Spec::Functions qw(catdir splitpath catpath splitpath updir catfile);
use Try::Tiny; use Try::Tiny;
use namespace::autoclean -also => qr/^_/;
use namespace::clean;
=head1 NAME =head1 NAME
@ -36,34 +35,39 @@ These methods are available from this class:
=cut =cut
my $root;
BEGIN { BEGIN {
$root = realpath(catdir( use Sub::Name qw(subname);
my $root = realpath(catdir(
catpath((splitpath(__FILE__))[0,1], ''), (updir) x 2 catpath((splitpath(__FILE__))[0,1], ''), (updir) x 2
)); ));
my %paths = (
configBase => catdir($root, 'etc'),
logConfig => catfile($root, 'etc', 'log.conf'),
spectreConfig => catfile($root, 'etc', 'spectre.conf'),
upgradesPath => catfile($root, 'var', 'upgrades'),
preloadCustom => catfile($root, 'sbin', 'preload.custom'),
preloadExclusions => catfile($root, 'sbin', 'preload.exclude'),
extras => catdir($root, 'www', 'extras'),
defaultUploads => catdir($root, 'www', 'uploads'),
defaultCreateSQL => catdir($root, 'var', 'create.sql'),
);
for my $sub (keys %paths) {
my $path = $paths{$sub};
no strict 'refs';
*{$sub} = subname $sub => sub () { $path };
}
} }
use constant {
CONFIG_BASE => catdir($root, 'etc'),
LOG_CONFIG => catfile($root, 'etc', 'log.conf'),
SPECTRE_CONFIG => catfile($root, 'etc', 'spectre.conf'),
UPGRADES_PATH => catfile($root, 'var', 'upgrades'),
PRELOAD_CUSTOM => catfile($root, 'sbin', 'preload.custom'),
PRELOAD_EXCLUSIONS => catfile($root, 'sbin', 'preload.exclude'),
EXTRAS => catdir($root, 'www', 'extras'),
DEFAULT_UPLOADS => catdir($root, 'www', 'uploads'),
DEFAULT_SQL => catdir($root, 'var', 'create.sql'),
};
sub siteConfigs { sub siteConfigs {
opendir my $dh, CONFIG_BASE; my $class = shift;
opendir my $dh, $class->configBase;
my @configs; my @configs;
while ( my $file = readdir $dh ) { while ( my $file = readdir $dh ) {
my $fullPath = realpath( catfile( CONFIG_BASE, $file ) ); my $fullPath = realpath( catfile( $class->configBase, $file ) );
if ( -d $fullPath if ( -d $fullPath
|| $file !~ /\.conf$/ || $file !~ /\.conf$/
|| $fullPath eq realpath(LOG_CONFIG) || $fullPath eq realpath($class->logConfig)
|| $fullPath eq realpath(SPECTRE_CONFIG) ) || $fullPath eq realpath($class->spectreConfig) )
{ {
next; next;
} }
@ -73,38 +77,40 @@ sub siteConfigs {
} ## end sub siteConfigs } ## end sub siteConfigs
sub preloadPaths { sub preloadPaths {
my $class = shift;
my @paths; my @paths;
try { try {
@paths = grep { @paths = grep {
(-d) ? 1 : do { (-d) ? 1 : do {
warn "WARNING: Not adding lib directory '$path' from @{[PRELOAD_CUSTOM]}: Directory does not exist.\n"; warn "WARNING: Not adding lib directory '$path' from @{[$class->preloadCustom]}: Directory does not exist.\n";
0; 0;
} }
} _readTextLines(PRELOAD_CUSTOM); } _readTextLines($class->preloadCustom);
}; };
return @paths; return @paths;
} }
sub includePreloads { sub includePreloads {
unshift @INC, preloadPaths(); my $class = shift;
unshift @INC, $class->preloadPaths;
} }
sub preloadExclude { sub preloadExclude {
my @excludes = _readTextLines(PRELOAD_EXCLUDE); my $class = shift;
my @excludes = _readTextLines($class->preloadExclude);
return @excludes; return @excludes;
} }
sub preloadAll { sub preloadAll {
my $class = shift;
require WebGUI::Pluggable; require WebGUI::Pluggable;
WebGUI::Pluggable::findAndLoad( 'WebGUI', { WebGUI::Pluggable::findAndLoad( 'WebGUI', {
exclude => \( preloadExclude() ), exclude => \( $class->preloadExclude ),
onLoadFail => sub { warn sprintf 'Error loading %s: %s', @_ }, onLoadFail => sub { warn sprintf 'Error loading %s: %s', @_ },
}); });
} }
no namespace::clean;
sub _readTextLines { sub _readTextLines {
my $file = shift; my $file = shift;
my @lines; my @lines;
@ -120,6 +126,4 @@ sub _readTextLines {
return @lines; return @lines;
} }
use namespace::clean;
1; 1;

View file

@ -5,11 +5,11 @@ use warnings;
use Test::More tests => 2; # last test to print use Test::More tests => 2; # last test to print
use WebGUI::Paths; use WebGUI::Paths;
can_ok 'WebGUI::Paths', qw(CONFIG_BASE LOG_CONFIG SPECTRE_CONFIG UPGRADES_PATH PRELOAD_CUSTOM PRELOAD_EXCLUSIONS EXTRAS DEFAULT_UPLOADS DEFAULT_SQL); can_ok 'WebGUI::Paths', qw(configBase logConfig spectreConfig upgradesPath preloadCustom preloadExclusions extras defaultUploads defaultCreateSQL);
ok !(grep { WebGUI::Paths->can($_) } ok !(grep { WebGUI::Paths->can($_) }
qw(croak realpath catdir splitpath catpath splitpath updir catfile try catch _readTextLines)), qw(croak realpath catdir splitpath catpath splitpath updir catfile try catch _readTextLines subname)),
'Internal functions cleaned up'; 'Internal functions cleaned up';
my @configs = WebGUI::Paths->siteConfigs; my @configs = WebGUI::Paths->siteConfigs;
ok !(\@configs ~~ WebGUI::Paths->SPECTRE_CONFIG), 'Spectre config not listed in configs'; ok !(\@configs ~~ WebGUI::Paths->spectreConfig), 'Spectre config not listed in configs';