Testsuite: perl version oddity

[exim.git] / src / src / exiqsumm.src

diff --git a/src/src/exiqsumm.src b/src/src/exiqsumm.src
index f913fe7e880b3f2381db318900aa4342a967a541..3918ab0b83ef77e2d7c45399846f652e406bb022 100644 (file)
--- a/src/src/exiqsumm.src
+++ b/src/src/exiqsumm.src
@@ -1,8 +1,12 @@
-#! PERL_COMMAND -w
-# $Cambridge: exim/src/src/exiqsumm.src,v 1.2 2006/11/20 11:57:57 ph10 Exp $
+#! PERL_COMMAND
 
 # Mail Queue Summary
 # Christoph Lameter, 21 May 1997
+#
+# Copyright (c) The Exim Maintainers 2023
+# SPDX-License-Identifier: GPL-2.0-or-later
+# See the file NOTICE for conditions of use and distribution.
+
 # Modified by Philip Hazel, June 1997
 # Bug fix: June 1998 by Philip Hazel
 #   Message sizes not listed by -bp with K or M
@@ -28,7 +32,7 @@
 #   typo. Fix provided by Chris Liddiard.
 # November 2006 by Jori Hamalainen
 #   Added feature to separate frozen and bounced messages from queue
-#   Adedd feature to list queue per source - destination pair
+#   Added feature to list queue per source - destination pair
 #   Changed regexps to compile once to very minor speed optimization
 #   Short circuit for empty lines
 #
@@ -42,6 +46,17 @@
 
 # Slightly modified sub from eximstats
 
+use warnings;
+BEGIN { pop @INC if $INC[-1] eq '.' };
+use File::Basename;
+
+if (@ARGV && ($ARGV[0] eq '--version' || ($ARGV[0] eq '-v'))) {
+    print basename($0) . ": $0\n",
+        "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n",
+        "perl(runtime): $]\n";
+        exit 0;
+}
+
 sub print_volume_rounded {
 my($x) = pop @_;
 if ($x < 10000)
@@ -107,9 +122,12 @@ if (/^$/o || /^\s*D\s\S+/o) { next; }
 # If it's the first line of a message, pick out the data. Note: it may
 # have text after the final > (e.g. frozen) so don't insist that it ends >.
 
-if (/^([\d\s]{2,3}\w)\s+(\S+)\s(\S+)\s\<(\S*)\>/o)
+if (/^    (?<age>[\d\s]{2,3}\w)
+      \s+  (?<size>\S+)
+      \s   (?<id>\S+)
+      \s\< (?<src>\S*) \>/ox)
   {
-  ($age,$size,$id,$src)=($1,$2,$3,$4);
+  ($age,$size,$id,$src)=($+{age},$+{size},$+{id},$+{src});
   $src =~ s/([^\@]*)\@(.*?)$/$2/o;
   if (/\*\*\*\sfrozen\s\*\*\*/o) { $frozen=1; } else { $frozen=0; }
   if ($src eq "") { $bounce=1; $src="<>"; } else { $bounce=0; }
@@ -140,7 +158,7 @@ elsif (/^\s+[^@]*\@([\w\.\-]+|\[(\d+\.){3}\d+\])/o)
 print "\nCount  Volume  Oldest  Newest  Domain";
 print "\n-----  ------  ------  ------  ------\n\n";
 
-my ($count, $volume, $max_age, $min_age) = (0, 0, "0m", "0000d");
+my ($count, $volume, $max_age, $min_age) = (0, 0, "0m", undef);
 
 foreach $id (sort
             {
@@ -154,10 +172,12 @@ foreach $id (sort
     $queue{$id}, &print_volume_rounded($q_size{$id}), $q_oldest{$id},
     $q_recent{$id}, $id);
     $max_age = $q_oldest{$id} if &older($q_oldest{$id}, $max_age) > 0;
-    $min_age = $q_recent{$id} if &older($min_age, $q_recent{$id}) > 0;
+    $min_age = $q_recent{$id}
+      if (!defined $min_age || &older($min_age, $q_recent{$id}) > 0);
     $volume += $q_size{$id};
     $count += $queue{$id};
   }
+  $min_age ||= "0000d";
 printf("---------------------------------------------------------------\n");
 printf("%5d  %.6s  %6s  %6s  %.80s\n",
   $count, &print_volume_rounded($volume), $max_age, $min_age, "TOTAL");