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

Merge branch 'WebGUI8' into HEAD

Browse source
This commit is contained in:
Graham Knop 2010-04-16 20:52:46 -05:00
commit 373be0881d
871 changed files with 36107 additions and 28933 deletions
Download patch file Download diff file Expand all files Collapse all files

2
sbin/.gitignore vendored
View file

@ -1,2 +0,0 @@
/preload.custom
/preload.exclude

24
sbin/_utility.skeleton
View file

@ -10,31 +10,26 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
$|++; # disable output buffering
our ($webguiRoot, $configFile, $help, $man);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Pod::Usage;
use Getopt::Long;
use WebGUI::Paths -inc;
use WebGUI::Session;
$|++; # disable output buffering
# Get parameters here, including $help
GetOptions(
'configFile=s' => \$configFile,
'help' => \$help,
'man' => \$man,
'configFile=s' => \(my $configFile),
'help' => \(my $help),
'man' => \(my $man),
);
pod2usage( verbose => 1 ) if $help;
pod2usage( verbose => 2 ) if $man;
pod2usage( msg => "Must specify a config file!" ) unless $configFile;
pod2usage( msg => "Must specify a config file!" ) unless $configFile;
my $session = start( $webguiRoot, $configFile );
my $session = start( $configFile );
# Do your work here
finish($session);
@ -43,9 +38,8 @@ finish($session);
#----------------------------------------------------------------------------
sub start {
my $webguiRoot = shift;
my $configFile = shift;
my $session = WebGUI::Session->open($webguiRoot,$configFile);
my $session = WebGUI::Session->open($configFile);
$session->user({userId=>3});
## If your script is adding or changing content you need these lines, otherwise leave them commented

364
sbin/changeIobStatus.pl
View file

@ -1,185 +1,179 @@
#!/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
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use Getopt::Long;
use Pod::Usage;
use strict;
use WebGUI::Session;
use WebGUI::User;
use WebGUI::Inbox;
$|=1;
my $configFile;
my $help;
my $quiet;
my $whatsHappening = "Automatically signed out.";
my $newStatus = "Out";
my $currentStatus = "In";
my $userMessage = "You were logged out of the In/Out Board automatically.";
my $userMessageFile;
GetOptions(
'configfile=s'=>\$configFile,
'help'=>\$help,
'quiet'=>\$quiet,
'whatsHappening:s'=>\$whatsHappening,
'userMessage:s'=>\$userMessage,
'userMessageFile:s'=>\$userMessageFile,
'currentStatus:s'=>\$currentStatus,
'newStatus:s'=>\$newStatus
);
pod2usage( verbose => 2 ) if $help;
pod2usage() unless $configFile;
print "Starting up...\n" unless ($quiet);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
if ($userMessageFile) {
print "Opening message file.." unless ($quiet);
if (open(FILE,"<".$userMessageFile)) {
print "OK\n" unless ($quiet);
my $contents;
while (<FILE>) {
$contents .= $_;
}
close(FILE);
if (length($contents) == 0) {
print "Message file empty, reverting to original message.\n";
} else {
$userMessage = $contents;
}
} else {
print "Failed to open message file.\n";
}
}
print "Searching for users with a status of $currentStatus ...\n" unless ($quiet);
my $userList;
my $now = $session->datetime->time();
my $inbox = WebGUI::Inbox->new($session);
my $sth = $session->db->read("select userId,assetId from InOutBoard_status where status=?",[$currentStatus]);
while (my ($userId,$assetId) = $sth->array) {
my $user = WebGUI::User->new($session, $userId);
print "\tFound user ".$user->username."\n" unless ($quiet);
$userList .= $user->username." (".$userId.")\n";
$session->db->write("update InOutBoard_status set dateStamp=?, message=?, status=? where userId=? and assetId=?",[$now, $whatsHappening, $newStatus, $userId, $assetId]);
$session->db->write("insert into InOutBoard_statusLog (userId, createdBy, dateStamp, message, status, assetId) values (?,?,?,?,?,?)",
[$userId,3,$now, $whatsHappening, $newStatus, $assetId]);
$inbox->addMessage({
userId=>$userId,
subject=>"IOB Update",
message=>$userMessage
});
}
if (length($userList) > 0) {
print "Alerting admins of changes\n" unless ($quiet);
my $message = "The following users had their status changed:\n\n".$userList;
$inbox->addMessage({
groupId=>3,
subject=>"IOB Update",
message=>$userMessage
});
}
print "Cleaning up..." unless ($quiet);
$session->var->end;
$session->close;
print "OK\n" unless ($quiet);
__END__
=head1 NAME
changeIobStatus - Automate WebGUI's InOut Board User status switching.
=head1 SYNOPSIS
changeIobStatus --configFile config.conf
[--currentStatus status]
[--newStatus status]
[--userMessage text|--userMessageFile pathname]
[--whatsHappening text]
[--quiet]
changeIobStatus --help
=head1 DESCRIPTION
This WebGUI utility script helps you switch one or more user status
in the InOut Board (IOB). For instance, you might want to run it
from cron each night to automatically mark out all users that haven't
already marked out.
=over
=item B<--configFile config.conf>
The WebGUI config file to use. Only the file name needs to be specified,
since it will be looked up inside WebGUI's configuration directory.
This parameter is required.
=item B<--currentStatus status>
Check users in the IOB having B<status> status. If left unspecified,
it will default to C<In>.
=item B<--newStatus status>
Change users status in the IOB to B<status> status. If left unspecified,
it will default to C<Out>.
=item B<--userMessage msg>
Text of the message to be sent to the user after changing the status.
If left unspecified it will default to
You were logged out of the In/Out Board automatically.
=item B<--userMessageFile pathname>
Pathname to a file whose contents will be sent to the user after changing
the status. Using this option overrides whatever messages is set
with B<--userMessage> (see above).
=item B<--whatsHappening text>
The message attached to the InOut Board when changing status. If left
unspecified it defaults to
Automatically signed out.
=item B<--quiet>
Disable all output unless there's an error.
=item B<--help>
Shows this documentation, then exits.
=back
=head1 AUTHOR
Copyright 2001-2009 Plain Black Corporation.
=cut
#!/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
#-------------------------------------------------------------------
use strict;
use WebGUI::Paths -inc;
use Getopt::Long;
use Pod::Usage;
use WebGUI::Session;
use WebGUI::User;
use WebGUI::Inbox;
$|=1;
my $configFile;
my $help;
my $quiet;
my $whatsHappening = "Automatically signed out.";
my $newStatus = "Out";
my $currentStatus = "In";
my $userMessage = "You were logged out of the In/Out Board automatically.";
my $userMessageFile;
GetOptions(
'configfile=s'=>\$configFile,
'help'=>\$help,
'quiet'=>\$quiet,
'whatsHappening:s'=>\$whatsHappening,
'userMessage:s'=>\$userMessage,
'userMessageFile:s'=>\$userMessageFile,
'currentStatus:s'=>\$currentStatus,
'newStatus:s'=>\$newStatus
);
pod2usage( verbose => 2 ) if $help;
pod2usage() unless $configFile;
print "Starting up...\n" unless ($quiet);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
if ($userMessageFile) {
print "Opening message file.." unless ($quiet);
if (open(FILE,"<".$userMessageFile)) {
print "OK\n" unless ($quiet);
my $contents;
while (<FILE>) {
$contents .= $_;
}
close(FILE);
if (length($contents) == 0) {
print "Message file empty, reverting to original message.\n";
} else {
$userMessage = $contents;
}
} else {
print "Failed to open message file.\n";
}
}
print "Searching for users with a status of $currentStatus ...\n" unless ($quiet);
my $userList;
my $now = time();
my $inbox = WebGUI::Inbox->new($session);
my $sth = $session->db->read("select userId,assetId from InOutBoard_status where status=?",[$currentStatus]);
while (my ($userId,$assetId) = $sth->array) {
my $user = WebGUI::User->new($session, $userId);
print "\tFound user ".$user->username."\n" unless ($quiet);
$userList .= $user->username." (".$userId.")\n";
$session->db->write("update InOutBoard_status set dateStamp=?, message=?, status=? where userId=? and assetId=?",[$now, $whatsHappening, $newStatus, $userId, $assetId]);
$session->db->write("insert into InOutBoard_statusLog (userId, createdBy, dateStamp, message, status, assetId) values (?,?,?,?,?,?)",
[$userId,3,$now, $whatsHappening, $newStatus, $assetId]);
$inbox->addMessage({
userId=>$userId,
subject=>"IOB Update",
message=>$userMessage
});
}
if (length($userList) > 0) {
print "Alerting admins of changes\n" unless ($quiet);
my $message = "The following users had their status changed:\n\n".$userList;
$inbox->addMessage({
groupId=>3,
subject=>"IOB Update",
message=>$userMessage
});
}
print "Cleaning up..." unless ($quiet);
$session->var->end;
$session->close;
print "OK\n" unless ($quiet);
__END__
=head1 NAME
changeIobStatus - Automate WebGUI's InOut Board User status switching.
=head1 SYNOPSIS
changeIobStatus --configFile config.conf
[--currentStatus status]
[--newStatus status]
[--userMessage text|--userMessageFile pathname]
[--whatsHappening text]
[--quiet]
changeIobStatus --help
=head1 DESCRIPTION
This WebGUI utility script helps you switch one or more user status
in the InOut Board (IOB). For instance, you might want to run it
from cron each night to automatically mark out all users that haven't
already marked out.
=over
=item B<--configFile config.conf>
The WebGUI config file to use. Only the file name needs to be specified,
since it will be looked up inside WebGUI's configuration directory.
This parameter is required.
=item B<--currentStatus status>
Check users in the IOB having B<status> status. If left unspecified,
it will default to C<In>.
=item B<--newStatus status>
Change users status in the IOB to B<status> status. If left unspecified,
it will default to C<Out>.
=item B<--userMessage msg>
Text of the message to be sent to the user after changing the status.
If left unspecified it will default to
You were logged out of the In/Out Board automatically.
=item B<--userMessageFile pathname>
Pathname to a file whose contents will be sent to the user after changing
the status. Using this option overrides whatever messages is set
with B<--userMessage> (see above).
=item B<--whatsHappening text>
The message attached to the InOut Board when changing status. If left
unspecified it defaults to
Automatically signed out.
=item B<--quiet>
Disable all output unless there's an error.
=item B<--help>
Shows this documentation, then exits.
=back
=head1 AUTHOR
Copyright 2001-2009 Plain Black Corporation.
=cut

12
sbin/diskUsage.pl
View file

@ -10,16 +10,10 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use Pod::Usage;
use strict;
use WebGUI::Paths -inc;
use WebGUI::Session;
use WebGUI::Asset;
@ -54,7 +48,7 @@ finish($session);
#-------------------------------------------------
sub start {
my $session = WebGUI::Session->open($webguiRoot,$configFile);
my $session = WebGUI::Session->open($configFile);
$session->user({userId=>3});
return $session;
}

27
sbin/fileImport.pl
View file

@ -10,30 +10,24 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot, @nailable);
BEGIN {
$webguiRoot = "..";
@nailable = qw(jpg jpeg png gif);
unshift (@INC, $webguiRoot."/lib");
}
$| = 1;
use strict;
use File::Path;
use File::stat;
use FileHandle;
use Getopt::Long;
use POSIX;
use Pod::Usage;
use strict;
use WebGUI::Paths -inc;
use WebGUI::Asset::File;
use WebGUI::Asset::File::Image;
use WebGUI::Session;
use WebGUI::Storage;
use WebGUI::Utility;
$| = 1;
my @nailable = qw(jpg jpeg png gif);
# TB : Get the time as soon as possible. Use $now as global variable.
# $now is used for skipOlderThan feature.
my $now = time;
@ -89,7 +83,7 @@ my %ListAssetExists;
my %filelisthash;
print "Starting..." unless ($quiet);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
my $session = WebGUI::Session->open($configFile);
$session->user({userId=>3});
print "OK\n" unless ($quiet);
@ -266,14 +260,15 @@ sub buildFileList {
exit 2;
}
my $filename = $session->url->urlize($file);
push(@filelist, {
ext=>$ext,
filename=>$file,
filename=>$filename,
fullPathFile => $fullpathfile,
});
$filelisthash{$file} = $fullpathfile;
print "Found file $file.\n" unless ($quiet);
$filelisthash{$filename} = $fullpathfile;
print "Found file $file as $filename.\n" unless ($quiet);
}
# TB : the recursive call
push(@filelist, buildFileList($now,"$fullpathfile")) if ((-d "$fullpathfile") && $recursive);

