Adding the IHP Kit.
This commit is contained in:
JT Smith
parent
fc8808c5c0
commit
55108689b4
11 changed files with 1047 additions and 0 deletions
26
sbin/Hourly/CleanLoginHistory.pm
Normal file
26
sbin/Hourly/CleanLoginHistory.pm
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
package Hourly::CleanLoginHistory;
|
||||
|
||||
my $ageToDelete = 90; # in days, time to wait before deleting from login log
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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::Session;
|
||||
use WebGUI::SQL;
|
||||
|
||||
#-----------------------------------------
|
||||
sub process {
|
||||
WebGUI::SQL->write("delete from userLoginLog where timeStamp<".(time()-(86400*$ageToDelete)));
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
27
sbin/Hourly/DecayKarma.pm
Normal file
27
sbin/Hourly/DecayKarma.pm
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
package Hourly::DecayKarma;
|
||||
|
||||
my $minimumKarma = 0; # won't go below this number
|
||||
my $decayFactor = 1; # amount to remove per hour
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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::Session;
|
||||
use WebGUI::SQL;
|
||||
|
||||
#-----------------------------------------
|
||||
sub process {
|
||||
WebGUI::SQL->write("update users set karma=karma-$decayFactor where karma>".$minimumKarma);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
26
sbin/Hourly/DeleteExpiredEvents.pm
Normal file
26
sbin/Hourly/DeleteExpiredEvents.pm
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
package Hourly::DeleteExpiredEvents;
|
||||
|
||||
my $offset = 0; # in days, time to wait before deleting
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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::Session;
|
||||
use WebGUI::SQL;
|
||||
|
||||
#-----------------------------------------
|
||||
sub process {
|
||||
WebGUI::SQL->write("delete from EventsCalendar_event where endDate<".(time()-(86400*$offset)));
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
25
sbin/Hourly/DeleteExpiredGroupings.pm
Normal file
25
sbin/Hourly/DeleteExpiredGroupings.pm
Normal file
|
|
@ -0,0 +1,25 @@
|
|||
package Hourly::DeleteExpiredGroupings;
|
||||
|
||||
my $offset = 0; # in seconds, time to wait before deleting
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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::Session;
|
||||
use WebGUI::SQL;
|
||||
|
||||
#-----------------------------------------
|
||||
sub process {
|
||||
WebGUI::SQL->write("delete from groupings where expireDate<".(time()-(86400*$offset)));
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
27
sbin/Hourly/EmptyTrash.pm
Normal file
27
sbin/Hourly/EmptyTrash.pm
Normal file
|
|
@ -0,0 +1,27 @@
|
|||
package Hourly::EmptyTrash;
|
||||
|
||||
#-----------------------------------------
|
||||
# Copyright 2002 Plain Black LLC
|
||||
#-----------------------------------------
|
||||
# Before using this software be sure you
|
||||
# agree to the terms of its license, which
|
||||
# can be found in docs/ihpkit.pdf of this
|
||||
# distribution.
|
||||
#-----------------------------------------
|
||||
# http://www.plainblack.com
|
||||
# info@plainblack.com
|
||||
#-----------------------------------------
|
||||
|
||||
|
||||
use strict;
|
||||
use WebGUI::Operation::Trash;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::SQL;
|
||||
|
||||
#-----------------------------------------
|
||||
sub process {
|
||||
WebGUI::Operation::Trash::www_purgeTrashConfirm();
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
26
sbin/Hourly/TrashExpiredContent.pm
Normal file
26
sbin/Hourly/TrashExpiredContent.pm
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
package Hourly::TrashExpiredContent;
|
||||
|
||||
my $offset = 0; # in seconds, time to wait before deleting
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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::Session;
|
||||
use WebGUI::SQL;
|
||||
|
||||
#-----------------------------------------
|
||||
sub process {
|
||||
WebGUI::SQL->write("update page set parentId=3, endDate=endDate+31536000 where endDate<".(time()-(86400*$offset)));
|
||||
WebGUI::SQL->write("update wobject set pageId=3, endDate=endDate+31536000 where endDate<".(time()-(86400*$offset)));
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
246
sbin/dmImport.pl
Normal file
246
sbin/dmImport.pl
Normal file
|
|
@ -0,0 +1,246 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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, $webUser, @nailable);
|
||||
|
||||
BEGIN {
|
||||
$webguiRoot = "..";
|
||||
$webUser = "apache";
|
||||
@nailable = qw(jpg jpeg png gif tif tiff bmp);
|
||||
unshift (@INC, $webguiRoot."/lib");
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# NO NEED TO MODIFY BELOW THIS LINE
|
||||
|
||||
|
||||
|
||||
$| = 1;
|
||||
|
||||
use File::stat;
|
||||
use Image::Magick;
|
||||
use DBI;
|
||||
use Mysql;
|
||||
use Data::Config;
|
||||
use WebGUI::SQL;
|
||||
use File::Copy qw(cp);
|
||||
use File::Path;
|
||||
use FileHandle;
|
||||
use POSIX;
|
||||
use strict;
|
||||
|
||||
my ($filelist, $dbh, $settings, $config);
|
||||
|
||||
if ($ARGV[0] ne "" && $ARGV[1] ne ""){
|
||||
print "Starting...\n";
|
||||
$filelist = buildFileList($ARGV[0]);
|
||||
$config = getConfig($ARGV[1]);
|
||||
$dbh = connectToDb($config);
|
||||
$settings = getSettings($dbh,$ARGV[3]);
|
||||
addFiles($dbh, $filelist, $settings, $ARGV[0], $ARGV[2], $config);
|
||||
setPrivileges($config) unless ($^O =~ /Win/i);
|
||||
print "Cleaning up...\n";
|
||||
$dbh->disconnect;
|
||||
print "Finished!\n";
|
||||
} else {
|
||||
print "Usage: $0 <pathToFiles> <webguiConfigFile> <wobjectId> [<thumbnailSize>]\n";
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# addFiles(dbHandler, filelistHashRef, webguiSettingsHashRef, pathToCopyFrom)
|
||||
#-----------------------------------------
|
||||
sub addFiles {
|
||||
my ($exists, @files, $filename, $ext, $id, $i, $file1, $file2, $file3, $seq);
|
||||
print "Adding files...\n";
|
||||
($exists) = WebGUI::SQL->quickArray("select count(*) from DownloadManager where wobjectId='$_[4]'",$_[0]);
|
||||
if ($exists) {
|
||||
mkdir($_[5]->{uploadsPath}."/".$_[4]);
|
||||
foreach $filename (keys %{$_[1]}) {
|
||||
print "Processing $filename.\n";
|
||||
$id = getId($_[0]);
|
||||
mkdir($_[5]->{uploadsPath}."/".$_[4]."/".$id);
|
||||
($seq) = WebGUI::SQL->quickArray("select max(sequenceNumber) from DownloadManager_file where wobjectId='$_[4]'",$_[0]);
|
||||
$i = 0;
|
||||
@files = [];
|
||||
foreach $ext (keys %{${$_[1]}{$filename}}) {
|
||||
print "Copying ".${$_[1]}{$filename}{$ext}.".\n";
|
||||
$a = FileHandle->new($_[3]."/".${$_[1]}{$filename}{$ext},"r");
|
||||
binmode($a);
|
||||
$b = FileHandle->new(">".$_[5]->{uploadsPath}."/".$_[4]."/".$id."/".${$_[1]}{$filename}{$ext});
|
||||
binmode($b);
|
||||
cp($a,$b);
|
||||
$a->close;
|
||||
$b->close;
|
||||
createThumbnail(${$_[1]}{$filename}{$ext},$_[5]->{uploadsPath}."/".$_[4]."/".$id,$_[2]->{thumbnailSize});
|
||||
$files[$i] = ${$_[1]}{$filename}{$ext};
|
||||
$i++;
|
||||
}
|
||||
my @files = sort {isIn(getType($b),@nailable) cmp isIn(getType($a),@nailable)} @files;
|
||||
print "Adding $filename to the database.\n";
|
||||
WebGUI::SQL->write("insert into DownloadManager_file (downloadId,wobjectId,fileTitle,downloadFile,
|
||||
groupToView,dateUploaded,alternateVersion1,alternateVersion2,sequenceNumber) values (
|
||||
$id,$_[4],'$filename','$files[0]',2,".time().",'$files[1]','$files[2]',".($seq+1).")",$_[0]);
|
||||
}
|
||||
} else {
|
||||
print "Warning: Download Manager '$_[4]' does not exist. Cannot import files.\n";
|
||||
}
|
||||
print "Finished adding.\n";
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# setPrivileges(webguiSettingsHashRef)
|
||||
#-----------------------------------------
|
||||
sub setPrivileges {
|
||||
print "Setting filesystem privileges.\n";
|
||||
system("chown -R ".$webUser." ".$_[0]->{uploadsPath});
|
||||
print "Privileges set.\n";
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getSettings(dbHandler)
|
||||
#-----------------------------------------
|
||||
sub getSettings {
|
||||
my (%settings);
|
||||
print "Retrieving settings from WebGUI.\n";
|
||||
%settings = WebGUI::SQL->buildHash("select * from settings",$_[0]);
|
||||
print "Settings retrieved.\n";
|
||||
$settings{thumbnailSize} = $_[1] if ($_[1] ne "");
|
||||
return \%settings;
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getConfig(configFilename)
|
||||
#-----------------------------------------
|
||||
sub getConfig {
|
||||
my ($config, $error, %config);
|
||||
print "Getting site config.\n";
|
||||
$config = new Data::Config $webguiRoot.'/etc/'.$_[0] or $error=1;
|
||||
if ($error) {
|
||||
print "Couldn't open config file.\n";
|
||||
exit;
|
||||
} else {
|
||||
foreach ($config->param) {
|
||||
$config{$_} = $config->param($_);
|
||||
}
|
||||
print "Config retrieved.\n";
|
||||
return \%config;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# connectToDb()
|
||||
#-----------------------------------------
|
||||
sub connectToDb {
|
||||
my ($dbh, $error);
|
||||
print "Connecting to database ".${$_[0]}{dsn}." as user ".${$_[0]}{dbuser}.".\n";
|
||||
$dbh = DBI->connect(${$_[0]}{dsn}, ${$_[0]}{dbuser}, ${$_[0]}{dbpass}, { RaiseError => 0, AutoCommit => 1 }) or $error=1;
|
||||
unless ($error) {
|
||||
print "Connection established.\n";
|
||||
return $dbh;
|
||||
} else {
|
||||
print "Error: Could not connect to the database.\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# buildFileList(pathToImportFiles)
|
||||
#-----------------------------------------
|
||||
sub buildFileList {
|
||||
print "Building file list.\n";
|
||||
my (%filelist, @files, $file, $filename, $ext);
|
||||
if (opendir(FILES,$_[0])) {
|
||||
@files = readdir(FILES);
|
||||
foreach $file (@files) {
|
||||
unless ($file eq "." || $file eq "..") {
|
||||
$file =~ /(.*?)\.(.*?)$/;
|
||||
$filename = $1;
|
||||
$ext = $2;
|
||||
$filelist{$filename}{$ext} = $file;
|
||||
print "Found file $file.\n";
|
||||
}
|
||||
}
|
||||
closedir(FILES);
|
||||
print "File list complete.\n";
|
||||
return \%filelist;
|
||||
} else {
|
||||
print "Error: Could not open folder.\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# isIn(keyvalue, arrayOfValues)
|
||||
#-----------------------------------------
|
||||
sub isIn {
|
||||
my ($i, @a, @b, @isect, %union, %isect, $e);
|
||||
foreach $e (@_) {
|
||||
if ($a[0] eq "") {
|
||||
$a[0] = $e;
|
||||
} else {
|
||||
$b[$i] = $e;
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
foreach $e (@a, @b) { $union{$e}++ && $isect{$e}++ }
|
||||
@isect = keys %isect;
|
||||
if (defined @isect) {
|
||||
undef @isect;
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getType(filename)
|
||||
#-----------------------------------------
|
||||
sub getType {
|
||||
my ($extension);
|
||||
$extension = $_[0];
|
||||
$extension =~ s/.*\.(.*?)$/$1/;
|
||||
return $extension;
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# createThumbnail(filename,path,thumnailSize)
|
||||
#-----------------------------------------
|
||||
sub createThumbnail {
|
||||
my ($image, $x, $y, $r, $n, $type);
|
||||
$type = getType($_[0]);
|
||||
if (isIn($type, @nailable) && !($_[0] =~ m/thumb-/)) {
|
||||
print "Nailing: $_[1]/$_[0]\n";
|
||||
$image = Image::Magick->new;
|
||||
$image->Read($_[1].'/'.$_[0]);
|
||||
($x, $y) = $image->Get('width','height');
|
||||
$n = $_[2] || 50;
|
||||
$r = $x>$y ? $x / $n : $y / $n;
|
||||
$image->Scale(width=>($x/$r),height=>($y/$r)) if ($r > 0);
|
||||
if (isIn($type, qw(tif tiff bmp))) {
|
||||
$image->Write($_[1].'/thumb-'.$_[0].'.png');
|
||||
} else {
|
||||
$image->Write($_[1].'/thumb-'.$_[0]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getId(dbHandler)
|
||||
#-----------------------------------------
|
||||
sub getId {
|
||||
my ($id);
|
||||
($id) = WebGUI::SQL->quickArray("select nextValue from incrementer where incrementerId='downloadId'",$_[0]);
|
||||
WebGUI::SQL->write("update incrementer set nextValue=nextValue+1 where incrementerId='downloadId'",$_[0]);
|
||||
return $id;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
233
sbin/imImport.pl
Normal file
233
sbin/imImport.pl
Normal file
|
|
@ -0,0 +1,233 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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, $webUser, @nailable);
|
||||
|
||||
BEGIN {
|
||||
$webguiRoot = "..";
|
||||
$webUser = "apache";
|
||||
@nailable = qw(jpg jpeg png gif);
|
||||
unshift (@INC, $webguiRoot."/lib");
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# NO NEED TO MODIFY BELOW THIS LINE
|
||||
|
||||
|
||||
$| = 1;
|
||||
|
||||
use File::stat;
|
||||
use Image::Magick;
|
||||
use DBI;
|
||||
use Mysql;
|
||||
use Data::Config;
|
||||
use WebGUI::SQL;
|
||||
use File::Copy qw(cp);
|
||||
use File::Path;
|
||||
use FileHandle;
|
||||
use POSIX;
|
||||
use strict;
|
||||
|
||||
my ($config, $filelist, $dbh, $settings);
|
||||
|
||||
if ($ARGV[0] ne "" && $ARGV[1] ne ""){
|
||||
print "Starting...\n";
|
||||
$filelist = buildFileList($ARGV[0]);
|
||||
$config = getConfig($ARGV[1]);
|
||||
$dbh = connectToDb($config);
|
||||
$settings = getSettings($dbh,$ARGV[2]);
|
||||
addFiles($dbh, $filelist, $settings, $ARGV[0], $config);
|
||||
setPrivileges($config) unless ($^O =~ /Win/i);
|
||||
print "Cleaning up...\n";
|
||||
$dbh->disconnect;
|
||||
print "Finished!\n";
|
||||
} else {
|
||||
print "Usage: $0 <pathToNewImages> <webguiConfigFile> [<thumbnailSize>]\n";
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# addFiles(dbHandler, filelistHashRef, webguiSettingsHashRef, pathToCopyFrom)
|
||||
#-----------------------------------------
|
||||
sub addFiles {
|
||||
my ($filename, $ext, $id, $a, $b);
|
||||
print "Adding files...\n";
|
||||
mkdir($_[4]->{uploadsPath}."/images");
|
||||
foreach $filename (keys %{$_[1]}) {
|
||||
print "Processing $filename.\n";
|
||||
foreach $ext (keys %{${$_[1]}{$filename}}) {
|
||||
$id = getId($_[0]);
|
||||
print "Copying ".${$_[1]}{$filename}{$ext}.".\n";
|
||||
mkdir($_[4]->{uploadsPath}."/images/".$id);
|
||||
$a = FileHandle->new($_[3]."/".${$_[1]}{$filename}{$ext},"r");
|
||||
binmode($a);
|
||||
$b = FileHandle->new(">".$_[4]->{uploadsPath}."/images/".$id."/".${$_[1]}{$filename}{$ext});
|
||||
binmode($b);
|
||||
cp($a,$b);
|
||||
$a->close;
|
||||
$b->close;
|
||||
createThumbnail(${$_[1]}{$filename}{$ext},
|
||||
$_[4]->{uploadsPath}."/images/".$id,
|
||||
$_[2]->{thumbnailSize});
|
||||
print "Adding $filename to the database.\n";
|
||||
WebGUI::SQL->write("insert into images (imageId,name,filename,userId,username,dateUploaded) values
|
||||
($id,".$dbh->quote($filename).",".$dbh->quote($filename.".".$ext).",3,'Imported',".time().")",$_[0]);
|
||||
}
|
||||
}
|
||||
print "Finished adding.\n";
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getConfig(configFilename)
|
||||
#-----------------------------------------
|
||||
sub getConfig {
|
||||
my ($config, $error, %config);
|
||||
print "Getting site config.\n";
|
||||
$config = new Data::Config $webguiRoot.'/etc/'.$_[0] or $error=1;
|
||||
if ($error) {
|
||||
print "Couldn't open config file.\n";
|
||||
exit;
|
||||
} else {
|
||||
foreach ($config->param) {
|
||||
$config{$_} = $config->param($_);
|
||||
}
|
||||
print "Config retrieved.\n";
|
||||
return \%config;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# setPrivileges(webguiSettingsHashRef)
|
||||
#-----------------------------------------
|
||||
sub setPrivileges {
|
||||
print "Setting filesystem privileges.\n";
|
||||
system("chown -R ".$webUser." ".$_[0]->{uploadsPath});
|
||||
print "Privileges set.\n";
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getSettings(dbHandler)
|
||||
#-----------------------------------------
|
||||
sub getSettings {
|
||||
my (%settings);
|
||||
print "Retrieving settings from WebGUI.\n";
|
||||
%settings = WebGUI::SQL->buildHash("select * from settings",$_[0]);
|
||||
print "Settings retrieved.\n";
|
||||
$settings{thumbnailSize} = $_[1] if ($_[1] ne "");
|
||||
return \%settings;
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# connectToDb()
|
||||
#-----------------------------------------
|
||||
sub connectToDb {
|
||||
my ($config, $dbh, $error);
|
||||
print "Connecting to database ".$_[0]->{dsn}." as user ".$_[0]->{dbuser}.".\n";
|
||||
$dbh = DBI->connect($_[0]->{dsn}, $_[0]->{dbuser}, $_[0]->{dbpass}, { RaiseError => 0, AutoCommit => 1 }) or $error=1;
|
||||
unless ($error) {
|
||||
print "Connection established.\n";
|
||||
return $dbh;
|
||||
} else {
|
||||
print "Error: Could not connect to the database.\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# buildFileList(pathToImportFiles)
|
||||
#-----------------------------------------
|
||||
sub buildFileList {
|
||||
print "Building file list.\n";
|
||||
my (%filelist, @files, $file, $filename, $ext);
|
||||
if (opendir(FILES,$_[0])) {
|
||||
@files = readdir(FILES);
|
||||
foreach $file (@files) {
|
||||
unless ($file eq "." || $file eq "..") {
|
||||
$file =~ /(.*?)\.(.*?)$/;
|
||||
$filename = $1;
|
||||
$ext = $2;
|
||||
if (isIn($ext, @nailable)) {
|
||||
$filelist{$filename}{$ext} = $file;
|
||||
print "Found file $file.\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
closedir(FILES);
|
||||
print "File list complete.\n";
|
||||
return \%filelist;
|
||||
} else {
|
||||
print "Error: Could not open folder.\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# isIn(keyvalue, arrayOfValues)
|
||||
#-----------------------------------------
|
||||
sub isIn {
|
||||
my ($i, @a, @b, @isect, %union, %isect, $e);
|
||||
foreach $e (@_) {
|
||||
if ($a[0] eq "") {
|
||||
$a[0] = $e;
|
||||
} else {
|
||||
$b[$i] = $e;
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
foreach $e (@a, @b) { $union{$e}++ && $isect{$e}++ }
|
||||
@isect = keys %isect;
|
||||
if (defined @isect) {
|
||||
undef @isect;
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getType(filename)
|
||||
#-----------------------------------------
|
||||
sub getType {
|
||||
my ($extension);
|
||||
$extension = $_[0];
|
||||
$extension =~ s/.*\.(.*?)$/$1/;
|
||||
return $extension;
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# createThumbnail(filename,path,thumnailSize)
|
||||
#-----------------------------------------
|
||||
sub createThumbnail {
|
||||
my ($image, $x, $y, $r, $n, $type);
|
||||
$type = getType($_[0]);
|
||||
if (isIn($type, @nailable) && !($_[0] =~ m/thumb-/)) {
|
||||
print "Nailing: $_[1]/$_[0]\n";
|
||||
$image = Image::Magick->new;
|
||||
$image->Read($_[1].'/'.$_[0]);
|
||||
($x, $y) = $image->Get('width','height');
|
||||
$n = $_[2] || 50;
|
||||
$r = $x>$y ? $x / $n : $y / $n;
|
||||
$image->Scale(width=>($x/$r),height=>($y/$r)) if ($r > 0);
|
||||
$image->Write($_[1].'/thumb-'.$_[0]);
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getId(dbHandler)
|
||||
#-----------------------------------------
|
||||
sub getId {
|
||||
my ($id);
|
||||
($id) = WebGUI::SQL->quickArray("select nextValue from incrementer where incrementerId='imageId'",$_[0]);
|
||||
WebGUI::SQL->write("update incrementer set nextValue=nextValue+1 where incrementerId='imageId'",$_[0]);
|
||||
return $id;
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
98
sbin/thumbnailer.pl
Normal file
98
sbin/thumbnailer.pl
Normal file
|
|
@ -0,0 +1,98 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
#-----------------------------------------
|
||||
# A little utility to generate WebGUI
|
||||
# thumbnails.
|
||||
#-----------------------------------------
|
||||
|
||||
use File::stat;
|
||||
use Image::Magick;
|
||||
|
||||
if ($ARGV[0] ne ""){
|
||||
$results = recurseFileSystem($ARGV[0]);
|
||||
} else {
|
||||
print "Usage: $0 <uploadsPath> [<thumbnailSize (50)>]\n";
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# isIn(string, listToCheck)
|
||||
#-----------------------------------------
|
||||
sub isIn {
|
||||
my ($i, @a, @b, @isect, %union, %isect, $e);
|
||||
foreach $e (@_) {
|
||||
if ($a[0] eq "") {
|
||||
$a[0] = $e;
|
||||
} else {
|
||||
$b[$i] = $e;
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
foreach $e (@a, @b) { $union{$e}++ && $isect{$e}++ }
|
||||
@isect = keys %isect;
|
||||
if (defined @isect) {
|
||||
undef @isect;
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# getType(filename)
|
||||
#-----------------------------------------
|
||||
sub getType {
|
||||
my ($extension);
|
||||
$extension = $_[0];
|
||||
$extension =~ s/.*\.(.*?)$/$1/;
|
||||
return $extension;
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# createThumbnail(filename,path)
|
||||
#-----------------------------------------
|
||||
sub createThumbnail {
|
||||
my ($image, $x, $y, $r, $n, $type);
|
||||
$type = getType($_[0]);
|
||||
if (isIn($type, qw(jpg jpeg gif png tif tiff bmp)) && !($_[0] =~ m/thumb-/)) {
|
||||
print "Nailing: $_[1]/$_[0]\n";
|
||||
$image = Image::Magick->new;
|
||||
$image->Read($_[1].'/'.$_[0]);
|
||||
($x, $y) = $image->Get('width','height');
|
||||
$n = $ARGV[1] || 50;
|
||||
$r = $x>$y ? $x / $n : $y / $n;
|
||||
$image->Scale(width=>($x/$r),height=>($y/$r)) if ($r > 0);
|
||||
if (isIn($type, qw(tif tiff bmp))) {
|
||||
$image->Write($_[1].'/thumb-'.$_[0].'.png');
|
||||
} else {
|
||||
$image->Write($_[1].'/thumb-'.$_[0]);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# recurseFileSystem(path)
|
||||
#-----------------------------------------
|
||||
sub recurseFileSystem {
|
||||
my (@filelist, $file);
|
||||
if (opendir(DIR,$_[0])) {
|
||||
@filelist = readdir(DIR);
|
||||
foreach $file (@filelist) {
|
||||
unless ($file eq "." || $file eq "..") {
|
||||
recurseFileSystem($_[0]."/".$file);
|
||||
createThumbnail($file,$_[0]);
|
||||
}
|
||||
}
|
||||
closedir(DIR);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
147
sbin/upgrade.pl
Normal file
147
sbin/upgrade.pl
Normal file
|
|
@ -0,0 +1,147 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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, $mysql);
|
||||
$mysql = "/usr/bin/mysql";
|
||||
$mysqldump = "/usr/bin/mysqldump";
|
||||
$backupDir = $ARGV[0] || "/data/backups";
|
||||
|
||||
BEGIN {
|
||||
$webguiRoot = "..";
|
||||
unshift (@INC, $webguiRoot."/lib");
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
# NO NEED TO MODIFY BELOW THIS LINE
|
||||
|
||||
|
||||
if (!($^O =~ /Win/i) && $> != 0) {
|
||||
print "You must be the super user to use this utility.\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
|
||||
use Data::Config;
|
||||
use DBI;
|
||||
use WebGUI::SQL;
|
||||
|
||||
$|=1;
|
||||
my ($upgrade, @files, $file, $dbh, $config, $dir, %upgrade, %config);
|
||||
|
||||
|
||||
print "\nLooking for upgrade files...\n";
|
||||
if ($^O =~ /Win/i) {
|
||||
$dir = $webguiRoot."\\docs\\upgrades\\";
|
||||
} else {
|
||||
$dir = $webguiRoot."/docs/upgrades/";
|
||||
}
|
||||
opendir(DIR,$dir) or die "Couldn't open $dir\n";
|
||||
@files = readdir(DIR);
|
||||
closedir(DIR);
|
||||
foreach $file (@files) {
|
||||
if ($file =~ /upgrade_(\d+\.\d+.\d+)-(\d+\.\d+\.\d+)\.(\w+)/) {
|
||||
if (checkVersion($1)) {
|
||||
if ($3 eq "sql") {
|
||||
print "Found upgrade script from $1 to $2.\n";
|
||||
$upgrade{$1}{sql} = $dir.$file;
|
||||
} elsif ($3 eq "pl") {
|
||||
print "Found upgrade executable from $1 to $2.\n";
|
||||
$upgrade{$1}{pl} = $dir.$file;
|
||||
}
|
||||
$upgrade{$1}{from} = $1;
|
||||
$upgrade{$1}{to} = $2;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
print "\nGetting site configs...\n";
|
||||
if ($^O =~ /Win/i) {
|
||||
$dir = $webguiRoot."\\etc\\";
|
||||
} else {
|
||||
$dir = $webguiRoot."/etc/";
|
||||
}
|
||||
opendir (DIR,$dir) or die "Can't open $dir\n";
|
||||
@files=readdir(DIR);
|
||||
closedir(DIR);
|
||||
foreach $file (@files) {
|
||||
if ($file =~ /(.*?)\.conf$/ && $file ne "some_other_site.conf") {
|
||||
print "Found $file.\n";
|
||||
$config{$file}{configFile} = $dir.$file;
|
||||
my $config = new Data::Config $config{$file}{configFile};
|
||||
$config{$file}{dsn} = $config->param('dsn');
|
||||
$config{$file}{dsn} =~ /DBI\:mysql\:(\w+).*/;
|
||||
$config{$file}{db} = $1;
|
||||
$config{$file}{dbuser} = $config->param('dbuser');
|
||||
$config{$file}{dbpass} = $config->param('dbpass');
|
||||
$dbh = DBI->connect($config{$file}{dsn},$config{$file}{dbuser},$config{$file}{dbpass});
|
||||
($config{$file}{version}) = WebGUI::SQL->quickArray("select webguiVersion from webguiVersion order by dateApplied desc, webguiVersion desc limit 1",$dbh);
|
||||
$dbh->disconnect;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
print "\nREADY TO BEGIN UPGRADES\n";
|
||||
mkdir($backupDir);
|
||||
mkdir($backupDir."/db");
|
||||
|
||||
foreach $config (keys %config) {
|
||||
while ($upgrade{$config{$config}{version}}{sql} ne "") {
|
||||
$upgrade = $upgrade{$config{$config}{version}}{from};
|
||||
print "\n".$config{$config}{db}." ".$upgrade{$upgrade}{from}."-".$upgrade{$upgrade}{to}."\n";
|
||||
print "\tBacking up $config{$config}{db} ($upgrade{$upgrade}{from}).\n";
|
||||
mkdir($backupDir."/db/".$config{$config}{db});
|
||||
system($mysqldump." -u".$config{$config}{dbuser}." -p".$config{$config}{dbpass}." --add-drop-table ".$config{$config}{db}." > ".$backupDir."/db/".$config{$config}{db}."/".$upgrade{$upgrade}{from}.".sql");
|
||||
print "\tUpgrading to $upgrade{$upgrade}{to}.\n";
|
||||
system($mysql." -u".$config{$config}{dbuser}." -p".$config{$config}{dbpass}." --add-drop-table ".$config{$config}{db}." < ".$upgrade{$upgrade}{sql});
|
||||
$config{$config}{version} = $upgrade{$upgrade}{to};
|
||||
}
|
||||
}
|
||||
|
||||
print "\nUPGRADES COMPLETE\n";
|
||||
|
||||
print "Please restart your web server and test your sites.\n";
|
||||
|
||||
print "\nNOTE: If you have not already done so, please consult\ndocs/gotcha.txt for possible upgrade complications.\n\n";
|
||||
|
||||
|
||||
#-----------------------------------------
|
||||
# checkVersion($versionNumber)
|
||||
#-----------------------------------------
|
||||
# Version number must be 3.5.1 or greater
|
||||
# in order to be upgraded by this utility.
|
||||
#-----------------------------------------
|
||||
sub checkVersion {
|
||||
$_[0] =~ /(\d+)\.(\d+).(\d+)/;
|
||||
if ($1 > 3) {
|
||||
return 1;
|
||||
} elsif ($1 == 3) {
|
||||
if ($2 > 5) {
|
||||
return 1;
|
||||
} elsif ($2 == 5) {
|
||||
if ($3 > 0) {
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
166
sbin/userImport.pl
Normal file
166
sbin/userImport.pl
Normal file
|
|
@ -0,0 +1,166 @@
|
|||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2002 Plain Black LLC.
|
||||
#-------------------------------------------------------------------
|
||||
# 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 ($slash, $webguiRoot, $usersFile, $configFile, $defaultIdentifier);
|
||||
|
||||
BEGIN {
|
||||
$slash = ($^O =~ /Win/i) ? "\\" : "/";
|
||||
$webguiRoot = "..";
|
||||
$usersFile = $ARGV[0];
|
||||
$configFile = $ARGV[1];
|
||||
$defaultIdentifier = $ARGV[2] || "password";
|
||||
unshift (@INC, $webguiRoot.$slash."lib");
|
||||
}
|
||||
|
||||
unless ($usersFile ne "" && $configFile ne "") {
|
||||
print "\nUsage: $0 <pathToUserFile> <webguiConfigFile> [ <defaultIdentifier> ]\n\n";
|
||||
print "User file format:\n";
|
||||
print "\t-Tab delimited fields.\n";
|
||||
print "\t-First row contains field names.\n";
|
||||
print "\t-Valid field names:\n";
|
||||
print "\t\tusername password authMethod ldapURL connectDN\n";
|
||||
print "\t\tfirstName middleName lastName gender birthdate\n";
|
||||
print "\t\temail icq aim msnIM yahooIM cellPhone pager emailToPager\n";
|
||||
print "\t\thomeAddress homeCity homeState homeZip homeCountry homePhone homeURL\n";
|
||||
print "\t\tworkName workAddress workCity workState workZip workCountry workPhone workURL\n";
|
||||
print "\t\ttimeOffset dateFormat timeFormat language discussionLayout INBOXNotifications\n";
|
||||
print "\t\tgroups\n";
|
||||
print "\t-The special field name 'groups' should contain a comma separated list of group ids.\n";
|
||||
print "\n";
|
||||
print "Special cases:\n";
|
||||
print "\t-If no username is specified it will default to 'firstName.lastName'.\n";
|
||||
print "\t-If firstName and lastName or username are not specified, user will be skipped.\n";
|
||||
print "\t-If no identifier is specified, the default identifier will be used.\n";
|
||||
print "\t-If no default identifier is specified 'password' will be used.\n";
|
||||
print "\t-If no authMethod is specified 'WebGUI' will be used.\n";
|
||||
print "\t-Invalid field names will be ignored.\n";
|
||||
print "\t-Blank lines will be ignored.\n";
|
||||
print "\n";
|
||||
exit;
|
||||
}
|
||||
|
||||
use strict;
|
||||
use Data::Config;
|
||||
use WebGUI::SQL;
|
||||
use Digest::MD5 qw(md5_base64);
|
||||
|
||||
$|=1;
|
||||
|
||||
print "Starting...\n";
|
||||
|
||||
my ($i, $dbh, @row, %user, @field, $userId, $first, $dup, $lineNumber, $expireAfter, @group);
|
||||
$first = 1;
|
||||
$dbh = connectToDb();
|
||||
open(FILE,"<".$usersFile);
|
||||
while(<FILE>) {
|
||||
$lineNumber++;
|
||||
%user = ();
|
||||
chomp;
|
||||
@row = split("\t",$_);
|
||||
$i=0;
|
||||
if ($first) {
|
||||
foreach (@row) {
|
||||
chomp;
|
||||
$field[$i] = $_;
|
||||
$i++;
|
||||
}
|
||||
$first = 0;
|
||||
} else {
|
||||
foreach (@row) {
|
||||
chomp;
|
||||
$user{$field[$i]} = $_;
|
||||
$user{$field[$i]} =~ s/\s+$//g; #remove trailing whitespace from each field
|
||||
$i++;
|
||||
}
|
||||
$user{username} = $user{firstName}.".".$user{lastName} if ($user{username} eq "" && $user{firstName} ne "" && $user{lastName} ne "");
|
||||
$user{identifier} = $defaultIdentifier if ($user{password} eq "");
|
||||
$user{authMethod} = "WebGUI" if ($user{authMethod} eq "");
|
||||
$user{identifier} = Digest::MD5::md5_base64($user{identifier});
|
||||
($dup) = WebGUI::SQL->quickArray("select count(*) from users where username=".$dbh->quote($user{username}),$dbh);
|
||||
if ($user{username} eq "") {
|
||||
print "Skipping line $lineNumber.\n";
|
||||
} elsif ($dup) {
|
||||
print "User $user{username} already exists. Skipping.\n";
|
||||
} else {
|
||||
print "Adding user $user{username}\n";
|
||||
$user{userId} = getUserId($dbh);
|
||||
WebGUI::SQL->write("insert into users (userId,username,identifier,authMethod,ldapURL,connectDN,dateCreated,lastUpdated) values
|
||||
($user{userId},".$dbh->quote($user{username}).", ".$dbh->quote($user{identifier}).",".$dbh->quote($user{authMethod}).",
|
||||
".$dbh->quote($user{ldapURL}).", ".$dbh->quote($user{connectDN}).",".time().",".time().")",$dbh);
|
||||
foreach (keys %user) {
|
||||
if (isIn($_, qw(discussionLayout INBOXNotifications gender birthdate timeOffset dateFormat timeFormat email language firstName middleName lastName icq aim msnIM yahooIM cellPhone pager emailToPager homeAddress homeCity homeState homeZip homeCountry homePhone homeURL workName workAddress workCity workState workZip workCountry workPhone workURL))) {
|
||||
WebGUI::SQL->write("insert into userProfileData (userId, fieldName, fieldData) values
|
||||
($user{userId}, '$_', ".$dbh->quote($user{$_}).")",$dbh);
|
||||
}
|
||||
}
|
||||
($expireAfter) = WebGUI::SQL->quickArray("select expireAfter from groups where groupId=2",$dbh);
|
||||
$user{groups} =~ s/ //g;
|
||||
@group = split(/,/,$user{groups});
|
||||
foreach (@group) {
|
||||
($expireAfter) = WebGUI::SQL->quickArray("select expireAfter from groups where groupId=$_",$dbh);
|
||||
WebGUI::SQL->write("insert into groupings (groupId,userId,expireDate) values
|
||||
($user{userId},$_,".(time()+$expireAfter).")",$dbh);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
print "Cleaning up...\n";
|
||||
close(FILE);
|
||||
$dbh->disconnect;
|
||||
print "Finished.\n";
|
||||
|
||||
|
||||
#-----------------------------------------
|
||||
sub connectToDb {
|
||||
print "Connecting to database.\n";
|
||||
my ($config, $dbh, $error);
|
||||
$config = new Data::Config $webguiRoot.'/etc/'.$configFile;
|
||||
$dbh = DBI->connect($config->param("dsn"), $config->param("dbuser"), $config->param("dbpass"), { RaiseError => 0, AutoCommit => 1 }) or $error=1;
|
||||
unless ($error) {
|
||||
print "Connection established.\n";
|
||||
return $dbh;
|
||||
} else {
|
||||
print "Error: Could not connect to the database.\n";
|
||||
exit;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
sub isIn {
|
||||
my ($i, @a, @b, @isect, %union, %isect, $e);
|
||||
foreach $e (@_) {
|
||||
if ($a[0] eq "") {
|
||||
$a[0] = $e;
|
||||
} else {
|
||||
$b[$i] = $e;
|
||||
$i++;
|
||||
}
|
||||
}
|
||||
foreach $e (@a, @b) { $union{$e}++ && $isect{$e}++ }
|
||||
@isect = keys %isect;
|
||||
if (defined @isect) {
|
||||
undef @isect;
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
#-----------------------------------------
|
||||
sub getUserId {
|
||||
my ($id);
|
||||
($id) = WebGUI::SQL->quickArray("select nextValue from incrementer where incrementerId='userId'",$_[0]);
|
||||
WebGUI::SQL->write("update incrementer set nextValue=nextValue+1 where incrementerId='userId'",$_[0]);
|
||||
return $id;
|
||||
}
|
||||
|
||||
|
||||
|
||||
Loading…
Add table
Add a link
Reference in a new issue