view release on metacpan or  search on metacpan

timeput  view on Meta::CPAN

#!/usr/bin/perl
use 5.008 ; use strict ; use warnings ; 
use Getopt::Std ;
use Getopt::Long qw [ GetOptions :config bundling no_ignore_case pass_through ] ; # GetOptionsFromArray ] ;
use Time::HiRes qw[ gettimeofday tv_interval sleep ] ; # Perl 5.7.3からコアモジュール
use Term::ANSIColor qw[ color :constants ] ; $Term::ANSIColor::AUTORESET = 1 ;
use FindBin qw[ $Script ] ; 

sub FB ($){FAINT BOLD $_[0]} 
sub Y ($){YELLOW $_[0]} 

GetOptions 'sleep=f' => \my$sleep ; 
getopts ".:b:c:dgsz:" , \my %o ; 

my ($t0s,$t0p) = gettimeofday ; # 「起動した時刻」の記録。15マイクロ秒のオーバーヘッド
$ENV{TZ} //= $o{z} ; # タイムゾーン

## Ctrl+Z 押下に対する反応 の指定
sub cZ { say STDERR CYAN "$. line(s) output so far. ($Script $$)" ; $SIG{TSTP} ='DEFAULT' ; kill 'TSTP', $$ } ;
$SIG{TSTP} = sub { cZ } ; 
$SIG{CONT} = sub { $SIG{TSTP} = sub { cZ } } ;

$| = 0 eq ($o{b}//'') ? 0 : 1 ; # -b 0 の設定で、バッファリングをしない。($| != 0 ならただちに出力。)

## --sleep 秒数(マイクロ秒単位) での動き
do { & proc_sleep ; exit } if defined $sleep ; 
sub proc_sleep () { 
  while ( <> ) {
    do { my $s = $sleep * $. - tv_interval( [$t0s,$t0p] , [gettimeofday] ) ; sleep $s > 0 ? $s : 0 } ; 
    print $_ ; # print は 2 〜 5 ミリ秒動作に時間がかかる。
  }
}

#$o{'.'} //= 3 ; # 秒数の小数点以下桁数の設定
my $dig = $o{'.'} // 0 ; # 桁数 (表示する秒の小数点以下の桁数)
my $lay = 1e6 / 10 ** $dig if defined $dig ; # lay は英語の「置く」のつもり。100万未満のマイクロ秒に対して、割る数。
* gapproc = $o{g} ? sub (){ ($t0s, $t0p) = gettimeofday } : sub (){} ; # 50ナノ秒のオーバーヘッド。1回の実行につき。

my $HMS0 = '%02d:%02d:%02d' ; #　何度も使われる書式
my $HMSd = "$HMS0.%0${dig}d" ; #　何度も使われる書式
my $dHMS0 = "%02d-%02d-%02d $HMS0" ; 
my $dHMSd = "%02d-%02d-%02d $HMSd" ; 

do { & main ; exit } ; 

sub hms0 () { sprintf $HMS0 , @{[localtime]}[2,1,0] }
sub hmsD () { my($s,$m)=gettimeofday ; sprintf $HMSd, @{[localtime $s]}[2,1,0], int $m/$lay }
sub Dhms0 () { my @f=localtime;$f[4]+=1;$f[5]+=1900 ; sprintf $dHMS0 , @f[5,4,3,2,1,0] }
sub DhmsD () { my($s,$m)=gettimeofday ; my @f=localtime $s;$f[4]+=1;$f[5]+=1900 ; sprintf $dHMSd , @f[5,4,3,2,1,0],int $m/$lay }
sub secondsSince0 () { return sprintf "%0.0f" , time - $t0s } 
sub secondsSinceD () { return sprintf "%0.${dig}f" , tv_interval [ $t0s, $t0p ] } ;
sub timenow () ;

sub main () { 
  * timenow = $o{d} ? $dig ? * DhmsD : *Dhms0 : $dig ? * hmsD : * hms0 ; 
  * timenow = $o{'.'} ? * secondsSinceD : * secondsSince0 if $o{s} || $o{g} ; 
  my $C = defined $o{c} ? $o{c} eq 0 ? '' : color $o{c} : color 'faint bold' ; # 発色させる
  my $R = defined $o{c} ? $o{c} eq 0 ? '' : color 'reset' : color 'reset' ;    # 発色した場合は、色をリセットさせる
  while (<>) { my $t = timenow ; print "$C$t$R\t$_" ; & gapproc } ;
}

## ヘルプの扱い
sub VERSION_MESSAGE {}
sub HELP_MESSAGE{
    use FindBin qw[ $Script ] ; 
    $ARGV[1] //= '' ;
    open my $FH , '<' , $0 ;
    while(<$FH>){
        s/\$0/$Script/g ;
        print $_ if $ARGV[1] eq 'opt' ? m/^\ +\-/ : s/^=head1// .. s/^=cut// ;