16
sbin/galleryImport.pl
View file

@ -10,14 +10,23 @@
# http://www.plainblack.com info@plainblack.com
# -------------------------------------------------------------------
$|=1;
use lib '../lib';
use strict;
use File::Basename ();
use File::Spec;
my $webguiRoot;
BEGIN {
$webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir));
unshift @INC, File::Spec->catdir($webguiRoot, 'lib');
}
$|=1;
use Carp qw( carp croak );
use File::Find;
use Getopt::Long;
use Pod::Usage;
use Scalar::Util qw( blessed );
use WebGUI::Paths -inc;
use WebGUI::Asset::Wobject::Collaboration;
use WebGUI::Asset::Wobject::GalleryAlbum;
use WebGUI::Asset::Wobject::Gallery;
@ -25,6 +34,7 @@ use WebGUI::Asset::Wobject::Folder;
use WebGUI::Asset::Post::Thread;
use WebGUI::Storage;
$|=1;
# custom flags
my ($fromAssetId, $fromPath, $fromAssetUrl, $toId, $toUrl) = undef;
@ -378,7 +388,7 @@ sub start {
pod2usage("$0: Must specify a --configFile");
}
my $session = WebGUI::Session->open("..",$configFile);
my $session = WebGUI::Session->open($configFile);
$session->user({userId=>3});
my $versionTag = WebGUI::VersionTag->getWorking($session);

