345 lines
6.7 KiB
Perl
Executable file
345 lines
6.7 KiB
Perl
Executable file
#!/usr/bin/perl -w
|
|
|
|
=pod
|
|
|
|
=head1 NAME
|
|
|
|
teetime - Save stdin including timing
|
|
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
... | teetime [-a] I<file> | ...
|
|
|
|
teetime [-f <factor>] [-m <maxwait>] -i I<file>
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
B<teetime> saves stdin (standard input) to a file just like B<tee>.
|
|
|
|
Unlike B<tee> B<teetime> also timestamps input so it can be played
|
|
back with the same pauses.
|
|
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 4
|
|
|
|
=item B<--append>
|
|
|
|
=item B<-a>
|
|
|
|
Instead of overwriting I<file>, append to I<file>.
|
|
|
|
|
|
=item B<--factor> I<factor>
|
|
|
|
=item B<-f> I<factor>
|
|
|
|
Play back I<factor> times faster. 1.0 = actual speed.
|
|
|
|
|
|
=item B<--input>
|
|
|
|
=item B<-i>
|
|
|
|
Read I<file> as input. Use - to read from standard input.
|
|
|
|
|
|
=item B<--maxwait> I<maxwait>
|
|
|
|
=item B<-m> I<maxwait>
|
|
|
|
Wait at most I<maxwait> seconds.
|
|
|
|
=back
|
|
|
|
|
|
=head1 EXAMPLES
|
|
|
|
(sleep 0.5; echo After 0.5s; sleep 1.5; echo After 2s) |
|
|
teetime myfile.tt
|
|
(sleep 0.5; echo After 2.5s; sleep 1.5; echo After 4s) |
|
|
teetime -a myfile.tt
|
|
teetime -i myfile.tt
|
|
|
|
Play file using stdin:
|
|
|
|
cat myfile.tt | teetime -i -
|
|
|
|
Play it faster:
|
|
|
|
teetime -f 2 -i myfile.tt
|
|
|
|
=head1 File format
|
|
|
|
The .tt-format is simply:
|
|
|
|
Version: "TTM1"
|
|
Repeat: (
|
|
Wait ms: Unsigned 32-bit
|
|
Length of string: Unsigned 32-bit
|
|
String: string
|
|
)
|
|
|
|
=head1 AUTHOR
|
|
|
|
Copyright (C) 2020-2023 Ole Tange,
|
|
http://ole.tange.dk and Free Software Foundation, Inc.
|
|
|
|
|
|
=head1 LICENSE
|
|
|
|
Copyright (C) 2012 Free Software Foundation, Inc.
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 3 of the License, or
|
|
at your option any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
=head1 DEPENDENCIES
|
|
|
|
B<teetime> uses B<perl>.
|
|
|
|
|
|
=head1 SEE ALSO
|
|
|
|
B<tee>
|
|
|
|
|
|
=cut
|
|
|
|
sub bashtest1 {
|
|
q{
|
|
rand -s 8 | head -c 1G | teetime - |mbuffer -q | teetime -i - | pv | md5sum
|
|
rand -s 8 | head -c 1G | pv | md5sum
|
|
};
|
|
}
|
|
|
|
sub bashtest2 {
|
|
q{
|
|
doit() {
|
|
diff <(rand -s $1 |
|
|
head -c$1 |
|
|
md5sum) <(rand -s $1 |
|
|
teetime - |
|
|
teetime -i - |
|
|
head -c$1 |
|
|
md5sum);
|
|
}
|
|
export -f doit
|
|
find-first-fail -v doit
|
|
};
|
|
}
|
|
|
|
use strict;
|
|
|
|
use Getopt::Long;
|
|
|
|
sub now {
|
|
# Returns time since epoch in ms
|
|
# Uses:
|
|
# @Global::use
|
|
# Returns:
|
|
# $time = in milliseconds
|
|
if(not $Global::use{"Time::HiRes"}) {
|
|
if(eval "use Time::HiRes qw ( time );") {
|
|
eval "sub TimeHiRestime { return Time::HiRes::time };";
|
|
} else {
|
|
eval "sub TimeHiRestime { return time() };";
|
|
}
|
|
$Global::use{"Time::HiRes"} = 1;
|
|
}
|
|
|
|
return TimeHiRestime()*1000;
|
|
}
|
|
|
|
sub readstdin {
|
|
# Read stdin and save it in .tt-format
|
|
# If no file: save to stdout, but do not tee output
|
|
my $file = shift;
|
|
my $last_time = now();
|
|
my $rin = '';
|
|
my $in;
|
|
my ($read, $time, $delta);
|
|
my $fh;
|
|
my $save_to_stdout;
|
|
if(not defined $file or $file eq "-") {
|
|
$save_to_stdout = 1;
|
|
}
|
|
if($save_to_stdout) {
|
|
$fh = *STDOUT;
|
|
$| = 1;
|
|
} else {
|
|
open($fh, ($opt::append ? ">>" : ">"), $file) || die;
|
|
}
|
|
vec($rin, fileno(STDIN), 1) = 1;
|
|
# print FourCC file identifier
|
|
print $fh "TTM1";
|
|
while(1) {
|
|
select($rin,undef,undef,undef);
|
|
$read = sysread(STDIN,$in,1000000);
|
|
$time = now();
|
|
$delta = $time - $last_time;
|
|
print $fh pack("L*",$delta,length $in),$in;
|
|
if(not $save_to_stdout) { print STDOUT $in; }
|
|
$last_time = $time;
|
|
if(not $read) {
|
|
# Select says there is something to read,
|
|
# but there is not => eof
|
|
last;
|
|
}
|
|
}
|
|
close $fh;
|
|
}
|
|
|
|
sub min(@) {
|
|
# Returns:
|
|
# Minimum value of array
|
|
my $min;
|
|
for (@_) {
|
|
# Skip undefs
|
|
defined $_ or next;
|
|
defined $min or do { $min = $_; next; }; # Set $_ to the first non-undef
|
|
$min = ($min < $_) ? $min : $_;
|
|
}
|
|
return $min;
|
|
}
|
|
|
|
sub readfile {
|
|
# Input is in .tt-format
|
|
my $file = shift;
|
|
my $fh;
|
|
if($file eq "-") {
|
|
$fh = *STDIN;
|
|
} else {
|
|
open($fh, "<", $file) || die;
|
|
}
|
|
my $fileformat;
|
|
if(sysread($fh,$fileformat,4)) {
|
|
if($fileformat eq "TTM1") {
|
|
read_ttm1($fh);
|
|
} else {
|
|
error("Unsupported file format: $fileformat");
|
|
}
|
|
}
|
|
}
|
|
|
|
sub read_ttm1 {
|
|
my $fh = shift;
|
|
my $in;
|
|
my $nread;
|
|
while(1) {
|
|
if($nread = sysread($fh,$in,8)) {
|
|
if($nread != 8) { die; }
|
|
# time in ms, length in bytes
|
|
my ($delta,$length) = unpack("L*",$in);
|
|
$delta = min($delta/$opt::factor,$opt::maxwait*1000);
|
|
select(undef,undef,undef,$delta/1000);
|
|
while($nread = sysread($fh,$in,$length)) {
|
|
$length -= $nread;
|
|
print $in;
|
|
}
|
|
} else {
|
|
# Blocking sysread says there is something read,
|
|
# but there is not => eof
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub version() {
|
|
# Returns: N/A
|
|
print join
|
|
("\n",
|
|
"GNU $Global::progname $Global::version",
|
|
"Copyright (C) 2020-2022 Ole Tange, http://ole.tange.dk and Free Software",
|
|
"Foundation, Inc.",
|
|
"License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>",
|
|
"This is free software: you are free to change and redistribute it.",
|
|
"GNU $Global::progname comes with no warranty.",
|
|
"",
|
|
"Web site: https://gitlab.com/ole.tange/tangetools/-/tree/master/${Global::progname}\n",
|
|
);
|
|
}
|
|
|
|
sub help() {
|
|
# Returns: N/A
|
|
print join
|
|
("\n",
|
|
"Usage:",
|
|
"",
|
|
"... | teetime [-a] file | ...",
|
|
"teetime [-m max] [-f factor] -i file",
|
|
"",
|
|
"-a append to file",
|
|
"-f playback speed factor",
|
|
"-i read from file",
|
|
"-m max wait seconds",
|
|
"",
|
|
"See 'man $Global::progname' for details",
|
|
"",);
|
|
}
|
|
|
|
sub error(@) {
|
|
my @w = @_;
|
|
my $prog = $Global::progname || "teetime";
|
|
status(map { ($prog.": Error: ". $_); } @w);
|
|
}
|
|
|
|
sub status(@) {
|
|
my @w = @_;
|
|
my $fh = *STDERR;
|
|
print $fh map { ($_, "\n") } @w;
|
|
flush $fh;
|
|
}
|
|
|
|
sub debug {
|
|
$opt::D or return;
|
|
@_ = grep { defined $_ ? $_ : "" } @_;
|
|
if($opt::D eq "all" or $opt::D eq $_[0]) {
|
|
print @_[1..$#_];
|
|
}
|
|
}
|
|
|
|
|
|
$|=1;
|
|
$Global::progname = "teetime";
|
|
$Global::version = "20221108";
|
|
if(GetOptions("debug|D=s" => \$opt::D,
|
|
"append|a" => \$opt::append,
|
|
"factor|f=s" => \$opt::factor,
|
|
"input|i" => \$opt::input,
|
|
"maxwait|m=s" => \$opt::maxwait,
|
|
"help|h" => \$opt::help,
|
|
"version|V" => \$opt::version)) {
|
|
if($opt::help) {
|
|
help();
|
|
exit(1);
|
|
}
|
|
if($opt::version) {
|
|
version();
|
|
exit(1);
|
|
}
|
|
if($opt::input) {
|
|
$opt::maxwait ||= 1000000;
|
|
$opt::factor ||= 1;
|
|
readfile(@ARGV);
|
|
} else {
|
|
readstdin(@ARGV);
|
|
}
|
|
} else {
|
|
help();
|
|
exit(1);
|
|
}
|