tangetools/teetime/teetime

#!/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.


=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
  (sleep 0.5; echo After 2.5s; sleep 1.5; echo After 4s) | teetime -a myfile
  teetime -i myfile

=head1 AUTHOR

Copyright (C) 2020 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

use strict;

use Getopt::Long;

sub now {
    # Returns time since epoch as in seconds with 3 decimals
    # Uses:
    #   @Global::use
    # Returns:
    #   $time = time now with millisecond accuracy
    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 {
    my $file = shift;
    my $last_time = now();    
    my $rin = '';
    my $in;
    my $twogb = 2**31;
    my ($read, $time, $delta);
    open(my $fh, ($opt::append ? ">>" : ">"), $file) || die;
    
    vec($rin, fileno(STDIN), 1) = 1;
    while(1) {
	select($rin,undef,undef,undef);
	$read = sysread(STDIN,$in,$twogb);
	$time = now();
	$delta = $time - $last_time;
	print $fh pack("L*",$delta,length $in),$in;
	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 {
    my $file = shift;
    open(my $fh, "<", $file) || die;
    while(1) {
	my $in;
	if(sysread($fh,$in,8)) {
	    # 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);
	    sysread($fh,$in,$length);	
	    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",
	 "-i  read from file",
	 "-m  max wait seconds",
	 "",
	 "See 'man $Global::progname' for details",
	 "",);
}

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);
}