30
sbin/generateContent.pl
View file

@ -10,19 +10,10 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our $webguiRoot;
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use DBI;
use FileHandle;
use strict;
use Getopt::Long;
use Pod::Usage;
use strict qw(subs vars);
use WebGUI::Paths -inc;
use WebGUI::Session;
use WebGUI::Asset;
@ -46,7 +37,7 @@ pod2usage( verbose => 2 ) if $help;
pod2usage() if ($configFile eq '' || !($assetId||$url) );
# Open WebGUI session
my $session = WebGUI::Session->open($webguiRoot,$configFile);
my $session = WebGUI::Session->open($configFile);
$session->user({userId=>$userId}) if (defined $userId);
$session->scratch->set("personalStyleId", $styleId) if (defined $styleId);
@ -54,23 +45,26 @@ my $asset = undef;
if ($url) {
$asset = WebGUI::Asset->newByUrl($session,$url);
} else {
}
else {
$asset = WebGUI::Asset->newByDynamicClass($session,$assetId);
}
if (defined $asset) {
my $file = undef;
my $file;
if ($toFile) {
$file = FileHandle->new(">$toFile") or die "Can't open file $toFile for writing. $!";
open $file, '>', $toFile or die "Can't open file $toFile for writing. $!";
$session->output->setHandle($file);
}
my $content = $asset->www_view;
unless ($content eq "chunked") {
$session->output->print($content);
$session->output->print($content);
$session->output->setHandle(undef);
}
$file->close if (defined $file);
} else {
close $file
if defined $file;
}
else {
print "Asset not defined!!\n";
}

