Merge branch 'master' into WebGUI8.

docs/changelog/7.x.x.txt

@@ -1,3 +1,5 @@
+7.10.25
+
 7.10.24
  - fixed #12318: asset error causes asset manager to fail
  - fixed #12308: error message used scalar as reference

docs/upgrades/upgrade_7.10.23-7.10.24.pl

@@ -1,183 +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
-#-------------------------------------------------------------------
-
-our ($webguiRoot);
-
-BEGIN {
-    $webguiRoot = "../..";
-    unshift (@INC, $webguiRoot."/lib");
-}
-
-use strict;
-use Getopt::Long;
-use WebGUI::Session;
-use WebGUI::Storage;
-use WebGUI::Asset;
-
-
-my $toVersion = '7.10.24';
-my $quiet; # this line required
-
-
-my $session = start(); # this line required
-
-# upgrade functions go here
-addPALastLogTable($session);
-addForkRedirect($session);
-extendBucketName($session);
-fixSurveyQuestionTypes($session);
-
-finish($session); # this line required
-
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub addPALastLogTable {
-    my $session = shift;
-    print "\tAdd a table to keep track of additional Passive Analytics data... " unless $quiet;
-    # and here's our code
-    $session->db->write(<<EOSQL);
-CREATE TABLE IF NOT EXISTS `PA_lastLog` (
-`userId` char(22) CHARACTER SET utf8 COLLATE utf8_bin NOT NULL,
-`assetId` char(22) CHARACTER SET utf8 COLLATE utf8_bin NOT NULL,
-`sessionId` char(22) CHARACTER SET utf8 COLLATE utf8_bin NOT NULL,
-`timeStamp` bigint(20) DEFAULT NULL,
-`url` char(255) NOT NULL,
-PRIMARY KEY (userId, sessionId)
-) ENGINE=MyISAM DEFAULT CHARSET=utf8
-EOSQL
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub addForkRedirect {
-    my $session = shift;
-    print "\tAdd a column to Fork to keep track of late generated redirect URLs... " unless $quiet;
-    # and here's our code
-    $session->db->write(<<EOSQL);
-ALTER TABLE Fork add column redirect CHAR(255);
-EOSQL
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub extendBucketName {
-    my $session = shift;
-    print "\tExtend the size of the bucket name in the bucketLog table for Passive Analytics... " unless $quiet;
-    # and here's our code
-    $session->db->write(<<EOSQL);
-ALTER TABLE bucketLog CHANGE COLUMN Bucket Bucket CHAR(255)
-EOSQL
-    print "DONE!\n" unless $quiet;
-}
-
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-sub fixSurveyQuestionTypes {
-    my $session = shift;
-    print "\tFix bad custom Question Types in the Survey... " unless $quiet;
-    # and here's our code
-    $session->db->write(<<EOSQL);
-update Survey_questionTypes set answers="{}" where answers like 'HASH%';
-EOSQL
-    print "DONE!\n" unless $quiet;
-}
-
-#----------------------------------------------------------------------------
-# Describe what our function does
-#sub exampleFunction {
-#    my $session = shift;
-#    print "\tWe're doing some stuff here that you should know about... " unless $quiet;
-#    # and here's our code
-#    print "DONE!\n" unless $quiet;
-#}
-
-
-# -------------- DO NOT EDIT BELOW THIS LINE --------------------------------
-
-#----------------------------------------------------------------------------
-# Add a package to the import node
-sub addPackage {
-    my $session     = shift;
-    my $file        = shift;
-
-    print "\tUpgrading package $file\n" unless $quiet;
-    # Make a storage location for the package
-    my $storage     = WebGUI::Storage->createTemp( $session );
-    $storage->addFileFromFilesystem( $file );
-
-    # Import the package into the import node
-    my $package = eval {
-        my $node = WebGUI::Asset->getImportNode($session);
-        $node->importPackage( $storage, {
-            overwriteLatest    => 1,
-            clearPackageFlag   => 1,
-            setDefaultTemplate => 1,
-        } );
-    };
-
-    if ($package eq 'corrupt') {
-        die "Corrupt package found in $file.  Stopping upgrade.\n";
-    }
-    if ($@ || !defined $package) {
-        die "Error during package import on $file: $@\nStopping upgrade\n.";
-    }
-
-    return;
-}
-
-#-------------------------------------------------
-sub start {
-    my $configFile;
-    $|=1; #disable output buffering
-    GetOptions(
-        'configFile=s'=>\$configFile,
-        'quiet'=>\$quiet
-    );
-    my $session = WebGUI::Session->open($webguiRoot,$configFile);
-    $session->user({userId=>3});
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->set({name=>"Upgrade to ".$toVersion});
-    return $session;
-}
-
-#-------------------------------------------------
-sub finish {
-    my $session = shift;
-    updateTemplates($session);
-    my $versionTag = WebGUI::VersionTag->getWorking($session);
-    $versionTag->commit;
-    $session->db->write("insert into webguiVersion values (".$session->db->quote($toVersion).",'upgrade',".time().")");
-    $session->close();
-}
-
-#-------------------------------------------------
-sub updateTemplates {
-    my $session = shift;
-    return undef unless (-d "packages-".$toVersion);
-    print "\tUpdating packages.\n" unless ($quiet);
-    opendir(DIR,"packages-".$toVersion);
-    my @files = readdir(DIR);
-    closedir(DIR);
-    my $newFolder = undef;
-    foreach my $file (@files) {
-        next unless ($file =~ /\.wgpkg$/);
-        # Fix the filename to include a path
-        $file       = "packages-" . $toVersion . "/" . $file;
-        addPackage( $session, $file );
-    }
-}
-
-#vim:ft=perl

sbin/findBrokenAssets.pl

@@ -74,6 +74,7 @@ my $sth   = $session->db->read($sql);
 ##Guarantee that we get the most recent revisionDate
 my $max_revision  = $session->db->prepare('select max(revisionDate) from assetData where assetId=?');
 
+print "Checking all assets\n";
 my $count = 1;
 my %classTables;            # Cache definition lookups
 while ( my %row = $sth->hash ) {
@@ -204,6 +205,80 @@ while ( my %row = $sth->hash ) {
 } ## end while ( my %row = $sth->hash)
 $sth->finish;
 $max_revision->finish;
+print "\n";
+
+my $shortcuts = $session->db->quickScalar(q!select count(*) from asset where className='WebGUI::Asset::Shortcut'!);
+if ($shortcuts) {
+    print "Checking for broken shortcuts\n";
+    my $get_shortcut = WebGUI::Asset::Shortcut->getIsa($session, 0, {returnAll => 1});
+    $count = 0;
+    SHORTCUT: while (1) {
+        my $shortcut = eval { $get_shortcut->() };
+        if ( $@ || Exception::Class->caught() ) {
+            ##Do nothing, since it would have been caught above
+            printf "\r%-68s", "No shortcut to check";
+        }
+        elsif (!$shortcut) {
+            last SHORTCUT
+        }
+        else {
+            my $linked_asset = eval { WebGUI::Asset->newPending($session, $shortcut->get('shortcutToAssetId')); };
+            if ( $@ || Exception::Class->caught() || ! $linked_asset ) {
+                printf "\r%-68s", "-- Broken shortcut: ".$shortcut->getId.' pointing to '.$shortcut->get('shortcutToAssetId');
+                if ($delete) {
+                    my $success = $shortcut->purge;
+                    if ($success) {
+                        print "Purged shortcut";
+                    }
+                    else {
+                        print "Could not purge shortcut";
+                    }
+                }
+                print "\n";
+            }
+        }
+        progress( $shortcuts, $count++ ) unless $no_progress;
+    }
+    progress( $shortcuts, $count ) unless $no_progress;
+}
+
+print "\n";
+
+my $file_assets = $session->db->quickScalar(q!select count(*) from asset where className like 'WebGUI::Asset::File%'!);
+if ($file_assets) {
+    print "Checking for broken File Assets\n";
+    my $get_asset = WebGUI::Asset::File->getIsa($session, 0, {returnAll => 1});
+    $count = 0;
+    FILE_ASSET: while (1) {
+        my $file_asset = eval { $get_asset->() };
+        if ( $@ || Exception::Class->caught() ) {
+            ##Do nothing, since it would have been caught above
+            printf "\r%-68s", "No asset to check";
+        }
+        elsif (!$file_asset) {
+            last FILE_ASSET
+        }
+        else {
+            my $storage = $file_asset->getStorageLocation;
+            my $file = $storage->getPath($file_asset->get('filename'));
+            if (! -e $file) {
+                printf "\r%-s", "-- Broken file asset: ".$file_asset->getId." file does not exist: $file";
+                if ($delete) {
+                    my $success = $file_asset->purge;
+                    if ($success) {
+                        print "Purged File Asset";
+                    }
+                    else {
+                        print "Could not purge File Asset";
+                    }
+                }
+                print "\n";
+            }
+        }
+        progress( $file_assets, $count++ ) unless $no_progress;
+    }
+    progress( $file_assets, $count ) unless $no_progress;
+}
 
 finish($session);
 print "\n";
@@ -261,7 +336,20 @@ findBrokenAssets.pl -- Find and fix broken assets
 =head1 DESCRIPTION
 
 This utility will find any broken assets that cannot be instantiated and are 
-causing undesired operation of your website.
+causing undesired operation of your website.  It also checks for these kinds of
+semi-working assets and reports them:
+
+=over 4
+
+=item *
+
+Shortcuts pointing to assets that don't exist.
+
+=item *
+
+File assets that have lost their files in the uploads area.
+
+=back
 
 It can also automatically delete them or fix them so you can restore missing data.
 
@@ -283,7 +371,7 @@ Delete any corrupted assets.
 
 =item B<--fix>
 
-Try to fix any corrupted assets.
+Try to fix any corrupted assets.  The broken Shortcuts and File Assets cannot be fixed.
 
 =item B<--help>