added the rebuildLineage utility and updated the other utilities not to point to a specific perl

This commit is contained in:
JT Smith 2005-08-01 20:51:05 +00:00
parent 8c2440760f
commit 60103cdd07
9 changed files with 137 additions and 21 deletions

View file

@ -221,6 +221,31 @@ sub addRevision {
#-------------------------------------------------------------------
=head2 addVersionTag ( [ name ] )
A class method. Creates a version tag and assigns the tag to the current user's version tag. Returns the id of the tag created.
=head3 name
The name of the version tag. If not specified, one will be generated using the current user's name along with the date.
=cut
sub addVersionTag {
my $class = shift;
my $name = shift || WebGUI::DateTime::epochToHuman()." / ".$session{user}{username};
my $tagId = WebGUI::SQL->setRow("assetVersionTag","tagId",{
tagId=>"new",
name=>$name,
creationDate=>time(),
createdBy=>$session{user}{userId}
});
WebGUI::Session::setScratch("versionTag",$tagId);
return $tagId;
}
#-------------------------------------------------------------------
=head2 canAdd ( [userId, groupId] )
Verifies that the user has the privileges necessary to add this type of asset. Return a boolean.
@ -2665,13 +2690,7 @@ Adds a version tag and sets the user's default version tag to that.
sub www_addVersionTagSave {
my $self = shift;
return WebGUI::Privilege::insufficient() unless (WebGUI::Grouping::isInGroup(12));
my $tagId = WebGUI::SQL->setRow("assetVersionTag","tagId",{
tagId=>"new",
name=>$session{form}{name},
creationDate=>time(),
createdBy=>$session{user}{userId}
});
WebGUI::Session::setScratch("versionTag",$tagId);
$self->addVersionTag($sesion{form}{name});
return $self->www_manageVersions();
}
@ -2911,6 +2930,9 @@ sub www_editSave {
my $self = shift;
return WebGUI::Privilege::insufficient() unless $self->canEdit;
my $object;
unless($session{setting}{autoCommit} || $session{scratch}{versionTag}) {
$self->addVersionTag;
}
if ($session{form}{assetId} eq "new") {
$object = $self->addChild({className=>$session{form}{class}});
$object->{_parent} = $self;

View file

@ -1,5 +1,3 @@
#!/usr/bin/perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2005 Plain Black Corporation.
#-------------------------------------------------------------------

View file

@ -1,5 +1,3 @@
#!/usr/bin/perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2005 Plain Black Corporation.
#-------------------------------------------------------------------

View file

@ -1,5 +1,3 @@
#!/usr/bin/perl
my $webguiRoot;
BEGIN {

108
sbin/rebuildLineage.pl Normal file
View file

@ -0,0 +1,108 @@
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2005 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");
}
$| = 1;
use Getopt::Long;
use strict;
use WebGUI::Session;
use WebGUI::SQL;
my $configFile;
my $help;
my $quiet;
GetOptions(
'configFile=s'=>\$configFile,
'help'=>\$help,
'quiet'=>\$quiet,
);
if ($help || $configFile eq ""){
print <<STOP;
Usage: perl $0 --configfile=<webguiConfig>
This utility will rebuild your WebGUI Lineage Tree. The lineage tree is an
index that is used to make WebGUI run faster.
WARNING: Use this tool only if you know what you're doing. It should only
be used if somehow your lineage tree has become corrupt (very rare) or if
you have done some massive reorganization of your asset tree and you want
to fill in the gaps between the ranks of your assets. A side effect of
using this utility can be that your assets may no longer be in the same rank
as they once were, which means that they may appear out of order in your
navigation.
--configFile WebGUI config file.
Options:
--help Display this help message and exit.
--quiet Disable output unless there's an error.
STOP
exit;
}
print "Starting..." unless ($quiet);
WebGUI::Session::open($webguiRoot,$configFile);
print "OK\n" unless ($quiet);
print "Rebuilding lineage...\n" unless ($quiet);
my $oldRootLineage = WebGUI::SQL->quickArray("select lineage from asset where assetId='PBasset000000000000001'");
$oldRootLineage = sprintf("%06d",$oldRootLineage);
printChange("Asset ID","Old Lineage","New Lineage");
printChange('PBasset000000000000001',$oldRootLineage,'000001');
WebGUI::SQL->write("update asset set lineage='000001' where assetId='PBasset000000000000001'");
recurseTree("PBasset000000000000001","000001");
print "Cleaning up..." unless ($quiet);
WebGUI::Session::end($session{var}{sessionId});
WebGUI::Session::close();
print "OK\n" unless ($quiet);
sub recurseTree {
my $parentId = shift;
my $parentLineage = shift;
my $rank = 0;
my $getChildren = WebGUI::SQL->prepare("select assetId, lineage from asset where parentId=? order by lineage");
$getChildren->execute([$parentId]);
while (my ($assetId, $oldLineage) = $getChildren->array) {
$rank++;
my $newLineage = $parentLineage.sprintf("%06d",$rank);
printChange($assetId,$oldLineage,$newLineage);
my $setLineage = WebGUI::SQL->prepare("update asset set lineage=? where assetId=?");
$setLineage->execute([$newLineage,$assetId]);
recurseTree($assetId,$newLineage);
}
}
sub printChange {
my $assetId = shift;
my $oldLineage = shift;
my $newLineage = shift;
print sprintf("%-25s",$assetId).sprintf("%-51s",$oldLineage).sprintf("%-51s",$newLineage)."\n" unless ($quiet);
}

View file

@ -1,5 +1,3 @@
#!/usr/bin/perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2005 Plain Black Corporation.
#-------------------------------------------------------------------

View file

@ -1,5 +1,3 @@
#!/usr/bin/perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2005 Plain Black Corporation.
#-------------------------------------------------------------------

View file

@ -1,5 +1,3 @@
#!/usr/bin/perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2005 Plain Black Corporation.
#-------------------------------------------------------------------

View file

@ -1,5 +1,3 @@
#!/usr/bin/perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2005 Plain Black Corporation.
#-------------------------------------------------------------------