16
sbin/installClass.pl
View file

@ -11,12 +11,22 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use lib "../lib";
use strict;
use File::Basename ();
use File::Spec;
my $webguiRoot;
BEGIN {
$webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir));
unshift @INC, File::Spec->catdir($webguiRoot, 'lib');
}
use Getopt::Long;
use Pod::Usage;
use WebGUI::Paths -inc;
use WebGUI::Pluggable;
use WebGUI::Session;
use WebGUI::Paths;
$|++;
@ -44,10 +54,10 @@ 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 );
my $session = WebGUI::Session->open( $configFile );
$session->user( { userId => 3 } );
# Install or uninstall the asset

13
sbin/maintenanceMode.pl
View file

@ -10,17 +10,10 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use Pod::Usage;
use strict;
use WebGUI::Paths -inc;
use WebGUI::Session;
my $help;
@ -39,7 +32,7 @@ pod2usage( verbose => 2 ) if $help;
pod2usage() if $configFile eq "";
my $session = WebGUI::Session->open($webguiRoot,$configFile);
my $session = WebGUI::Session->open($configFile);
$session->setting->remove('specialState');
$session->setting->add('specialState','upgrading') unless $stop;
$session->var->end;

4
sbin/preload.custom.example
View file

@ -1,4 +0,0 @@
# Add paths to lib folders where you have custom plugins for WebGUI.
# Note that the folder must contain the same directory structure of
# of WebGUI itself. This file should reside at WebGUI/sbin/preload.custom
/data/Custom/lib

69
sbin/preload.exclude.example
View file

@ -1,69 +0,0 @@
# Create preload.exclude in your WebGUI/sbin directory and add modules to it
# that you don't want to be loaded by modperl. This will decrease the overall
# size of your modperl instances, which will increase performance, and reduce
# memory use.
WebGUI::Auth::LDAP
WebGUI::Asset::Wobject::WSClient
WebGUI::Asset::File::ZipArchive
WebGUI::Asset::Template::HTMLTemplateExpr
WebGUI::Asset::Template::TemplateToolkit
WebGUI::Asset::Wobject::Matrix
WebGUI::Asset::Wobject::HttpProxy
WebGUI::Asset::Sku::Product
WebGUI::Asset::Sku::Donation
WebGUI::Asset::Sku::Subscription
WebGUI::Asset::Sku::FlatDiscount
WebGUI::Asset::Sku::EMSBadge
WebGUI::Asset::Sku::EMSRibbon
WebGUI::Asset::Sku::EMSTicket
WebGUI::Asset::Sku::EMSToken
WebGUI::Asset::Sku
WebGUI::Asset::Wobject::Survey
WebGUI::Asset::Wobject::InOutBoard
WebGUI::Asset::Wobject::Dashboard
WebGUI::Asset::Wobject::EventManagementSystem
WebGUI::Asset::Wobject::ProjectManager
WebGUI::Asset::Wobject::SyndicatedContent
WebGUI::Asset::Wobject::WSClient
WebGUI::Asset::Wobject::MultiSearch
WebGUI::Shop::Vendor
WebGUI::Shop::Transaction
WebGUI::Shop::CartItem
WebGUI::Shop::Cart
WebGUI::Shop::Ship
WebGUI::Shop::Pay
WebGUI::Shop::TransactionItem
WebGUI::Shop::Credit
WebGUI::Shop::AddressBook
WebGUI::Shop::Admin
WebGUI::Shop::PayDriver
WebGUI::Shop::Products
WebGUI::Shop::PayDriver::Cash
WebGUI::Shop::PayDriver::ITransact
WebGUI::Shop::Address
WebGUI::Shop::ShipDriver
WebGUI::Shop::Tax
WebGUI::Shop::ShipDriver::FlatRate
WebGUI::Content::Shop
WebGUI::Macro::AOIHits
WebGUI::Macro::AOIRank
WebGUI::Macro::AdminText
WebGUI::Macro::CanEditText
WebGUI::Macro::CartItemCount
WebGUI::Macro::EditableToggle
WebGUI::Macro::Execute
WebGUI::Macro::FormParam
WebGUI::Macro::GroupAdd
WebGUI::Macro::GroupDelete
WebGUI::Macro::GroupText
WebGUI::Macro::Include
WebGUI::Macro::LastModified
WebGUI::Macro::MiniCart
WebGUI::Macro::Quote
WebGUI::Macro::RootTitle
WebGUI::Macro::SQL
WebGUI::Macro::SpectreCheck
WebGUI::Macro::Splat_random
WebGUI::Macro::URLEncode
WebGUI::Macro::ViewCart
WebGUI::Macro::Widget

