Recast more internal string routines to use growable-strings
[exim.git] / src / src / exigrep.src
index b678c058472b897b3b44db4a0a436e8a970b5000..5db01fe082e8303356dd9789c125ac4498a7981d 100644 (file)
@@ -2,10 +2,13 @@
 
 use warnings;
 use strict;
 
 use warnings;
 use strict;
-use Pod::Usage;
 BEGIN { pop @INC if $INC[-1] eq '.' };
 
 BEGIN { pop @INC if $INC[-1] eq '.' };
 
-# Copyright (c) 2007-2015 University of Cambridge.
+use Pod::Usage;
+use Getopt::Long;
+use File::Basename;
+
+# Copyright (c) 2007-2017 University of Cambridge.
 # See the file NOTICE for conditions of use and distribution.
 
 # Except when they appear in comments, the following placeholders in this
 # See the file NOTICE for conditions of use and distribution.
 
 # Except when they appear in comments, the following placeholders in this
@@ -34,7 +37,6 @@ BEGIN { pop @INC if $INC[-1] eq '.' };
 # Typical run time acceleration: 4 times
 
 
 # Typical run time acceleration: 4 times
 
 
-use Getopt::Std qw(getopts);
 use POSIX qw(mktime);
 
 
 use POSIX qw(mktime);
 
 
@@ -44,7 +46,7 @@ use POSIX qw(mktime);
 
 sub seconds {
 my($year,$month,$day,$hour,$min,$sec,$tzs,$tzh,$tzm) =
 
 sub seconds {
 my($year,$month,$day,$hour,$min,$sec,$tzs,$tzh,$tzm) =
-  $_[0] =~ /^(\d{4})-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)(?>\s([+-])(\d\d)(\d\d))?/o;
+  $_[0] =~ /^(\d{4})-(\d\d)-(\d\d)\s(\d\d):(\d\d):(\d\d)(?:.\d+)?(?>\s([+-])(\d\d)(\d\d))?/o;
 
 my $seconds = mktime $sec, $min, $hour, $day, $month - 1, $year - 1900;
 
 
 my $seconds = mktime $sec, $min, $hour, $day, $month - 1, $year - 1900;
 
@@ -61,10 +63,17 @@ return $seconds;
 # This subroutine processes a single line (in $_) from a log file. Program
 # defensively against short lines finding their way into the log.
 
 # This subroutine processes a single line (in $_) from a log file. Program
 # defensively against short lines finding their way into the log.
 
-my (%saved, %id_list, $pattern, $queue_time, $insensitive, $invert);
+my (%saved, %id_list, $pattern);
+
+my $queue_time  = -1;
+my $insensitive = 1;
+my $invert      = 0;
+my $related     = 0;
+my $use_pager   = 1;
+my $literal     = 0;
+
 
 # If using "related" option, have to track extra message IDs
 
 # If using "related" option, have to track extra message IDs
-my $related;
 my $related_re='';
 my @Mids = ();
 
 my $related_re='';
 my @Mids = ();
 
@@ -75,7 +84,7 @@ sub do_line {
 if (!/^\d{4}-/o) { $_ =~ s/^.*? exim\b.*?: //o; }
 
 return unless
 if (!/^\d{4}-/o) { $_ =~ s/^.*? exim\b.*?: //o; }
 
 return unless
-  my($date,$id) = /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d (?:[+-]\d{4} )?)(?:\[\d+\] )?(\w{6}\-\w{6}\-\w{2})?/o;
+  my($date,$id) = /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d(?:\.\d+)? (?:[+-]\d{4} )?)(?:\[\d+\] )?(\w{6}\-\w{6}\-\w{2})?/o;
 
 # Handle the case when the log line belongs to a specific message. We save
 # lines for specific messages until the message is complete. Then either print
 
 # Handle the case when the log line belongs to a specific message. We save
 # lines for specific messages until the message is complete. Then either print
@@ -116,7 +125,7 @@ if (defined $id)
   if (index($_, 'Completed') != -1 ||
       index($_, 'SMTP data timeout') != -1 ||
         (index($_, 'rejected') != -1 &&
   if (index($_, 'Completed') != -1 ||
       index($_, 'SMTP data timeout') != -1 ||
         (index($_, 'rejected') != -1 &&
-          /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d (?:[+-]\d{4} )?)(?:\[\d+\] )?\w{6}\-\w{6}\-\w{2} rejected/o))
+          /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d(?:\.\d+)? (?:[+-]\d{4} )?)(?:\[\d+\] )?\w{6}\-\w{6}\-\w{2} rejected/o))
     {
     if ($queue_time != -1 &&
         $saved{$id} =~ /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d ([+-]\d{4} )?)/o)
     {
     if ($queue_time != -1 &&
         $saved{$id} =~ /^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d ([+-]\d{4} )?)/o)
