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

lib/WebGUI/Asset.pm

@@ -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",{
+	$self->addVersionTag($sesion{form}{name});
-		tagId=>"new",
-		name=>$session{form}{name},
-		creationDate=>time(),
-		createdBy=>$session{user}{userId}
-		});
-	WebGUI::Session::setScratch("versionTag",$tagId);
 	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;

sbin/fileImport.pl

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

sbin/generateContent.pl

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

sbin/preload.perl

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

sbin/rebuildLineage.pl

@@ -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);
+}
+

sbin/runHourly.pl

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

sbin/thumbnailer.pl

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

sbin/upgrade.pl

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

sbin/userImport.pl

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