times function Unix, yes, NT, no -Perl NT 
Author Message
 times function Unix, yes, NT, no -Perl NT

)
) 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 »



Wed, 06 Sep 2000 03:00:00 GMT  
 
 [ 2 post ] 

 Relevant Pages 

1. NT, perl, mySQL yes or no?

2. anounce:making Crypt::IDEA under NT, exchange crypted data between Unix and NT

3. PERL(NT) for Win32 and SYSTEM Calls in NT 4.0 (worked in NT 3.51)

4. PERL NT to PERL UNIX communication

5. NT Perl vs UNIX Perl

6. converting unix perl to nt perl

7. Q: Perl for Unix Vs. Perl for NT

8. Perl for NT vs. Perl for Unix

9. Transition from UNIX Perl to NT Perl?

10. exec/system functions on perl for NT using the perl.exe module

11. parse_dir function in File::Listing - wrong time for unix ls output

12. Unix Perl CGI <-> Windows NT Informix

 

 
Powered by phpBB® Forum Software