@@ -206,20 +215,44 @@ sub get_related_ids {
 # which is an additional condition. The -M flag will also display "related"
 # loglines (msgid from matched lines is searched in following lines).
 
 # which is an additional condition. The -M flag will also display "related"
 # loglines (msgid from matched lines is searched in following lines).
 
-getopts('Ilvt:Mhm',\my %args);
-$queue_time  = $args{'t'}? $args{'t'} : -1;
-$insensitive = $args{'I'}? 0 : 1;
-$invert      = $args{'v'}? 1 : 0;
-$related     = $args{'M'}? 1 : 0;
-
-pod2usage(-exit => 0, -verbose => 1) if $args{'h'};
-pod2usage(-exit => 0, -verbose => 2, -noperldoc => system('perldoc -V 2>/dev/null >/dev/null'))
-    if $args{'m'};
-pod2usage if not @ARGV;
+GetOptions(
+    'I|sensitive' => sub { $insensitive = 0 },
+      'l|literal' => \$literal,
+      'M|related' => \$related,
+      't|queue-time=i' => \$queue_time,
+      'pager!'         => \$use_pager,
+      'v|invert'       => \$invert,
+      'h|help'         => sub { pod2usage(-exit => 0, -verbose => 1) },
+      'm|man'          => sub {
+        pod2usage(
+            -exit      => 0,
+            -verbose   => 2,
+            -noperldoc => system('perldoc -V 2>/dev/null >&2')
+        );
+      },
+      'version'        => sub {
+            print basename($0) . ": $0\n",
+                "build: EXIM_RELEASE_VERSIONEXIM_VARIANT_VERSION\n",
+                "perl(runtime): $]\n";
+            exit 0;
+      },
+) and @ARGV or pod2usage;
 
 $pattern = shift @ARGV;
 
 $pattern = shift @ARGV;
-$pattern = quotemeta $pattern if $args{l};
+$pattern = quotemeta $pattern if $literal;
 
 
+# Start a pager if output goes to a terminal
+if (-t 1 and $use_pager)
+  {
+  # for perl >= v5.10.x: foreach ($ENV{PAGER}//(), 'less', 'more')
+  foreach (defined $ENV{PAGER} ? $ENV{PAGER} : (), 'less', 'more')
+    {
+    local $ENV{LESS} .= ' --no-init --quit-if-one-screen';
+    open(my $pager, '|-', $_) or next;
+    select $pager;
+    last;
+    }
+  }
 
 # If file arguments are given, open each one and process according as it is
 # is compressed or not.
 
 # If file arguments are given, open each one and process according as it is
 # is compressed or not.
@@ -283,40 +316,47 @@ If no file names are given on the command line, the standard input is read.
 For known file extensions indicating compression (F<.gz>, F<.bz2>, F<.xz>, and F<.lzma>)
 a suitable de-compressor is used, if available.
 
 For known file extensions indicating compression (F<.gz>, F<.bz2>, F<.xz>, and F<.lzma>)
 a suitable de-compressor is used, if available.
 
+The output is sent through a pager if a terminal is connected to STDOUT. As
+pager are considered: C<$ENV{PAGER}>, C<less>, C<more>.
+
 =head1 OPTIONS
 
 =over
 
 =head1 OPTIONS
 
 =over
 
-=item B<-l>
+=item B<-l>|B<--literal>
 
 This means 'literal', that is, treat all characters in the
 pattern  as standing for themselves.  Otherwise the pattern must be a
 Perl regular expression.  The pattern match is case-insensitive.
 
 
 This means 'literal', that is, treat all characters in the
 pattern  as standing for themselves.  Otherwise the pattern must be a
 Perl regular expression.  The pattern match is case-insensitive.
 
-=item B<-t> I<seconds>
+=item B<-t>|B<--queue-time> I<seconds>
 
 Limit the output to messages that spent at least I<seconds> in the
 queue.
 
 
 Limit the output to messages that spent at least I<seconds> in the
 queue.
 
-=item B<-I>
+=item B<-I>|B<--sensitive>
 
 Do a case sensitive search.
 
 
 Do a case sensitive search.
 
-=item B<-v>
+=item B<-v>|B<--invert>
 
 Invert the meaning of the search pattern. That is, print message log
 entries that are not related to that pattern.
 
 
 Invert the meaning of the search pattern. That is, print message log
 entries that are not related to that pattern.
 
-=item B<-M>
+=item B<-M>|B<--related>
 
 Search for related messages too.
 
 
 Search for related messages too.
 
-=item B<-h>
+=item B<--no-pager>
+
+Do not use a pager, even if STDOUT is connected to a terminal.
+
+=item B<-h>|B<--help>
 
 Print a short reference help. For more detailed help try L<exigrep(8)>,
 or C<exigrep -m>.
 
 
 Print a short reference help. For more detailed help try L<exigrep(8)>,
 or C<exigrep -m>.
 
-=item B<-m>
+=item B<-m>|B<--man>
 
 Print this manual page of B<exigrep>.
 
 
 Print this manual page of B<exigrep>.