)
) Does anyone use the times function in the NT perl implementation?
)
) Are there any other functions I can call that would give me cpu elapsed time?
That is "performance data." On NT, you get performance data from
certain pseudo-Registry keys. This interface choice means that
you must fetch the entire collection of performance data for all
aspects of the computer and then parse out the particular type of
data (CPU usage) for the particular object (a certain process).
My Win32API::Registry module will let you fetch this data but
then you'll need to use some pretty complex pack/unpack code
to get at the data you want.
You can also run PerfMon to collect performance data. Its GUI
interface makes it pretty easy to select what data to collect
and/or display. Its GUI interface makes it almost impossible
to script.
So you could write a script that works almost exactly like
the Unix "times" command using only Perl 5.004_04 and my
Win32API::Registry module, but it wouldn't be easy at this
point.
If you just want to collect this data a few times or every so
often, then you'd be better off having PerfMon start saving
"Process" performance data to a log file before you start the
script, then later use the GUI to see what resources the
script used.
Below is a Win32::PerfData module I played with for a bit
and a script that exercises it. It doesn't know how to get
to the imporant data, though. It just does the outer 6 layers
of parsing so can tell you about the object about which the
performance data was gathered, not any of the performance
data itself.
--
Tye McQueen Nothing is obvious unless you are overlooking something
http://www.*-*-*.com/ ~tye/ (scripts, links, nothing fancy)
+++++ Start of PerfData.pl +++++
#!/usr/bin/perl -w
use Tie::Registry;
use Win32::PerfData;
exit main();
sub main
{
$Registry->ArrayValues(1);
$Registry->Delimiter("/");
my $PerfLib= $Registry->{"LMachine/Software/"
."Microsoft/Windows NT/CurrentVersion/PerfLib/"}
|| die "Can't open Windows NT/CurrentVersion/Perflib/: $^E\n";
my $nCounters= $PerfLib->{"/Last Counter"}
|| die "Can't get /Last Counter: $^E\n";
my $Perf9= $Registry->{"LMachine/Software/Microsoft/"
."Windows NT/CurrentVersion/PerfLib/009/"}
|| die "Can't open PerfLib/009/: $^E\n";
my $nMaxValData= 0;
if( ! $Perf9->RegQueryInfoKey(
[], [], [], [], [], [], [], [], $nMaxValData, [], [] )
&& 122 != $^E ) {
die "Can't get max value data length for PerfLib/009/: $^E\n";
}
my %Names= ();
{
my $vsNames= "";
$Perf9->RegQueryValueEx( "Counter", [], [], $vsNames, ++$nMaxValData )
|| die "Can't get $nMaxValData-byte list of name strings: $^E\n";
%Names= split( /\0/, $vsNames );
}
my $PerfData= $Registry->{"PerfData/"}
|| die "Can't open PerfData key: $^E\n";
my $sData= "";
my $nSize= 128*1024;
while( ! $PerfData->RegQueryValueEx("Global",[],[],$sData,$nSize) ) {
if( 234 != $^E ) {
die "Can't read $nSize-byte Global performance data: $^E\n";
}
$nSize *= 1.5;
}
my $p= Win32::PerfData->new( \$sData );
my $d= $p->OnlyDataBlock;
my $o= $d->FirstObjectType;
my $nObjs= $d->NumObjectTypes;
my $cd;
print "$nObjs object types:\n";
for( ; 0 < $nObjs--; $o= $o->NextObjectType ) {
print "Object ", $o->ObjectNameTitleIndex, ": ",
$Names{$o->ObjectNameTitleIndex}, "\n";
" instances, ", $o->NumCounters, " counters.\n";
if( 20 < $o->NumInstances ) {
print "\tToo many instances to list.\n";
} elsif( 0 < $o->NumInstances ) {
my $nInsts= $o->NumInstances;
my $id= $o->FirstInstanceDef;
for( ; 0 < $nInsts--; $id= $id->NextInstanceDef ) {
my $cb= $id->OnlyCounterBlock;
my $nCnts= $o->NumCounters;
printf " Instance %s:\n", $id->Name;
#$cd= $o->FirstCounterDef;
#for( ; 0 < $nCnts--; $cd= $cd->NextCounterDef ) {
# printf("\t\tCounter %ld: %s\n",
# CurCntr->CounterNameTitleIndex,
# lpNamesArray[CurCntr->CounterNameTitleIndex]);
#}
}
} else {
my $cb= $o->SingleCounterBlock;
my $nCnts= $o->NumCounters;
#$cd= $o->FirstCounterDef;
#for( ; 0 < $nCnts--; $cd= $cd->NextCounterDef ) {
#for( j=0; j < PerfObj->NumCounters; j++ ) {
# printf( "\tCounter %ld: %s\n", PerfCntr->CounterNameTitleIndex,
# lpNamesArray[PerfCntr->CounterNameTitleIndex] );
#}
}
}
0;
Quote:
}
__END__
void main()
{
PERF_INSTANCE_DEFINITION
L ByteLength
L ParentObjectTitleIndex "Process" if thread, "physdisk" if logdisk
P ParentObjectInstance Instance of parent type that is my parent
L UniqueID or PERF_NO_UNIQUE_ID
L NameOffset
L NameLength in bytes
Name Unicode name
PERF_COUNTER_DEFINITION x NumCounters
L ByteLength
L CounterNameTitleIndex
P CounterNameTitle
L CounterHelpTitleIndex
P CounterHelpTitle
L DefaultScale
L DetailLevel
L CounterType
PERF_SIZE_DWORD _LARGE _ZERO _VARIABLE_LEN
PERF_TYPE_NUMBER _COUNTER _TEXT _ZERO
PERF_NUMBER_HEX _DECIMAL _DEC_1000
PERF_COUNTER_VALUE _RATE _FRACTION _BASE
_ELAPSED _QUEUELEN _HISTOGRAM
PERF_TIMER_TICK _100NS PERF_OBJECT_TIMER
PERF_TEXT_UNICODE _ASCII
PERF_DELTA_COUNTER _BASE
PERF_INVERSE_COUNTER
PERF_MULTI_COUNTER
PERF_DISPLAY_NO_SUFFIX _PERF_SEC _PERCENT _SECONDS _NOSHOW
L CounterSize Size if PERF_TYPE_VARIABLE_LEN
L CounterOffset Offset from _COUNTER_BLOCK to counter data
PERF_COUNTER_BLOCK
L ByteLength
_DATA_BLOCK
{ x NumObjectTypes
_OBJECT_TYPE
_COUNTER_DEFINITION x NumCounters
{ x NumInstances
_INSTANCE_DEFINITION unless only 1 instance
_COUNTER_BLOCK
counter data
}
Quote:
}
first _OBJECT_TYPE= _DATA_BLOCK + HeaderLength
next _OBJECT_TYPE= _OBJECT_TYPE + TotalByteLength
first _INSTANCE_DEFINITION= _OBJECT_TYPE + DefinitionLength
_COUNTER_BLOCK= _INSTANCE_DEFINITION + ByteLength
next _INSTANCE_DEFINITION= _INSTANCE_DEFINITION->_COUNTER_BLOCK + ByteLength
first _COUNTER_DEFINITION= _OBJECT_TYPE + HeaderLength
next _COUNTER_DEFINITION= _COUNTER_DEFINITION + ByteLength
Object= firstObj sData
for( i=0; i < PerfData->NumObjectTypes; i++ )
printf( "\nObject %ld: %s\n", PerfObj->ObjectNameTitleIndex,
lpNamesArray[PerfObj->ObjectNameTitleIndex] );
PerfCntr = FirstCounter( PerfObj );
if( PerfObj->NumInstances > 0 ) {
PerfInst = FirstInstance( PerfObj );
for( k=0; k < PerfObj->NumInstances; k++ ) {
printf( "\n\tInstance %S: \n",
(char *)((PBYTE)PerfInst + PerfInst->NameOffset));
CurCntr = PerfCntr;
for( j=0; j < PerfObj->NumCounters; j++ ) {
printf("\t\tCounter %ld: %s\n",
CurCntr->CounterNameTitleIndex,
lpNamesArray[CurCntr->CounterNameTitleIndex]);
CurCntr = NextCounter( CurCntr );
}
PerfInst = NextInstance( PerfInst );
}
} else {
PtrToCntr = (PPERF_COUNTER_BLOCK) ((PBYTE)PerfObj +
PerfObj->DefinitionLength );
for( j=0; j < PerfObj->NumCounters; j++ ) {
printf( "\tCounter %ld: %s\n", PerfCntr->CounterNameTitleIndex,
lpNamesArray[PerfCntr->CounterNameTitleIndex] );
PerfCntr = NextCounter( PerfCntr );
}
}
PerfObj = NextObject( PerfObj );
}
Quote:
}
----- End of PerfData.pl -----
+++++ Start of Win32/PerfData.pm +++++
#!/usr/bin/perl -w
# PerfData.pm -- Perl module to access performance data from Win32 Registry.
#
# Skip to "=head" line for user documentation.
#
package Win32::PerfData;
use strict;
$VERSION= '0.01'; # will be Released after 1998-02-19
use Carp;
BEGIN {
$PACK= "Win32::PerfData"; # Used in error messages.
Quote:
}
# Required other modules:
use Tie::Registry; # $Registry
use Win32::WinError; # ERROR_*
#Implementation details:
# All objects:
# BUFFER string ref; buffer containing performance data structs
# OFFSET long; within BUFFER to start of current data struct
# While unpacking:
# NEXTFIELD long; offset within BUFFER to next field to unpack
######################################################################
#Package-local variables:
# Names of our subclasses:
use vars qw( $DataBlock $ObjectType $InstanceDef
$CounterDef $CounterBlock $CounterValue );
BEGIN {
$DataBlock= $PACK . "::DataBlock";
$ObjectType= $PACK . "::ObjectType";
$InstanceDef= $PACK . "::InstanceDef";
$CounterDef= $PACK . "::CounterDef";
$CounterBlock= $PACK . "::CounterBlock";
$CounterValue= $PACK . "::CounterValue";
Quote:
}
# Make them all subclasses:
{ no strict 'refs';
Quote:
}
######################################################################
# Preloaded methods go here.
sub new
{
my $class= ref($this) || $this;
my $self= {};
if( ref($data) && "$data" =~ /=/ ) {
$this= $data;
$data= $this->DataBuffer;
}
|| ! defined($offset) || $offset !~ /^\s*[-+]?0/ && 0 == $offset ) {
croak "Usage: ", $class, "->new( \\\$data[, \$offset] );\n";
}
if( ref($this) ) {
$offset +=
...
read more »