81
sbin/preload.perl
View file

@ -1,60 +1,22 @@
use strict;
my $webguiRoot = '/data/WebGUI';
use WebGUI::Paths -preload;
unshift @INC, $webguiRoot . "/lib";
use Log::Log4perl;
use DBI;
use WebGUI;
use WebGUI::Config;
use Apache2::Cookie;
use Apache2::ServerUtil;
# add custom lib directories to library search path
unshift @INC, grep {
if (!-d $_) {
warn "WARNING: Not adding lib directory '$_' from $webguiRoot/sbin/preload.custom: Directory does not exist.\n";
0;
}
else {
1;
}
} readLines($webguiRoot."/sbin/preload.custom");
#----------------------------------------
# Logger
#----------------------------------------
require Log::Log4perl;
Log::Log4perl->init( $webguiRoot."/etc/log.conf" );
#----------------------------------------
# Database connectivity.
#----------------------------------------
#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.
#----------------------------------------
require WebGUI;
require WebGUI::Config;
require WebGUI::Pluggable;
# these modules should always be skipped
my @excludes;
push @excludes, readLines($webguiRoot."/sbin/preload.exclude");
WebGUI::Pluggable::findAndLoad( "WebGUI",
{
exclude => \@excludes,
onLoadFail => sub { warn sprintf 'Error loading %s: %s', @_ },
}
);
require APR::Request::Apache2;
require Apache2::Cookie;
require Apache2::ServerUtil;
Log::Log4perl->init( WebGUI::Paths->logConfig );
DBI->install_driver("mysql");
if ( $ENV{MOD_PERL} ) {
# Add WebGUI to Apache version tokens
my $server = Apache2::ServerUtil->server;
$server->push_handlers(PerlPostConfigHandler => sub {
$server->add_version_component("WebGUI/".$WebGUI::VERSION);
$server->add_version_component('WebGUI/' . $WebGUI::VERSION);
});
}
@ -62,28 +24,7 @@ $| = 1;
print "\nStarting WebGUI ".$WebGUI::VERSION."\n";
#----------------------------------------
# Preload all site configs.
#----------------------------------------
WebGUI::Config->loadAllConfigs($webguiRoot);
# reads lines from a file 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;
}
WebGUI::Config->loadAllConfigs;
1;

12
sbin/purgeWGAccess.pl
View file

