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 File::Spec::Functions qw(catdir splitpath catpath splitpath updir catfile);
use Try::Tiny;
use namespace::clean;
use namespace::autoclean -also => qr/^_/;
=head1 NAME
@ -36,34 +35,39 @@ These methods are available from this class:
=cut
my $root;
BEGIN {
$root = realpath(catdir(
use Sub::Name qw(subname);
my $root = realpath(catdir(
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 {
opendir my $dh, CONFIG_BASE;
my $class = shift;
opendir my $dh, $class->configBase;
my @configs;
while ( my $file = readdir $dh ) {
my $fullPath = realpath( catfile( CONFIG_BASE, $file ) );
my $fullPath = realpath( catfile( $class->configBase, $file ) );
if ( -d $fullPath
|| $file !~ /\.conf$/
|| $fullPath eq realpath(LOG_CONFIG)
|| $fullPath eq realpath(SPECTRE_CONFIG) )
|| $fullPath eq realpath($class->logConfig)
|| $fullPath eq realpath($class->spectreConfig) )
{
next;
}
@ -73,38 +77,40 @@ sub siteConfigs {
} ## end sub siteConfigs
sub preloadPaths {
my $class = shift;
my @paths;
try {
@paths = grep {
(-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;
}
} _readTextLines(PRELOAD_CUSTOM);
} _readTextLines($class->preloadCustom);
};
return @paths;
}
sub includePreloads {
unshift @INC, preloadPaths();
my $class = shift;
unshift @INC, $class->preloadPaths;
}
sub preloadExclude {
my @excludes = _readTextLines(PRELOAD_EXCLUDE);
my $class = shift;
my @excludes = _readTextLines($class->preloadExclude);
return @excludes;
}
sub preloadAll {
my $class = shift;
require WebGUI::Pluggable;
WebGUI::Pluggable::findAndLoad( 'WebGUI', {
exclude => \( preloadExclude() ),
exclude => \( $class->preloadExclude ),
onLoadFail => sub { warn sprintf 'Error loading %s: %s', @_ },
});
}
no namespace::clean;
sub _readTextLines {
my $file = shift;
my @lines;
@ -120,6 +126,4 @@ sub _readTextLines {
return @lines;
}
use namespace::clean;
1;

View file

@ -5,11 +5,11 @@ use warnings;
use Test::More tests => 2; # last test to print
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($_) }
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';
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';