oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

progress and WebGUI::Paths conversion

Browse source
This commit is contained in:
Graham Knop 2010-02-23 10:06:50 -06:00
parent 90d63c6713
commit 29df110409
23 changed files with 63 additions and 333 deletions
Download patch file Download diff file Expand all files Collapse all files

7
lib/Spectre/Admin.pm
View file

@ -24,6 +24,7 @@ use POE::Component::IKC::Server;
use POE::Component::IKC::Specifier;
use Spectre::Cron;
use Spectre::Workflow;
use WebGUI::Paths;
#-------------------------------------------------------------------
@ -136,7 +137,7 @@ Fetches the site from each defined site, and loads it into the Workflow and Cron
sub loadSiteData {
my ( $kernel, $self) = @_[ KERNEL, OBJECT ];
my $configs = WebGUI::Config->readAllConfigs($self->{_config}->getWebguiRoot);
my $configs = WebGUI::Config->readAllConfigs;
$self->debug("Reading site configs.");
foreach my $key (keys %{$configs}) {
next if $key =~ m/^demo/;
@ -194,7 +195,7 @@ sub new {
my $class = shift;
my $config = shift;
my $debug = shift;
Log::Log4perl->init( $config->getWebguiRoot."/etc/log.conf" );
Log::Log4perl->init( WebGUI::Paths->logConfig );
$Log::Log4perl::caller_depth = $Log::Log4perl::caller_depth+3;
my $logger = Log::Log4perl->get_logger($config->getFilename);
my $self = {_debug=>$debug, _config=>$config, _logger=>$logger};
@ -244,7 +245,7 @@ sub runTests {
my $class = shift;
my $config = shift;
print "Running connectivity tests.\n";
my $configs = WebGUI::Config->readAllConfigs($config->getWebguiRoot);
my $configs = WebGUI::Config->readAllConfigs;
foreach my $key (keys %{$configs}) {
next if $key =~ m/^demo/;
print "Testing $key\n";

4
lib/WebGUI.pm
View file

@ -93,7 +93,7 @@ sub authen {
}
}
$config ||= WebGUI::Config->new($server->dir_config('WebguiRoot'),$request->dir_config('WebguiConfig'));
$config ||= WebGUI::Config->new($request->dir_config('WebguiConfig'));
my $cookies = APR::Request::Apache2->handle($request)->jar();
# determine session id
@ -160,7 +160,7 @@ sub handler {
$request = Apache2::Request->new($request);
my $configFile = shift || $request->dir_config('WebguiConfig'); #either we got a config file, or we'll build it from the request object's settings
my $server = Apache2::ServerUtil->server; #instantiate the server api
my $config = WebGUI::Config->new($server->dir_config('WebguiRoot'), $configFile); #instantiate the config object
my $config = WebGUI::Config->new($configFile); #instantiate the config object
my $error = "";
my $matchUri = $request->uri;
my $gateway = $config->get("gateway");

8
lib/WebGUI/Asset/Wobject/StoryArchive.pm
View file

@ -196,13 +196,7 @@ sub exportAssetCollateral {
}
# open another session to handle printing...
my $printSession = WebGUI::Session->open(
$self->session->config->getWebguiRoot,
$self->session->config->getFilename,
undef,
undef,
$self->session->getId,
);
my $printSession = WebGUI::Session->duplicate;
my $keywordObj = WebGUI::Keyword->new($printSession);
my $keywords = $keywordObj->findKeywords({

2
lib/WebGUI/AssetExportHtml.pm
View file

@ -265,7 +265,6 @@ sub exportAsHtml {
# now, create a new session as the user doing the exports. this is so that
# the exported assets are taken from that user's perspective.
my $exportSession = WebGUI::Session->open(
$session->config->getWebguiRoot,
$session->config->getFilename,
);
my $esGuard = Scope::Guard->new(sub {
@ -499,7 +498,6 @@ sub exportGetDescendants {
# assets that they can't see
if ( ref $user && $user->isa('WebGUI::User') ) {
$session = WebGUI::Session->open(
$session->config->getWebguiRoot,
$session->config->getFilename,
);
$session->user( { userId => $user->userId } );

71
lib/WebGUI/Config.pm
View file

@ -15,8 +15,9 @@ package WebGUI::Config;
=cut
use strict;
use Class::InsideOut qw(readonly id register);
use WebGUI::Paths;
use Cwd ();
use File::Spec;
use base 'Config::JSON';
my %config = ();
@ -50,7 +51,6 @@ This package parses the WebGUI config file.
$config->addToArray($name, $value);
my $configFileName = $config->getFilename;
my $webguiRoot = $config->getWebguiRoot;
=head1 ISA
@ -109,17 +109,6 @@ sub getCookieTTL {
return defined($configTTL)? $configTTL : "+10y";
}
#-------------------------------------------------------------------
=head2 getWebguiRoot ( )
Returns the path to the WebGUI installation.
=cut
readonly getWebguiRoot => my %webguiRoot;
#-------------------------------------------------------------------
=head2 loadAllConfigs ( webguiRoot )
@ -166,57 +155,39 @@ A boolean value that when set to true tells the config system not to store the c
=cut
sub new {
my $class = shift;
my $webguiPath = Cwd::realpath(shift);
my $filename = shift;
my $noCache = shift;
my $fullPath = Cwd::realpath($webguiPath.'/etc/'.$filename);
if (exists $config{$fullPath}) {
return $config{$fullPath};
} else {
my $self = Config::JSON->new($fullPath);
register($self, $class);
$webguiRoot{id $self} = $webguiPath;
$config{$filename} = $self unless $noCache;
return $self;
}
my $class = shift;
my $filename = shift;
my $noCache = shift;
if (!File::Spec->file_name_is_absolute($filename)) {
Cwd::realpath($filename = File::Spec->catfile(WebGUI::Paths->configBase, $filename));
}
if (exists $config{$filename}) {
return $config{$filename};
}
else {
my $self = $class->SUPER::new($fullPath);
$config{$filename} = $self unless $noCache;
return $self;
}
}
#-------------------------------------------------------------------
=head2 readAllConfigs ( webguiRoot )
=head2 readAllConfigs ( )
Reads all the config file data for all defined sites and returns a hash reference containing WebGUI::Config objects keyed by filename. This is a class method.
Example: $configs->{$filename};
=head3 webguiRoot
The path to the WebGUI installation.
=cut
sub readAllConfigs {
my $class = shift;
my $webguiPath = shift;
opendir my $dh, $webguiPath."/etc";
my @files = readdir $dh;
closedir $dh;
my %configs;
foreach my $file (@files) {
next
if $file !~ /\.conf$/
|| $file =~ /^\./
|| $file eq 'log.conf'
|| $file eq 'spectre.conf';
eval {
$configs{$file} = WebGUI::Config->new($webguiPath,$file)
};
if ($@) {
warn "Config file ".$file." looks to be corrupt or have a syntax error.";
}
}
my @configs = WebGUI::Paths->siteConfigs;
my %configs = map {
$_ => $class->new($_);
} @configs
return \%configs;
}

9
lib/WebGUI/Content/Maintenance.pm
View file

@ -48,12 +48,9 @@ sub handler {
my $session = shift;
if ($session->setting->get("specialState") eq "upgrading") {
$session->http->sendHeader;
my $output = "";
open(my $FILE,"<",$session->config->getWebguiRoot."/www/maintenance.html");
while (<$FILE>) {
$output .= $_;
}
close($FILE);
open my $fh, '<', $session->config->get('maintenancePage');
my $output = do { local $/; <$fh> };
close $fh;
return $output;
}
return undef;

3
lib/WebGUI/Image/Font.pm
View file

@ -2,6 +2,7 @@ package WebGUI::Image::Font;
use strict;
use WebGUI::Storage;
use WebGUI::Paths;
#-------------------------------------------------------------------
@ -72,7 +73,7 @@ sub getFile {
if ($self->getStorageId) {
return WebGUI::Storage->get($self->session, $self->getStorageId)->getPath($self->getFilename);
} else {
return $self->session->config->getWebguiRoot."/lib/default.ttf"
return WebGUI::Paths->var . '/default.ttf';
}
}

40
lib/WebGUI/Operation/Help.pm
View file

@ -17,6 +17,7 @@ use WebGUI::Asset::Template;
use WebGUI::Macro;
use WebGUI::Utility;
use WebGUI::TabForm;
use WebGUI::Pluggable;
=head1 NAME
@ -190,29 +191,6 @@ sub _linkTOC {
#-------------------------------------------------------------------
=head2 _getHelpFilesList ( $session )
Utility routine for returning a list of all Help files in the lib/WebGUI/Help folder.
=cut
sub _getHelpFilesList {
my $session = shift;
my $dir = join '/', $session->config->getWebguiRoot,"lib","WebGUI","Help";
opendir (DIR,$dir) or $session->errorHandler->fatal("Can't open Help directory!");
my @files;
foreach my $file (readdir DIR) {
next unless $file =~ /.pm$/;
my $modName;
($modName = $file) =~ s/\.pm$//;
push @files, [ $file, $modName ];
}
closedir(DIR);
return @files;
}
#-------------------------------------------------------------------
=head2 _related ( $session, $related )
Utility routine for returning a list of topics related the the current help
@ -380,18 +358,18 @@ sub www_viewHelpIndex {
my $session = shift;
return $session->privilege->insufficient() unless canView($session);
my $i18n = WebGUI::International->new($session);
my @helpIndex;
my @files = _getHelpFilesList($session,);
foreach my $fileSet (@files) {
my $namespace = $fileSet->[1];
my $help = _load($session,$namespace);
foreach my $key (keys %{$help}) {
my @helpIndex;
my @modules = WebGUI::Pluggable::findAndLoad('WebGUI::Help');
for my $namespace (@modules) {
$namespace =~ s/^WebGUI::Help:://;
my $help = _load($session,$namespace);
foreach my $key (keys %{$help}) {
next if $help->{$key}{private};
my $title = $i18n->get($help->{$key}{title},$namespace);
next unless $title;
push @helpIndex, [$namespace, $key, $title];
}
push @helpIndex, [$namespace, $key, $title];
}
}
my $output = '<table width="100%" class="content"><tr><td valign="top">';
my $halfway = round(@helpIndex / 2);
my $i = 0;

5
lib/WebGUI/Paths.pm
View file

@ -44,12 +44,13 @@ BEGIN {
configBase => catdir($root, 'etc'),
logConfig => catfile($root, 'etc', 'log.conf'),
spectreConfig => catfile($root, 'etc', 'spectre.conf'),
upgradesPath => catfile($root, 'var', 'upgrades'),
upgrades => catfile($root, 'docs', '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'),
defaultCreateSQL => catdir($root, 'docs', 'create.sql'),
var => catdir($root, 'var'),
);
for my $sub (keys %paths) {
my $path = $paths{$sub};

8
lib/WebGUI/Role/Asset/RssFeed.pm
View file

@ -209,13 +209,7 @@ sub exportAssetCollateral {
$reportSession->output->print(
'&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;' . $message . '<br />');
}
my $exportSession = WebGUI::Session->open(
$self->session->config->getWebguiRoot,
$self->session->config->getFilename,
undef,
undef,
$self->session->getId,
);
my $exportSession = WebGUI::Session->duplicate;
# open another session as the user doing the exporting...
my $selfdupe = WebGUI::Asset->newById( $exportSession, $self->getId );

3
lib/WebGUI/Session.pm
View file

@ -273,7 +273,6 @@ Creates a new session using the same WebGUI root, config file, and user.
sub duplicate {
my $self = shift;
my $newSession = WebGUI::Session->open(
$self->config->getWebguiRoot,
$self->config->getFilename,
undef,
undef,
@ -460,7 +459,7 @@ sub open {
my $configFile = shift;
my $request = shift;
my $server = shift;
my $config = WebGUI::Config->new($webguiRoot,$configFile);
my $config = WebGUI::Config->new($configFile);
my $self = {_config=>$config, _server=>$server};
bless $self , $class;
$self->{_request} = $request if (defined $request);

3
lib/WebGUI/Session/ErrorHandler.pm
View file

@ -17,6 +17,7 @@ package WebGUI::Session::ErrorHandler;
use strict;
use Log::Log4perl;
use WebGUI::Paths;
#use Apache2::RequestUtil;
use JSON;
use HTML::Entities qw(encode_entities);
@ -324,7 +325,7 @@ An active WebGUI::Session object.
sub new {
my $class = shift;
my $session = shift;
Log::Log4perl->init_once( $session->config->getWebguiRoot."/etc/log.conf" );
Log::Log4perl->init_once( WebGUI::Paths->logConfig );
my $logger = Log::Log4perl->get_logger($session->config->getFilename);
bless {_queryCount=>0, _logger=>$logger, _session=>$session}, $class;
}

3
lib/WebGUI/Storage.pm
View file

@ -26,6 +26,7 @@ use Image::Magick;
use Path::Class::Dir;
use Storable ();
use WebGUI::Utility qw(isIn);
use WebGUI::Paths;
=head1 NAME
@ -257,7 +258,7 @@ sub addFileFromCaptcha {
$self->session->errorHandler->warn("Error adding noise: $error");
}
# AddNoise generates a different average color depending on library. This is ugly, but the best I can see for now
$error = $image->Annotate(font=>$self->session->config->getWebguiRoot."/lib/default.ttf", pointsize=>40, skewY=>0, skewX=>0, gravity=>'center', fill=>'#ffffff', antialias=>'true', text=>$challenge);
$error = $image->Annotate(font=>WebGUI::Paths->var.'/default.ttf', pointsize=>40, skewY=>0, skewX=>0, gravity=>'center', fill=>'#ffffff', antialias=>'true', text=>$challenge);
if($error) {
$self->session->errorHandler->warn("Error Annotating image: $error");
}

65
lib/WebGUI/URL/Credits.pm
View file

@ -1,65 +0,0 @@
package WebGUI::URL::Credits;
=head1 LEGAL
-------------------------------------------------------------------
WebGUI is Copyright 2001-2009 Plain Black Corporation.
-------------------------------------------------------------------
Please read the legal notices (docs/legal.txt) and the license
(docs/license.txt) that came with this distribution before using
this software.
-------------------------------------------------------------------
http://www.plainblack.com info@plainblack.com
-------------------------------------------------------------------
=cut
use strict;
use Apache2::Const -compile => qw(OK DECLINED);
use APR::Finfo ();
use APR::Const -compile => qw(FINFO_NORM);
use WebGUI::Session;
=head1 NAME
Package WebGUI::URL::Credits
=head1 DESCRIPTION
A URL handler that displays the credits file.
=head1 SYNOPSIS
use WebGUI::URL::Credits;
my $status = WebGUI::URL::Credits::handler($r, $s, $config);
=head1 SUBROUTINES
These subroutines are available from this package:
=cut
#-------------------------------------------------------------------
=head2 handler ( request, server, config )
The Apache request handler for this package.
=cut
sub handler {
my ($request, $server, $config) = @_;
my $filename = $config->getWebguiRoot."/docs/credits.txt";
$request->push_handlers(PerlResponseHandler => sub {
$request->content_type('text/plain');
$request->sendfile($filename);
return Apache2::Const::OK;
});
$request->push_handlers(PerlTransHandler => sub { return Apache2::Const::OK });
$request->push_handlers(PerlMapToStorageHandler => sub { return Apache2::Const::OK });
return Apache2::Const::OK;
}
1;

2
lib/WebGUI/Workflow/Activity/DeleteExpiredSessions.pm
View file

@ -87,7 +87,7 @@ sub execute {
$self->session->errorHandler->warn("More than 1 old userLoginLog rows found, removing offending rows");
$self->session->db->write("delete from userLoginLog where lastPageViewed = timeStamp and sessionId = ? ", [$sessionId] );
}
my $session = WebGUI::Session->open($self->session->config->getWebguiRoot, $self->session->config->getFilename, undef, undef, $sessionId, 1);
my $session = WebGUI::Session->open($self->session->config->getFilename, undef, undef, $sessionId, 1);
if (defined $session) {
$session->var->end;
$session->close;

3
sbin/installClass.pl
View file

@ -17,6 +17,7 @@ use Getopt::Long;
use Pod::Usage;
use WebGUI::Pluggable;
use WebGUI::Session;
use WebGUI::Paths;
$|++;
@ -44,7 +45,7 @@ pod2usage("$0: Must specify a configFile")
if !$configFile;
die "Config file '$configFile' does not exist!\n"
if !-f '../etc/' . $configFile;
if !-f WebGUI::Paths->configBase . '/' . $configFile;
# Open the session
my $session = WebGUI::Session->open( "..", $configFile );

144
sbin/testCodebase.pl
View file

@ -1,144 +0,0 @@
#!/usr/bin/env perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#-------------------------------------------------------------------
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
$|=1;
use strict;
use FindBin;
use File::Spec qw[];
use Getopt::Long;
use Pod::Usage;
my $configFile;
my $help;
my $verbose;
my $perlBase;
my $noLongTests;
my $coverage;
GetOptions(
'verbose'=>\$verbose,
'configFile=s'=>\$configFile,
'perlBase=s'=>\$perlBase,
'noLongTests'=>\$noLongTests,
'help'=>\$help,
'coverage'=>\$coverage,
);
##Defaults to command-line switch
$configFile ||= $ENV{WEBGUI_CONFIG};
pod2usage( verbose => 2 ) if $help;
pod2usage() unless $configFile ne '';
my $verboseFlag = "-v" if ($verbose);
$perlBase .= '/bin/' if ($perlBase);
if (! -e $configFile) {
##Probably given the name of the config file with no path,
##attempt to prepend the path to it.
warn "Config file $configFile does not exist, assuming that you supplied a bare config and are running from inside the sbin directory\n";
$configFile = File::Spec->canonpath($FindBin::Bin.'/../etc/'.$configFile);
}
die "Unable to use $configFile as a WebGUI config file\n"
unless(-e $configFile and -f _);
my (undef, $directories, $file) = File::Spec->splitpath($configFile);
my $webguiRoot = File::Spec->canonpath(File::Spec->catdir($directories, File::Spec->updir));
my $webguiTest = File::Spec->catdir($webguiRoot, 't');
my $prefix = "WEBGUI_CONFIG=".$configFile;
##Run all tests unless explicitly forbidden
$prefix .= " CODE_COP=1" unless $noLongTests;
# Add coverage tests
$prefix .= " HARNESS_PERL_SWITCHES='-MDevel::Cover=-db,/tmp/coverdb'" if $coverage;
print(join ' ', $prefix, $perlBase."prove", $verboseFlag, '-r', $webguiTest); print "\n";
system(join ' ', $prefix, $perlBase."prove", $verboseFlag, '-r', $webguiTest);
__END__
=head1 NAME
testCodebase - Test WebGUI's code base.
=head1 SYNOPSIS
testCodebase --configFile /data/WebGUI/etc/config.conf
[--coverage]
[--noLongTests]
[--perlBase path]
[--verbose]
testCodebase --help
=head1 DESCRIPTION
This WebGUI utility script tests all of WebGUI's installed code base
using a particular confiuration file. It uses B<prove> to run all
the WebGUI supplied test routines, located in the B<t> subdirectory
of the WebGUI root.
You should B<NOT> use a production config file for testing, since some
of the test may be destructive.
=over
=item B<--configFile /data/WebGUI/etc/config.conf>
A WebGUI config file is required for testing. If one cannot be
found based on input from the user, then the script aborts
without running any tests.
Config files can be supplied on the command line, or via the environment
variable, WEBGUI_CONFIG being used as a fallback. If the config file
cannot be found, the script assumes that a bare filename was provided and
that it is being from from the WebGUI sbin directory. It then looks in
the parallel directory, '../etc', for the config file.
Be aware that some of the tests are destructive, and running tests
on production sites is not recommended.
=item B<--coverage>
Turns on additional L<Devel::Cover> based coverage tests. Note that
this can take a long time to run.
=item B<--noLongTests>
Prevent long tests from being run
=item B<--perlBase path>
Specify a path to an alternative Perl installation you wish to use for the
tests. If left unspecified, it defaults to the Perl installation in the
current PATH.
=item B<--verbose>
Turns on additional information during tests.
=item B<--help>
Shows this documentation, then exits.
=back
=head1 AUTHOR
Copyright 2001-2009 Plain Black Corporation.
=cut

3
t/Config.t
View file

@ -13,7 +13,7 @@ use strict;
use lib "$FindBin::Bin/lib";
use WebGUI::Test;
use Test::More tests => 15; # increment this value for each test you create
use Test::More tests => 14; # increment this value for each test you create
use Test::Deep;
use File::Basename qw(basename);
@ -27,7 +27,6 @@ is( ref $config->get("macros"), "HASH", "get() macros hash" );
is( ref $config->get("assets"), "HASH", "get() assets hash" );
is( ref $config->get("shippingDrivers"), "ARRAY", "get() shippingDrivers array" );
is( $config->getFilename, basename($configFile), "getFilename()" );
is( $config->getWebguiRoot, $webguiRoot, "getWebguiRoot()" );
ok( defined WebGUI::Config->readAllConfigs($webguiRoot), "readAllConfigs" );
$config->addToArray("shippingDrivers","TEST");
my $found = 0;

5
t/Macro/Include.t
View file

@ -13,6 +13,7 @@ use strict;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Paths;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Macro::Include;
@ -23,8 +24,8 @@ my $session = WebGUI::Test->session;
my $i18n = WebGUI::International->new($session, 'Macro_Include');
my $configFile = WebGUI::Test->root .'/etc/'. WebGUI::Test->file;
my $spectreConf = WebGUI::Test->root . '/etc/spectre.conf';
my $configFile = WebGUI::Paths->configBase . '/'. WebGUI::Test->file;
my $spectreConf = WebGUI::Paths->spectreConfig;
my $goodFile = 'The contents of this file are accessible';
my $twoLines = "This file contains two lines of text\nThis is the second line";

3
t/Mail/Send.t
View file

@ -22,6 +22,7 @@ use MIME::Parser;
use Encode qw/decode encode/;
use WebGUI::Test;
use WebGUI::Paths;
use WebGUI::Mail::Send;
@ -134,7 +135,7 @@ SKIP: {
my $numtests = 2; # Number of tests in this block
# Must be able to write the config, or we'll die
if ( !-w File::Spec->catfile( WebGUI::Test::root, 'etc', WebGUI::Test::file() ) ) {
if ( !-w File::Spec->catfile( WebGUI::Paths->configBase, WebGUI::Test->file ) ) {
skip "Cannot test emailOverride: Can't write new configuration value", $numtests;
}

3
t/Spectre/Workflow.t
View file

@ -18,6 +18,7 @@ use Test::More;
use lib "$FindBin::Bin/../lib";
use WebGUI::Test;
use WebGUI::Paths;
use WebGUI::Session;
use Spectre::Admin;
use WebGUI::Config;
@ -35,7 +36,7 @@ plan tests => 19;
$|++;
my $session = WebGUI::Test->session;
my $spectreConfigFile = WebGUI::Test->root . '/etc/spectre.conf';
my $spectreConfigFile = WebGUI::Paths->spectreConfig;
my $spectreConfig = Config::JSON->new($spectreConfigFile);
my $ip = $spectreConfig->get('ip');
my $port = $spectreConfig->get('port');

2
t/WebGUI_conf.t
View file

@ -33,7 +33,7 @@ plan tests => 3; # Increment this number for each test you create
#----------------------------------------------------------------------------
# put your tests here
my $defaultConfigFile = Path::Class::File->new(WebGUI::Test->root, qw/etc WebGUI.conf.original/);
my $defaultConfigFile = Path::Class::File->new(WebGUI::Paths->configBase, 'WebGUI.conf.original');
ok (-e $defaultConfigFile->stringify, 'WebGUI.conf.original exists');

0
lib/default.ttf → var/default.ttf
View file