@ -10,16 +10,11 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use Pod::Usage;
use File::Find ();
use WebGUI::Paths -inc;
use WebGUI::Config;
local $| = 1; #disable output buffering
@ -31,8 +26,7 @@ GetOptions(
pod2usage( verbose => 2 ) if $help;
pod2usage() if $configFile eq '';
my $config = WebGUI::Config->new($webguiRoot,$configFile);
use File::Find;
my $config = WebGUI::Config->new($configFile);
print "\tRemoving unnecessary .wgaccess files.\n";
my $uploadsPath = $config->get('uploadsPath');

16
sbin/rebuildLineage.pl
View file

@ -10,22 +10,14 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
$| = 1;
use strict;
use Getopt::Long;
use Pod::Usage;
use strict;
use WebGUI::Paths -inc;
use WebGUI::Session;
use WebGUI::Utility;
$| = 1;
my $configFile;
my $help;
my $quiet;
@ -40,7 +32,7 @@ pod2usage( verbose => 2 ) if $help;
pod2usage() unless (defined($configFile) && $configFile ne '');
print "Starting..." unless ($quiet);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
my $session = WebGUI::Session->open($configFile);
print "OK\n" unless ($quiet);
print "Looking for descendant replationships...\n" unless ($quiet);

14
sbin/search.pl
View file

@ -10,15 +10,9 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Getopt::Long;
use WebGUI::Paths -inc;
use WebGUI::Asset;
use WebGUI::Config;
use WebGUI::Session;
@ -47,7 +41,7 @@ GetOptions(
pod2usage( verbose => 2 ) if $help;
if ($configFile) {
my $session = WebGUI::Session->open($webguiRoot, $configFile);
my $session = WebGUI::Session->open($configFile);
if ($indexsite) {
reindexSite($session);
} elsif ($updatesite) {
@ -67,10 +61,10 @@ if ($configFile) {
#-------------------------------------------------------------------
sub reindexAllSites {
my $configs = WebGUI::Config->readAllConfigs($webguiRoot);
my $configs = WebGUI::Config->readAllConfigs;
foreach my $site (keys %{$configs}) {
print "Indexing ".$site."...\n";
my $session = WebGUI::Session->open($webguiRoot,$site);
my $session = WebGUI::Session->open($site);
reindexSite($session);
$session->var->end;
$session->close;

28
sbin/spectre.pl
View file

@ -10,20 +10,16 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use Pod::Usage;
use strict;
use warnings;
use Pod::Usage;
use Getopt::Long;
use File::Spec;
use POE::Component::IKC::ClientLite;
use Spectre::Admin;
use WebGUI::Paths -inc;
use WebGUI::Config;
use JSON;
$|=1; # disable output buffering
my $help;
@ -51,9 +47,7 @@ GetOptions(
pod2usage( verbose => 2 ) if $help;
pod2usage() unless ($ping||$shutdown||$daemon||$run||$test||$status);
require File::Spec;
# Convert to absolute since we'll be changing directory
my $config = WebGUI::Config->new(File::Spec->rel2abs($webguiRoot),"spectre.conf",1);
my $config = WebGUI::Config->new( WebGUI::Paths->spectreConfig, 1);
unless (defined $config) {
print <<STOP;
@ -158,7 +152,17 @@ sub getStatusReport {
return $POE::Component::IKC::ClientLite::error unless defined $result;
$remote->disconnect;
undef $remote;
return $result;
my $pattern = "%8.8s %-9.9s %-30.30s %-22.22s %-15.15s %-20.20s\n";
my $total = 0;
my $output = sprintf $pattern, "Priority", "Status", "Sitename", "Instance Id", "Last Run", "Last Run Time";
foreach my $instance (@{JSON->new->decode($result)}) {
my $originalPriority = ($instance->{priority} - 1) * 10;
my $priority = $instance->{workingPriority}."/".$originalPriority;
$output .= sprintf $pattern, $priority, $instance->{status}, $instance->{sitename}, $instance->{instanceId}, $instance->{lastState}, $instance->{lastRunTime};
$total++;
}
$output .= sprintf "\n%19.19s %4d\n", "Total Workflows", $total;
return $output;
}
__END__

161
sbin/syncToCdn.pl Normal file → Executable file
View file

@ -1,3 +1,5 @@
#!/usr/bin/env perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
#-------------------------------------------------------------------
@ -8,18 +10,13 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our $webguiRoot;
BEGIN {
$webguiRoot = "..";
unshift( @INC, $webguiRoot . "/lib" );
}
use strict;
use Fcntl ':flock';
use Getopt::Long;
use WebGUI::Paths -inc;
use WebGUI::Session;
use WebGUI::Storage;
use Pod::Usage;
my $configFile;
my $help;
@ -32,17 +29,11 @@ GetOptions(
'override' => \$override,
'migrate' => \$migrate,
'quiet' => \$quiet,
'h|help' => \$help,
);
if ( $configFile eq "" ) {
printHelp();
exit 4;
}
if ($help) {
printHelp();
exit 2;
}
pod2usage( { verbose => 2, exitval => 2, } ) if $help;
pod2usage( { exitval => 4, } ) unless $configFile;
# don't want two copies of this to run simultaneously
unless ( flock( DATA, LOCK_EX | LOCK_NB ) ) {
@ -50,61 +41,13 @@ unless ( flock( DATA, LOCK_EX | LOCK_NB ) ) {
exit 3;
}
sub printHelp {
print <<STOP;
Usage: perl $0 --configfile=<webguiConfig>
--configFile WebGUI config file.
Options:
--override This utility is designed to be run as
a privileged user on Linux style systems.
If you wish to run this utility without
being the super user, then use this flag,
but note that it may not work as
intended.
--migrate Migrate entirety of uploads directory to CDN.
Ignore the CDN queue and sync everything.
--help Display this help message and exit.
--quiet Disable output unless there's an error.
EXIT STATUS
The following exit values are returned:
0
Successful execution.
1
Only super user may run the script.
2
Help requested.
3
Only one instance of this script can run at a time.
4
Error during invocation of the command.
5
Content Delivery Network (CDN) is not enabled.
STOP
} ## end sub printHelp
if ( !( $^O =~ /^Win/i ) && $> != 0 && !$override ) {
print "You must be the super user to use this utility.\n";
exit 1;
}
print "Starting..." unless ($quiet);
my $session = WebGUI::Session->open( $webguiRoot, $configFile );
my $session = WebGUI::Session->open( $configFile );
$session->user( { userId => 3 } );
print "OK\n" unless ($quiet);
@ -213,3 +156,91 @@ sub syncUploads {
__DATA__
This exists so flock() code above works.
DO NOT REMOVE THIS DATA SECTION.
__END__
=head1 NAME
syncToCdn - WebGUI interface to a Content Delivery Network.
=head1 SYNOPSIS
syncToCdn.pl --configFile config.conf
[--override]
[--migrate]
[--quiet]
syncToCdn.pl --help
=head1 DESCRIPTION
This WebGUI utility script displays the amount of disk space used by
an asset and it's descendants. It has been modeled after the *nix 'du'
utility.
=over
=item B<--configFile config.conf>
The WebGUI config file to use. Only the file name needs to be specified,
since it will be looked up inside WebGUI's configuration directory.
This parameter is required.
=item B<--override>
This utility is designed to be run as a privileged user on Linux style
systems. If you wish to run this utility without being the super user,
then use this flag, but note that it may not work as intended.
=item B<--migrate>
Migrate entirety of uploads directory to CDN. Ignore the CDN queue and
sync everything.
=item B<--quiet>
Disable output unless there is an error.
=item B<--help>
Shows this documentation, then exits.
=back
=head1 EXIT CODES
The following exit values are returned:
=over 4
=item 0
Successful execution.
=item 1
Only super user may run the script.
=item 2
Help requested.
=item 3
Only one instance of this script can run at a time.
=item 4
Error during invocation of the command.
=item 5
Content Delivery Network (CDN) is not enabled.
=back
=head1 AUTHOR
Copyright 2001-2009 Plain Black Corporation.
=cut

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

29
sbin/testEnvironment.pl
View file

@ -10,15 +10,16 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
use strict;
use File::Basename ();
use File::Spec;
our $webguiRoot;
my $webguiRoot;
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
$webguiRoot = File::Spec->rel2abs(File::Spec->catdir(File::Basename::dirname(__FILE__), File::Spec->updir));
unshift @INC, File::Spec->catdir($webguiRoot, 'lib');
}
use strict;
use CPAN;
use Getopt::Long;
use Pod::Usage;
@ -60,12 +61,12 @@ if ($] >= 5.008) {
##Doing this as a global is not nice, but it works
my $missingModule = 0;
checkModule("LWP", 5.824 );
checkModule("LWP", 5.833 );
checkModule("HTTP::Request", 1.40 );
checkModule("HTTP::Headers", 1.61 );
checkModule("Test::More", 0.61, 2 );
checkModule("Test::More", 0.82, 2 );
checkModule("Test::MockObject", 1.02, 2 );
checkModule("Test::Deep", 0.095, 2 );
checkModule("Test::Deep", 0.095, );
checkModule("Test::Exception", 0.27, 2 );
checkModule("Test::Class", 0.31, 2 );
checkModule("Pod::Coverage", 0.19, 2 );
@ -88,6 +89,7 @@ checkModule("DateTime", 0.4501 );
checkModule("Time::HiRes", 1.9719 );
checkModule("DateTime::Format::Strptime", 1.0800 );
checkModule("DateTime::Format::Mail", 0.3001 );
checkModule("DateTime::Format::HTTP", 0.38 );
checkModule("Image::Magick", "6.0" );
checkModule("Log::Log4perl", 1.20 );
checkModule("Net::LDAP", 0.39 );
@ -95,12 +97,13 @@ checkModule("HTML::Highlight", 0.20 );
checkModule("HTML::TagFilter", 1.03 );
checkModule("HTML::Template", 2.9 );
checkModule("HTML::Template::Expr", 0.07, 2 );
checkModule("Template", 2.20, 2 );
checkModule("XML::FeedPP", 0.40 );
checkModule("JSON", 2.12 );
checkModule("JSON::Any", 1.22 );
checkModule("Config::JSON", "1.3.1" );
checkModule("Config::JSON", '1.5000' );
checkModule("Text::CSV_XS", "0.64" );
checkModule("Net::Subnets", 0.21 );
checkModule("Net::CIDR::Lite", 0.20 );
checkModule("Finance::Quote", 1.15 );
checkModule("POE", 1.005 );
checkModule("POE::Component::IKC::Server", 0.2001 );
@ -126,7 +129,7 @@ checkModule("Class::C3", "0.21" );
checkModule("Params::Validate", "0.91" );
checkModule("Clone", "0.31" );
checkModule('HTML::Packer', "0.4" );
checkModule('JavaScript::Packer', '0.02' );
checkModule('JavaScript::Packer', '0.04' );
checkModule('CSS::Packer', '0.2' );
checkModule('Business::Tax::VAT::Validation', '0.20' );
checkModule('Crypt::SSLeay', '0.57' );
@ -139,6 +142,10 @@ checkModule("Memcached::libmemcached", "0.3102" );
checkModule("Moose", "0.93" );
checkModule("MooseX::Storage", "0.23" );
checkModule("namespace::autoclean", "0.09" );
checkModule("Business::PayPal::API", "0.62" );
checkModule("Locales", "0.10" );
checkModule("Test::Harness", "3.17" );
checkModule("DateTime::Event::ICal", "0.10" );
failAndExit("Required modules are missing, running no more checks.") if $missingModule;

9
sbin/thumbnailer.pl
View file

@ -10,18 +10,12 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
#-----------------------------------------
# A little utility to generate WebGUI
# thumbnails.
#-----------------------------------------
use strict;
use File::stat;
use File::Find ();
use Getopt::Long;
@ -29,6 +23,7 @@ use Pod::Usage;
use Image::Magick;
use WebGUI::Paths -inc;
use WebGUI::Utility;
my $thumbnailSize;

37
sbin/upgrade.pl
View file

@ -10,29 +10,16 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Cwd ();
use File::Path ();
use File::Spec;
use Getopt::Long ();
use Pod::Usage ();
use WebGUI::Paths -inc;
foreach 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;
}
unshift @INC, $libDir;
}
require WebGUI::Config;
require WebGUI::Session;
use WebGUI::Config;
use WebGUI::Session;
my $help;
my $history;
@ -108,14 +95,14 @@ if ($^O =~ /^Win/i) {
} else {
$slash = "/";
}
our $upgradesPath = $webguiRoot.$slash."docs".$slash."upgrades".$slash;
our $upgradesPath = WebGUI::Paths->upgrades;
our (%upgrade, %config);
## Find site configs.
print "\nGetting site configs...\n" unless ($quiet);
my $configs = WebGUI::Config->readAllConfigs($webguiRoot);
my $configs = WebGUI::Config->readAllConfigs;
foreach my $filename (keys %{$configs}) {
print "\tProcessing $filename.\n" unless ($quiet);
$config{$filename}{configFile} = $filename;
@ -130,7 +117,7 @@ foreach my $filename (keys %{$configs}) {
$config{$filename}{mysqlCLI} = $configs->{$filename}->get("mysqlCLI");
$config{$filename}{mysqlDump} = $configs->{$filename}->get("mysqlDump");
$config{$filename}{backupPath} = $configs->{$filename}->get("backupPath");
my $session = WebGUI::Session->open($webguiRoot,$filename);
my $session = WebGUI::Session->open($filename);
($config{$filename}{version}) = $session->db->quickArray("select webguiVersion from webguiVersion order by
dateApplied desc, length(webguiVersion) desc, webguiVersion desc limit 1");
unless ($history) {
@ -141,10 +128,10 @@ foreach my $filename (keys %{$configs}) {
}
unless ($skipDelete) {
print "\tDeleting temp files.\n" unless ($quiet);
my $path = $configs->{$filename}->get("uploadsPath").$slash."temp";
my $path = File::Spec->catdir($configs->{$filename}->get("uploadsPath"), 'temp');
File::Path::rmtree($path) unless ($path eq "" || $path eq "/" || $path eq "/data");
print "\tDeleting file cache.\n" unless ($quiet);
$path = $configs->{$filename}->get("fileCacheRoot")||"/tmp/WebGUICache";
$path = $configs->{$filename}->get("fileCacheRoot") || "/tmp/WebGUICache";
File::Path::rmtree($path) unless ($path eq "" || $path eq "/" || $path eq "/data");
}
}
@ -159,7 +146,7 @@ if ($history) {
print "\nDisplaying upgrade history for each site.\n";
foreach my $file (keys %config) {
print "\n".$file."\n";
my $session = WebGUI::Session->open($webguiRoot,$file);
my $session = WebGUI::Session->open($file);
my $sth = $session->db->read("select * from webguiVersion order by dateApplied asc, webguiVersion asc");
while (my $data = $sth->hashRef) {
print "\t".sprintf("%-8s %-15s %-15s",
@ -220,7 +207,7 @@ foreach my $filename (keys %config) {
$cmd .= " --host=".$config{$filename}{host} if ($config{$filename}{host});
$cmd .= " --port=".$config{$filename}{port} if ($config{$filename}{port});
$cmd .= " --add-drop-table ".$config{$filename}{db}." --result-file="
.$backupTo.$slash.$config{$filename}{db}."_".$upgrade{$upgrade}{from}."_".time.".sql";
.File::Spec->catfile($backupTo, $config{$filename}{db}."_".$upgrade{$upgrade}{from}."_".time.".sql");
unless (system($cmd)) {
print "OK\n" unless ($quiet);
} else {
@ -267,7 +254,7 @@ foreach my $filename (keys %config) {
sleep 1; # Sleep a second to avoid adding asset revisions too quickly
}
chdir($currentPath);
my $session = WebGUI::Session->open($webguiRoot,$filename);
my $session = WebGUI::Session->open($filename);
print "\tSetting site upgrade completed..." unless ($quiet);
$session->setting->remove('specialState');
$session->close();

14
sbin/userImport.pl
View file

@ -10,17 +10,11 @@
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
our ($webguiRoot);
BEGIN {
$webguiRoot = "..";
unshift (@INC, $webguiRoot."/lib");
}
use strict;
use Digest::MD5;
use Getopt::Long;
use Pod::Usage;
use WebGUI::Paths -inc;
use WebGUI::DateTime;
use WebGUI::Group;
use WebGUI::Session;
@ -78,7 +72,7 @@ if (!($^O =~ /^Win/i) && $> != 0 && !$override) {
print "Starting up..." unless ($quiet);
my $session = WebGUI::Session->open($webguiRoot,$configFile);
my $session = WebGUI::Session->open($configFile);
$session->user({userId=>3});
open(FILE,"<".$usersFile);
print "OK\n" unless ($quiet);
@ -213,7 +207,7 @@ sub calculateExpireOffset {
}
}
if ($units eq "fixed") {
my $seconds = (($offset - $session->datetime->time()));
my $seconds = (($offset - time()));
if ($seconds < 1) {
return undef;
}
@ -362,7 +356,7 @@ It can be overridden in the import file for specific users.
=item B<--identifier string>
Specify the default password to use for loaded users. It can (and should)
be overriden in the import file for specific users. If left unspecified,
be overridden in the import file for specific users. If left unspecified,
it defaults to B<123qwe>.
=item B<--status status>