view release on metacpan or  search on metacpan

Harness/TraceHighRes.pm  view on Meta::CPAN

use strict;
package Benchmark::Harness::TraceHighRes;
use base qw(Benchmark::Harness::Trace);
use Benchmark::Harness;
use Benchmark::Harness::Constants;

use vars qw($VERSION); $VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);

### ###########################################################################
sub Initialize {
  my $self = Benchmark::Harness::Trace::Initialize(@_);
  $self->{_startTime} = Time::HiRes::time();

# Things we get for the ProcessInfo element:
#
# W32 Linux   attr : meaning
#  X    X      'm' : virtual memory size (kilobytes)
#       X      'r' : resident set size (kilobytes)
#       X      'u' : user mode time (milliseconds)
#       X      's' : kernel mode time (milliseconds)
#       X      'x' : user + kernal time
#  ?    ?      't' : system time, since process started, from time()
#       X      'p' : percent cpu used since process started

## from i686-linux-64int-ld
#       'euid' => 509,
#       'priority' => 0,
#       'wchan' => 0,
#       'cmndline' => '/usr/local/bin/perl5.8.3 test.pl ',
#       'fname' => 'perl5.8.3',
#       'cmajflt' => 29001,
#       'state' => 'run',
#       'pid' => 24077,
#       'cwd' => '/goto/big/stats/lib/perl/Benchmark',
#       'cminflt' => 10703,
#       'exec' => '/usr/local/bin/perl5.8.3',
#       'uid' => 509,
#       'cstime' => 7000,
#       'minflt' => 7084,
#       'pctcpu' => '0.00',
#       'suid' => 509,
#       'utime' => 0,
#       'pgrp' => 24077,
#       'start' => '1116131498',
#       'gid' => 509,
#       'ttydev' => '/dev/pts/8',
#       'fgid' => 509,
#       'pctmem' => '0.00',
#       'time' => 0,
#       'sess' => 26032,
#       'egid' => 509,
#       'size' => 7208960,
#       'ttynum' => 34824,
#       'stime' => 0,
#       'ctime' => 8000,
#       'sgid' => 509,
#       'flags' => 1048576,
#       'cutime' => 1000,
#       'majflt' => 436,
#       'fuid' => 509,
#       'ppid' => 26032,
#       'rss' => 5177344

if ( $^O ne 'MSWin32' ) { # Assume Linux, for now . . .

  eval 'use Proc::ProcessTable';
  die $@ if $@;
  my $procProcessTbl = new Proc::ProcessTable('cache_ttys' => 1);

  *Benchmark::Harness::Handler::TraceHighRes::reportTraceInfo =
      sub {
          my $self = shift;

          my $processTable = $procProcessTbl->table;
          my $processIdx = $self->[Benchmark::Harness::Handler::HNDLR_PROCESSIDX];

          my $procInfo = $processTable->[$processIdx] if defined($processIdx);
          # Our process idx is probably the same each time through . . .
          unless ( ref($procInfo) && ($procInfo->{pid} == $$) ) {
            my $processIdx = 0;
            for ( @$processTable ) {
              if ( $_->{pid} == $$ ) {
                  $procInfo = $_;