summaryrefslogtreecommitdiffstats
path: root/src/test/perl/PostgreSQL/Test/SimpleTee.pm
diff options
context:
space:
mode:
Diffstat (limited to 'src/test/perl/PostgreSQL/Test/SimpleTee.pm')
-rw-r--r--src/test/perl/PostgreSQL/Test/SimpleTee.pm63
1 files changed, 63 insertions, 0 deletions
diff --git a/src/test/perl/PostgreSQL/Test/SimpleTee.pm b/src/test/perl/PostgreSQL/Test/SimpleTee.pm
new file mode 100644
index 0000000..ec13714
--- /dev/null
+++ b/src/test/perl/PostgreSQL/Test/SimpleTee.pm
@@ -0,0 +1,63 @@
+
+# Copyright (c) 2021-2022, PostgreSQL Global Development Group
+
+# A simple 'tee' implementation, using perl tie.
+#
+# Whenever you print to the handle, it gets forwarded to a list of
+# handles. The list of output filehandles is passed to the constructor.
+#
+# This is similar to IO::Tee, but only used for output. Only the PRINT
+# method is currently implemented; that's all we need. We don't want to
+# depend on IO::Tee just for this.
+
+# The package is enhanced to add timestamp and elapsed time decorations to
+# the log file traces sent through this interface from Test::More functions
+# (ok, is, note, diag etc.). Elapsed time is shown as the time since the last
+# log trace.
+
+package PostgreSQL::Test::SimpleTee;
+use strict;
+use warnings;
+
+use Time::HiRes qw(time);
+
+my $last_time;
+
+BEGIN { $last_time = time; }
+
+sub _time_str
+{
+ my $tm = time;
+ my $diff = $tm - $last_time;
+ $last_time = $tm;
+ my ($sec, $min, $hour) = localtime($tm);
+ my $msec = int(1000 * ($tm - int($tm)));
+ return sprintf("[%.2d:%.2d:%.2d.%.3d](%.3fs) ",
+ $hour, $min, $sec, $msec, $diff);
+}
+
+sub TIEHANDLE
+{
+ my $self = shift;
+ return bless \@_, $self;
+}
+
+sub PRINT
+{
+ my $self = shift;
+ my $ok = 1;
+ # The first file argument passed to tiehandle in PostgreSQL::Test::Utils is
+ # the original stdout, which is what PROVE sees. Additional decorations
+ # confuse it, so only put out the time string on files after the first.
+ my $skip = 1;
+ my $ts = _time_str;
+ for my $fh (@$self)
+ {
+ print $fh ($skip ? "" : $ts), @_ or $ok = 0;
+ $fh->flush or $ok = 0;
+ $skip = 0;
+ }
+ return $ok;
+}
+
+1;