use strict; use Benchmark::Harness; package Benchmark::Harness::ValuesHighRes; use base qw(Benchmark::Harness::Values); use Benchmark::Harness::Constants; use vars qw($VERSION); $VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/); package Benchmark::Harness::Handler::ValuesHighRes; use base qw(Benchmark::Harness::Handler::Values); use Benchmark::Harness::Constants; use Time::HiRes; =pod =head1 Benchmark::Harness::ValuesHighRes =head2 SYNOPSIS High resolution timing combined with Benchmark::Harness::Values. =head2 Impact This produces a slightly larger XML report than the Values harness, since HighRes times consume more digits than low-res ones. This report will be about 20% larger than that of Trace. =over 8 =item1 MSWin32 Approximately 0.8 millisecond per trace (mostly from *::Trace.pm). =item1 Linux =back =cut ### ########################################################################### sub reportTraceInfo { my $self = shift; # return Benchmark::Harness::Handler::Values::reportTraceInfo($self, return Benchmark::Harness::Handler::reportTraceInfo($self, { 't' => ( Time::HiRes::time() - $self->[HNDLR_HARNESS]->{_startTime} ) } ,@_ ); } ### ########################################################################### #sub reportValueInfo { # my $self = shift; # return Benchmark::Harness::Handler::Values::reportValueInfo($self, # ,@_ # ); #} ### ########################################################################### # USAGE: Benchmark::HarnessVlauesHighRes::OnSubEntry('class::method', sub OnSubEntry { my $self = shift; my $i=1; for ( @_ ) { $self->NamedObjects($i, $_); last if ( $i++ == 20 ); } if ( scalar(@_) > 20 ) { ##$self->print(""); }; $self->reportTraceInfo();#(shift, caller(1)); return @_; # return the input arguments unchanged. } ### ########################################################################### # USAGE: Benchmark::Trace::MethodReturn('class::method', [, 'class::method' ] ) sub OnSubExit { my $self = shift; if (wantarray) { my $i=1; for ( @_ ) { $self->NamedObjects($i, $_) if defined $_; last if ( $i++ == 20 ); } if ( scalar(@_) > 20 ) { ##$self->print(""); }; } else { scalar $self->NamedObjects('0', $_[0]) if defined $_[0]; } $self->reportTraceInfo();#(shift, caller(1)); return @_; } ### ########################################################################### =head1 AUTHOR Glenn Wood, =head1 COPYRIGHT Copyright (C) 2004 Glenn Wood. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1;