[8537] in Perl-Users-Digest
Perl-Users Digest, Issue: 2154 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Mar 21 20:07:28 1998
Date: Sat, 21 Mar 98 17:00:30 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sat, 21 Mar 1998 Volume: 8 Number: 2154
Today's topics:
Re: Can't understand /g (match global) operator - help! <merlyn@stonehenge.com>
Re: HTML::Element::extract_links not grabbing frame sou (Peter G. Martin)
Re: Mail filter package? (I R A Aggie)
Re: need perl script to read utmp files (Gabor)
Re: Perl Daemons <bholzman@mail.earthlink.net>
Perl NT-Unix problem <Mark_Sage@Compuserve.com>
Re: Perl NT-Unix problem <bholzman@mail.earthlink.net>
Q: Add a _special_ CGI handler to Apache? <captain@pirate.de>
Replacing a line of text <e.phillips@tgrweb.com>
Re: Replacing a line of text (A. Deckers)
Re: reset a array? <sneaker@earthling.net>
Re: Sockets (Jason Gloudon)
Spaces in a sentence <melton@diagdata.com>
ssh exit status from perl <ptrainor@bbnplanet.com>
Re: times function Unix, yes, NT, no -Perl NT (Tye McQueen)
Re: Wanted: Perl for Windows 3.x <palincss@tidalwave.net>
Re: Wanted: Perl for Windows 3.x <sneaker@earthling.net>
Re: what is wrong with being a novice ?? (Jeff Yoak)
Win95 glob for filenames returns values but not into ar (JY)
Digest Administrivia (Last modified: 8 Mar 97) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 21 Mar 1998 17:22:48 -0700
From: Randal Schwartz <merlyn@stonehenge.com>
To: brosser@gil.com.au
Subject: Re: Can't understand /g (match global) operator - help!
Message-Id: <8cbtuztvza.fsf@gadget.cscaper.com>
>>>>> "brosser" == brosser <brosser@gil.com.au> writes:
brosser> Hi. I've been writing a simple little lexical scanner
brosser> today, and 'discovered' how wonderful Perl's /g regexp
brosser> operator can be.
brosser> But, near the end of the project, I'm coming a cropper -
brosser> perl's not working the way I'd expect, so there must be
brosser> (many!) things I still don't understand. I'd like to list
brosser> two examples, and if someone could tell me how/why perl
brosser> does what it does I'd be grateful!
First off, clip-n-save the following segment:
$_ = "your string";
while (/your regex/g) {
print join(" : ", map { defined $_ ? $_ : "undef" }
$`, $&, $', $1, $2, $3), "\n";
}
And let's try it on these examples:
brosser> 1. "abc" =~ /([abc])*/g gives (c, undef).
: abc : : c : undef : undef
abc : : : undef : undef : undef
brosser> Why doesn't it match the 'a' first, then the 'b',
brosser> and then the 'c', giving (a,b,c)?
As you can see, it matches the "abc" first. But the contents of the
first memory $1 is *only* the "c".
brosser> And why the trailing
brosser> undef (in all cases where I've used parenthesis and /g)?
On the second round, we're matching the null string *after* abc. There
are 0 [abc]'s there, so it fits.
brosser> 2. "aXa" =~ /(a)*/g gives (a, undef, a, undef)
: a : Xa : a : undef : undef
a : : Xa : undef : undef : undef
aX : a : : a : undef : undef
aXa : : : undef : undef : undef
brosser> which I guess I can understand - at least it's giving
brosser> me both 'a' tokens, although I still don't know why
brosser> the undefs come in.
Right. Matching the first a, then the null string after the first a,
then the "a" after the X, then the null string after that a.
brosser> But
brosser> "aaaaaXa" =~ /(a)*/g also gives (a, undef, a, undef)
: aaaaa : Xa : a : undef : undef
aaaaa : : Xa : undef : undef : undef
aaaaaX : a : : a : undef : undef
aaaaaXa : : : undef : undef : undef
brosser> i.e. it's ignoring the multiple string of a's in the
brosser> first part.
No, it's matching it on the first iteration.
Perhaps you think that (a)* is kinda like ((a)*), but it's not. $1
will be the whole string, and $2 will be just the *last* thing
matched. In fact, maybe if you changed all those to (a*) instead
of (a)*, you'd get the results you expected.
print "Just another Perl hacker," # but not what the media calls "hacker!" :-)
## legal fund: $20,990.69 collected, $186,159.85 spent; just 163 more days
## before I go to *prison* for 90 days; email fund@stonehenge.com for details
--
Name: Randal L. Schwartz / Stonehenge Consulting Services (503)777-0095
Keywords: Perl training, UNIX[tm] consulting, video production, skiing, flying
Email: <merlyn@stonehenge.com> Snail: (Call) PGP-Key: (finger merlyn@teleport.com)
Web: <A HREF="http://www.stonehenge.com/merlyn/">My Home Page!</A>
Quote: "I'm telling you, if I could have five lines in my .sig, I would!" -- me
------------------------------
Date: 21 Mar 1998 23:43:39 GMT
From: peterm@zeta.org.au (Peter G. Martin)
Subject: Re: HTML::Element::extract_links not grabbing frame sources
Message-Id: <6f1jbb$um8$2@phaedrus.kralizec.net.au>
In article <ebohlmanEq5Azn.74z@netcom.com>,
Eric Bohlman <ebohlman@netcom.com> writes:
[snip]...
> I don't think HTML::Parse understands <frame> elements yet, so it has no way
> of knowing that they contain attributes that refer to URLs (even if it
> did, it would have trouble with that example because it isn't well-formed
> HTML; <img> and <frame> can't occur in the same context). Someone (I'm
> not volunteering) ought to write a module that parses HTML according to a
> supplied DTD (yes, I know there are modules that interface to spgrove,
> but they're overkill for a lot of applications).
>
Check out Gisle Aas' dtd2pm.pl in libwww, under the HTML directory.
Last version I saw handled only HTML3.2, and filtered the DDT file
to output a ready-made pm file with hashes of reserved words in
various contexts etc.
I'm currently playing with a slightly hacked version
that seems to be handling the HTML4.0 DTD reasonably well --
the only significant changes it appears to require are
handling "reserved" attributes in the version of the DTD
I have.
However, let me echo Gisle's remarks as even more applicable
to me:
<quote>
# Disclaimer: I am not an SGML expert and don't really understand how
# to read those damn DTDs.
<unquote>
--
Peter G. Martin, Tech.Writer & Perl User
The Scribe & Chutney Trust
peterm@zeta.org.au, http://www.zeta.org.au/~peterm
ROZELLE, Australia +61 2 9818 5094
------------------------------
Date: Sat, 21 Mar 1998 17:06:21 -0500
From: fl_aggie@thepentagon.com (I R A Aggie)
Subject: Re: Mail filter package?
Message-Id: <fl_aggie-2103981706210001@aggie.coaps.fsu.edu>
In article <6eucdc$cjd$1@service3.uky.edu>, aarond@alpha.ewl.uky.edu
(Aaron B. Dossett) wrote:
+ Mike Arms (marms@sandia.gov) wrote:
+ > Being a typical lazy Perl programmer :-) I am looking for
+ > a Mail filter package. I need it to be able to extract
+ > mail messages from /var/mail/$USER that come from particular
+ > mailing lists and append them to named subfolders.
+ >
+
+ Procmail is far and away the best tool for what you want to do.
I dunno. I like mailagent. It has the advantage of understanding
perlish regex's, and you can write perl extentions to it.
James
--
Consulting Minister for Consultants, DNRC
The Bill of Rights is paid in Responsibilities - Jean McGuire
To cure your perl CGI problems, please look at:
<url:http://www.perl.com/CPAN-local/doc/FAQs/cgi/idiots-guide.html>
------------------------------
Date: 21 Mar 1998 22:29:09 GMT
From: gabor@vmunix.com (Gabor)
Subject: Re: need perl script to read utmp files
Message-Id: <slrn6h8gj4.nbh.gabor@vnode.vmunix.com>
In comp.lang.perl.misc, Ma Xin <maxin@iscs.nus.edu.sg> wrote :
# I'm looking for a perl script to read the utmp files(including /etc/utmp, /etc/wtmp, etc) in unix. I think it can be read using pack, unpack function in perl but I'm not sure what format the utmp files use. anyone?
try looking in /usr/include/utmp.h
or 'man utmp'
------------------------------
Date: Sat, 21 Mar 1998 19:05:25 -0500
From: Benjamin Holzman <bholzman@mail.earthlink.net>
To: neilb@zetnet.co.uk
Subject: Re: Perl Daemons
Message-Id: <351455C5.44AFFD9A@mail.earthlink.net>
Neil Briscoe wrote:
>
> In article <3511E531.64FE39C0@mail.earthlink.net>,
> bholzman@mail.earthlink.net (Benjamin Holzman) wrote:
>
> > > The code to do this is :-
> > >
> > > #!/usr/local/bin/perl
> > >
> > > if (fork()) { # Invoke a child
> > This is unlikely be very helpful in win32, I believe...
> >
>
> The question was "Is there a similar thing for this in Unix?" Try reading
> the question. I do so hope you're not a provider of tech. support.
Thanks, you're right. I did misread the question. I apologize. FWIW,
I'm not a tech support provider. But regardless, I should have read the
question.
>
> You've also had my mail regarding the Cygnus Development Kit. For the
> benefit of anyone else - compile the standard distribution using the cdk
> (which you can find on http://www.Cygnus.com) and you have a Win32 perl
> that does the right thing when presented with fork();
>
> Nevertheless, I can't help agreeing with Tom's "Win32 is unlikely to be
> helpful to anyone" ;-))). Hope I've paraphrased that roughly accurately.
>
> Regards
> Neil
------------------------------
Date: Sat, 21 Mar 1998 23:35:03 +0000
From: Mark Sage <Mark_Sage@Compuserve.com>
Subject: Perl NT-Unix problem
Message-Id: <35144EA7.946C6A7D@Compuserve.com>
I am reasonably new to Perl and so this might be a real stupid question,
but one that my ISP doesn't seem to know how to answer. I've written a
Perl script that has sub-routines, each sub-routine uses local variables
with the "MY" command. The script works perfectly on my WebSite
1.1/NT4/Perl 5 implementation, I then uploaded the script to my ISP who
says they run Unix/Perl 5. The script bombed out, receiving no help
from my ISP I tracked the fault down to the use of "MY", when I took
this out and made the variables global everything worked fine. Why?
Any ideas would be cool.
While I am here I have another question, all the Perl books talk about
using Perl to send email, so as to create simple CGI data collection.
This is all well and good except I have MS-Mail and NT, how the heck
does Perl email then? I suppose what I am asking is, can I/how do I
setup NT/Perl 5 to be able to email. (I do have a POP3 mail account and
a leased line to the internet.)
Thanks in advance
Mark.
------------------------------
Date: Sat, 21 Mar 1998 19:18:08 -0500
From: Benjamin Holzman <bholzman@mail.earthlink.net>
To: Mark Sage <Mark_Sage@Compuserve.com>
Subject: Re: Perl NT-Unix problem
Message-Id: <351458C0.9396D26E@mail.earthlink.net>
Mark Sage wrote:
>
> I am reasonably new to Perl and so this might be a real stupid question,
> but one that my ISP doesn't seem to know how to answer. I've written a
> Perl script that has sub-routines, each sub-routine uses local variables
> with the "MY" command. The script works perfectly on my WebSite
> 1.1/NT4/Perl 5 implementation, I then uploaded the script to my ISP who
> says they run Unix/Perl 5. The script bombed out, receiving no help
> from my ISP I tracked the fault down to the use of "MY", when I took
> this out and made the variables global everything worked fine. Why?
> Any ideas would be cool.
If you used the paradigm: "foreach my $foo (@bar) { ... }" and your ISP
has a very old perl5 (5.002 or earlier, I think), then I could see
this. Otherwise, not.
>
> While I am here I have another question, all the Perl books talk about
> using Perl to send email, so as to create simple CGI data collection.
> This is all well and good except I have MS-Mail and NT, how the heck
> does Perl email then? I suppose what I am asking is, can I/how do I
> setup NT/Perl 5 to be able to email. (I do have a POP3 mail account and
> a leased line to the internet.)
Get Net::SMTP from CPAN.
>
> Thanks in advance
>
> Mark.
------------------------------
Date: Sun, 22 Mar 1998 00:15:01 +0100
From: Mark Seuffert <captain@pirate.de>
Subject: Q: Add a _special_ CGI handler to Apache?
Message-Id: <351449F5.101F@pirate.de>
Hi,
I have a CGI script that is called frequently, it recieves
text-input and has to log it. I have seen that there is a API with the
Apache webserver, didn't understand what it can do and how to use it.
My questions: Is it possible that my CGI-Script is build into the
server, to catch a PUT request for a special script and logs the
recieved data? Could I add my handler, without recompling the
server-software?
And... is this faster than using a normal CGI-C-programm. Actually
speed is what I want to achieve!!!! :)
thx for informations,
sorry for my english, hope U understand what I want (:
--
Moak (plz reply also as email)
------------------------------
Date: Sat, 21 Mar 1998 18:01:35 -0000
From: "Eric Phillips" <e.phillips@tgrweb.com>
Subject: Replacing a line of text
Message-Id: <6f1h19$27i@camel19.mindspring.com>
Hello. I have a CGI script written in Perl, and I am trying to get it to
open a file, read it line for line, find the line that's a match, and edit
that line. I can open the file, read it, and file the match, but I don't
know how to replace the line of text that was just read with the new
(modified) line of text. How would I do this??
Please let me know. Thanks!
--
Eric Phillips
e.phillips@tgrweb.com
------------------------------
Date: 21 Mar 1998 23:11:15 GMT
From: Alain.Deckers@man.ac.uk (A. Deckers)
Subject: Re: Replacing a line of text
Message-Id: <slrn6h8i8i.4h3.Alain.Deckers@bashful.rediris.es>
In <6f1h19$27i@camel19.mindspring.com>,
Eric Phillips <e.phillips@tgrweb.com> wrote:
>Hello. I have a CGI script written in Perl, and I am trying to get it to
>open a file, read it line for line, find the line that's a match, and edit
>that line. I can open the file, read it, and file the match, but I don't
>know how to replace the line of text that was just read with the new
>(modified) line of text. How would I do this??
http://www.perl.com/CPAN/doc/FAQs/FAQ/PerlFAQ.html#How_do_I_change_one_line_in_a_fi
Seek and you shall find the answer.
Alain
--
Perl reference: <URL:http://reference.perl.com/>
Perl language: <URL:http://language.perl.com/>
Perl archive: <URL:http://www.perl.com/CPAN/>
Perl FAQ: <URL:http://www.perl.com/CPAN/doc/FAQs/FAQ/>
------------------------------
Date: Sat, 21 Mar 1998 23:15:17 GMT
From: Sneex <sneaker@earthling.net>
Subject: Re: reset a array?
Message-Id: <351448A9.287B6137@earthling.net>
The only defense I have against the
mis-matched quotes is -
I couldn't think whether to '' or "".
(One actually looked like a single ".)
Me
Uri Guttman wrote:
> Sneex <chasecreek.systemhouse@usa.net> writes:
>
> > Try either -
> > undef @array;
> > @array = '"";
>
> sorry, sneex, the last one is wrong. it will set the array to a list of
> one element which is a null string. and your quotes are mismatched too.
>
> you wanted:
>
> @array = () ;
>
> while undef @array actually removes it from the symbol table which is
> more than just resetting it.
>
> uri
>
> --
> Uri Guttman ----------------- SYStems ARCHitecture and Software Engineering
> Perl Hacker for Hire ---- 8 Years of Perl Experience, Available Immediately
> uri@sysarch.com --------- Resume and Perl Example at http://www.sysarch.com
> Use the Best Search Engine on the Net -------- http://www.northernlight.com
------------------------------
Date: Sat, 21 Mar 1998 22:29:45 GMT
From: jgloudon@manitoba.bbn.com (Jason Gloudon)
Subject: Re: Sockets
Message-Id: <slrn6h8fo8.3hl.jgloudon@manitoba.bbn.com>
carl m. trotto jr. <ctrotto@trotto.com> wrote:
>for($fh = "fh00", $i = 0; $i != $MAXSOCKET; $i++, $fh++ ) {
> socket($fh, AF_INET, SOCK_DGRAM, $proto ) || die "socket: $!";
> $qsock[$i] = $fh;
> select(fileno($fh)); $| = 1;
>}
You did say ?
Use Socket;
Socket expects a filehandle. You want to create several filehandles,
IO::Handle exists to do this for you.
Roughly :
Use Socket;
Use IO:Handle;
for($i=0;$i !=$MAXSOCKET;$i++){
$qsock[$i] = new IO::Handle;
socket($qsock[$i], AF_INET, SOCK_DGRAM, $proto ) || die "socket: $!";
select($qsock[$i]); $| = 1;
}
--
Jason Gloudon
------------------------------
Date: Sat, 21 Mar 1998 17:24:43 -0500
From: Alan Melton <melton@diagdata.com>
Subject: Spaces in a sentence
Message-Id: <35143E2B.AEA0D84E@diagdata.com>
If a sentence (probably a scalar value)
has spaces between the words and the perl script
ends the statement after it finds the first
space-- what character substitute can be put
in to represent a space value?
i.e. The New York Times
perl script gives: The
what can be put between The New The*spNew?
so that the final result given by the perl script
is: The New York Times
A Melton
------------------------------
Date: Sat, 21 Mar 1998 19:33:17 -0500
From: Pat Trainor <ptrainor@bbnplanet.com>
Subject: ssh exit status from perl
Message-Id: <Pine.LNX.3.95.980321192907.8779C-100000@aura>
How can:
$idremote = `ssh -l $ssh_user[$server_number] \
$ssh_server[$server_number] /usr/bin/egrep '^$login:' /etc/passwd`;
the scalar $idremote be used/evaluated to determine if the ssh
session returned an exit status of 0 or 1 ?? STDIN appears to be terminal
only, so I can't batch (nor want to) the password.
It is desireable that a condition of failed password:
contacting catherwood.downcity.net and checking for sdgbsdg
Password:
Permission denied.
cause a while loop to continue attempting to access until exit
status 0 is achieved. Problem is, I cannot lift the exit status using $@
ideas?
pat
:)
________________________________________________________________________
ptrainor@bbnplanet.com ptrainor@bbn.com ptrainor@bbnplanet.net
will program for boat
------------------------------
Date: 21 Mar 1998 14:56:41 -0600
From: tyde@medtrodnet.cdom (Tye McQueen)
Subject: Re: times function Unix, yes, NT, no -Perl NT
Message-Id: <6f19i9$n3c@fohnix.metronet.com>
cotal@delphi.com writes:
)
) 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.metronet.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";
print "\t@", $o->Offset, ", ", $o->NumInstances,
" 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;
}
__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
}
}
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 );
}
}
----- End of PerfData.pl -----
+++++ Start of Win32/PerfData.pm +++++
#!/usr/bin/perl -w
# PerfData.pm -- Perl module to access performance data from Win32 Registry.
# by Tye McQueen, tye@metronet.com, see http://www.metronet.com/~tye/.
#
# Skip to "=head" line for user documentation.
#
package Win32::PerfData;
use strict;
use vars qw( $PACK $VERSION @ISA @EXPORT @EXPORT_OK );
$VERSION= '0.01'; # will be Released after 1998-02-19
use Carp;
require Exporter;
@ISA= qw(Exporter);
@EXPORT= qw();
@EXPORT_OK= qw();
BEGIN {
$PACK= "Win32::PerfData"; # Used in error messages.
}
# 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";
}
# Make them all subclasses:
{ no strict 'refs';
@{$DataBlock."::ISA"}= ($PACK);
@{$ObjectType."::ISA"}= ($PACK);
@{$InstanceDef."::ISA"}= ($PACK);
@{$CounterDef."::ISA"}= ($PACK);
@{$CounterBlock."::ISA"}= ($PACK);
@{$CounterValue."::ISA"}= ($PACK);
}
######################################################################
# Preloaded methods go here.
sub new
{
my $this= shift(@_);
my $class= ref($this) || $this;
my $self= {};
my $data= ref($this) ? $this->DataBuffer : shift(@_);
if( ref($data) && "$data" =~ /=/ ) {
$this= $data;
$data= $this->DataBuffer;
}
my $offset= @_ ? shift(@_) : 0;
if( 0 != @_ || ! defined($data) || "SCALAR" ne ref($data)
|| ! defined($offset) || $offset !~ /^\s*[-+]?0/ && 0 == $offset ) {
croak "Usage: ", $class, "->new( \\\$data[, \$offset] );\n";
}
if( ref($this) ) {
$offset += $this->Offset;
}
$self->{BUFFER}= $data;
$self->{OFFSET}= $offset;
bless $self, $class;
return $self;
}
sub DataBuffer
{
my $self= shift(@_);
$self->{BUFFER};
}
sub Offset
{
my $self= shift(@_);
$self->{OFFSET};
}
sub Rewind
{
my $self= shift( @_ );
$self->{NEXTFIELD}= $self->{OFFSET};
$self;
}
sub Unpack
{
my $self= shift( @_ );
my( $format )= @_;
my $data= $self->DataBuffer;
my @fields= unpack( '@'.$self->{NEXTFIELD}.$format, $$data );
$self->{NEXTFIELD} += FormatLength($format);
@fields;
}
sub FormatLength
{
my( $format )= @_;
my @fields= split( /\s*(?=[a-zA-Z]|$)/, $format );
my $len= 0;
foreach( @fields ) {
if( /^[aAP](\d+)$/ ) {
$len += $1;
} elsif( /^[bB](\d+)$/ ) {
$len += 1 + int( ($1-1)/8 );
} elsif( /^[hH](\d+)$/ ) {
$len += 1 + int( ($1-1)/2 );
} elsif( /^[cCx](\d*)$/ ) {
$len += "" eq $1 ? 1 : $1;
} elsif( /^[X](\d*)$/ ) {
$len -= "" eq $1 ? 1 : $1;
} elsif( /^[sSnv](\d*)$/ ) {
$len += 2 * ( "" eq $1 ? 1 : $1 );
} elsif( /^[lLNVf](\d*)$/ ) {
$len += 4 * ( "" eq $1 ? 1 : $1 );
} elsif( /^[d](\d*)$/ ) {
$len += 8 * ( "" eq $1 ? 1 : $1 );
} else {
die "Invalid field in pack format ($_)";
}
}
$len;
}
sub OnlyDataBlock
{
my $this= shift( @_ );
my $self= new $DataBlock, $this, 0;
$self;
}
######################################################################
package Win32::PerfData::DataBlock;
use vars qw( @ISA );
sub FirstObjectType
{
my $this= shift( @_ );
my $self= Win32::PerfData::ObjectType->new( $this, $this->HeaderLength );
$self;
}
sub Cache
{
my $self= shift( @_ );
my( $Sig )= pack( "C*", $self->Rewind->Unpack("S4") );
my( $Little, $Vers, $Rev, $Total, $Head, $nObjs, $DefObj )=
$self->Unpack("L7");
my( @Date )= $self->Unpack("S8");
my( $pad )= $self->Unpack("L");
my( @Ticks, @Freq, @Time );
( @Ticks[0,1], @Freq[0,1], @Time[0,1] )= $self->Unpack("L6");
my( $NameLen, $NameOff )= $self->Unpack("L2");
my $dw= 0x10000*0x10000;
my( $SysName )= pack( "C*", $self->Unpack("S".($NameLen/2-1)) );
$self->{CACHE}= {};
@{$self->{CACHE}}{qw( Signature LittleEndian Version Revision
TotalByteLength HeaderLength NumObjectTypes DefaultObject
SystemTime PerfTime PerfFreq PerfTime100nSec
SystemNameLength SystemNameOffset SystemName )}= (
$Sig, $Little, $Vers, $Rev, $Total, $Head, $nObjs, $DefObj,
[@Date], $Ticks[0]+$dw*$Ticks[1], $Freq[0]+$dw*$Freq[1],
$Time[0]+$dw*$Time[1], $NameLen, $NameOff, $SysName );
}
sub HeaderLength
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{HeaderLength};
}
sub NumObjectTypes
{
my $self= shift( @_ );
$self->CacheBlock unless $self->{CACHE};
$self->{CACHE}{NumObjectTypes};
}
######################################################################
package Win32::PerfData::ObjectType;
use vars qw( @ISA );
sub NextObjectType
{
my $this= shift( @_ );
my $self= $this->new( $this->TotalByteLength );
$self;
}
sub FirstCounterDef
{
my $this= shift( @_ );
my $self= Win32::PerfData::CounterDef->new( $this, $this->HeaderLength );
$self;
}
sub FirstInstanceDef
{
my $this= shift( @_ );
my $self= Win32::PerfData::InstanceDef->new(
$this, $this->DefinitionLength );
$self;
}
sub SingleCounterBlock
{
my $this= shift( @_ );
my $self= Win32::PerfData::CounterBlock->new(
$this, $this->DefinitionLength );
$self;
}
sub Cache
{
my $self= shift( @_ );
my( $Total, $DefLen, $Head )= $self->Rewind->Unpack("L3");
my( $NameIdx, $NamePtr, $HelpIdx, $HelpPtr )= $self->Unpack("L4");
my( $Detail, $NumCounts, $DefCount, $NumInsts, $CodePage )=
$self->Unpack("LLllL");
my( @Ticks, @Freq );
( @Ticks[0,1], @Freq[0,1] )= $self->Unpack("L4");
my $dw= 0x10000*0x10000;
$self->{CACHE}= {};
@{$self->{CACHE}}{qw( TotalByteLength DefinitionLength HeaderLength
ObjectNameTitleIndex ObjectNameTitle ObjectHelpTitleIndex
ObjectHelpTitle DetailLevel NumCounters DefaultCounter
NumInstances CodePage PerfTime PerfFreq )}= (
$Total, $DefLen, $Head, $NameIdx, $NamePtr, $HelpIdx, $HelpPtr,
$Detail, $NumCounts, $DefCount, $NumInsts, $CodePage,
$Ticks[0]+$dw*$Ticks[1], $Freq[0]+$dw*$Freq[1] );
}
sub NumInstances
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{NumInstances};
}
sub NumCounters
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{NumCounters};
}
sub ObjectNameTitleIndex
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{ObjectNameTitleIndex};
}
sub TotalByteLength
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{TotalByteLength};
}
sub DefinitionLength
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{DefinitionLength};
}
sub HeaderLength
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{HeaderLength};
}
######################################################################
package Win32::PerfData::InstanceDef;
use vars qw( @ISA );
sub Cache
{
my $self= shift( @_ );
my( $Length, $ParTitle, $ParInst )= $self->Rewind->Unpack("L3");
my( $UniqID, $NameOff, $NameLen )= $self->Unpack("L3");
my( $Name )= 2 < $NameLen ? pack( "C*", $self->Unpack("S".($NameLen/2-1)) )
: "";
$self->{CACHE}= {};
@{$self->{CACHE}}{qw( ByteLength ParentObjectTitleIndex
ParentObjectInstance UniqueID NameOffset NameLength Name )}= (
$Length, $ParTitle, $ParInst, $UniqID, $NameOff, $NameLen, $Name );
}
sub UniqID
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{UniqID};
}
sub Name
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{Name};
}
sub ByteLength
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{ByteLength};
}
sub OnlyCounterBlock
{
my $this= shift( @_ );
my $self= Win32::PerfData::CounterBlock->new( $this, $this->ByteLength );
$self;
}
sub NextInstanceDef
{
my $this= shift( @_ );
my $block= $this->OnlyCounterBlock;
my $self= Win32::PerfData::InstanceDef->new( $block, $block->ByteLength );
$self;
}
######################################################################
package Win32::PerfData::CounterDef;
use vars qw( @ISA );
sub Cache
{
my $self= shift( @_ );
my( $Length, $NameIdx, $NamePtr )= $self->Rewind->Unpack("L3");
my( $HelpIdx, $HelpPtr, $Scale, $Detail )= $self->Unpack("L4");
my( $Type, $Size, $Offset )= $self->Unpack("L3");
$self->{CACHE}= {};
@{$self->{CACHE}}{qw( ByteLength CounterNameTitleIndex
CounterNameTitle CounterHelpTitleIndex CounterHelpTitle
DefaultScale DetailLevel CounterType CounterSize CounterOffset )}= (
$Length, $NameIdx, $NamePtr, $HelpIdx, $HelpPtr,
$Scale, $Detail, $Type, $Size, $Offset );
}
sub ByteLength
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{ByteLength};
}
sub NextCounterDef
{
my $this= shift( @_ );
my $self= $this->new( $this->ByteLength );
$self;
}
package Win32::PerfData::CounterBlock;
use vars qw( @ISA );
sub Cache
{
my $self= shift( @_ );
my( $Length )= $self->Rewind->Unpack("L");
$self->{CACHE}= {};
@{$self->{CACHE}}{qw( ByteLength )}= ( $Length );
}
sub ByteLength
{
my $self= shift( @_ );
$self->Cache unless $self->{CACHE};
$self->{CACHE}{ByteLength};
}
package Win32::PerfData::CounterValue;
use vars qw( @ISA );
# Autoload methods go after =cut, and are processed by the autosplit program.
1;
__END__
=head1 NAME
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 SUMMARY
=head1 AUTHOR
Tye McQueen, tye@metronet.com, see http://www.metronet.com/~tye/.
=head1 SEE ALSO
=head1 BUGS
=cut
# Autoload not currently supported by Perl under Windows.
----- End of Win32/PerfData.pm -----
Remove d's from address to reply (sorry for the inconvenience).
------------------------------
Date: Sat, 21 Mar 1998 16:57:33 -0800
From: Steve Palincsar <palincss@tidalwave.net>
To: sneaker@earthling.net
Subject: Re: Wanted: Perl for Windows 3.x
Message-Id: <351461FD.25A6@tidalwave.net>
Sneex wrote:
>
> As a former student, the best I can say is research - AskJeeves &
> DejaNews :-)
> (They are a student's BEST first line of information...)
>
> To answer your query - see www.activestate.com
NO! The activestate.com site pretty clearly advertises the product
as being for Win32, not Win16 or DOS. CPAN, on the other hand,
has two choices that work: ILYAZ's OS/2 port and Laszlo Molnar's
DJGPP port. I've used both. I couldn't get Ilya's OS/2 port to
run any external programs, which for me was fatal because I user perl
as glue to tie together external applications, but Laszlo's works
just fine.
Thanks once again to The Perl Journal for listing the DJGPP port. I
have pretty weird news service, evidently getting about 30% of the
postings, no more, so I follow the listserv reflector. Not once was
this port announced. I wrote to Laszlo, and he said he posted a
notice on the djgpp ng. but not on comp.lang.perl.announce, so
several months (of personal frustration where I was forced to continue
using perl 4.036 because the IlyaZ version won't allow you to run
external utilities) went by before I knw of its existence.
Suranga, get thee to CPAN!
>
> HTH,
> Sneex :-)
>
> PS - As the saying goes: Knowing stuff is Kool!
> Knowing how to find 'stuff' is power!
>
> Suranga Manage wrote:
>
> > Dear Friends,
> >
> > I am a computer eng student, I want to learn some perl. However
> > I don't have access to a UNIX box. Is there a perl version that
> > can be run on MS-Windows 3.1 or MS-Dos ?. I know that there
> > is a perl flavour for MS-Windows NT but I am not in a position
> > to have access to a NT machine.
> >
> > Thanks
> > Suranga
------------------------------
Date: Sat, 21 Mar 1998 23:19:15 GMT
From: Sneex <sneaker@earthling.net>
Subject: Re: Wanted: Perl for Windows 3.x
Message-Id: <35144998.303F6A2C@earthling.net>
guess I don't get credit for correcting myself after this post?
:-)
Sneex
Steve Palincsar wrote:
> Sneex wrote:
> >
> > As a former student, the best I can say is research - AskJeeves &
> > DejaNews :-)
> > (They are a student's BEST first line of information...)
> >
> > To answer your query - see www.activestate.com
>
> NO!
I know, it was the 'student' thing, right?:-)
------------------------------
Date: Sat, 21 Mar 1998 22:10:23 GMT
From: jeff@yoak.com (Jeff Yoak)
Subject: Re: what is wrong with being a novice ??
Message-Id: <6f1e7q$b6h@dfw-ixnews8.ix.netcom.com>
[posted and emailed]
tim@maroney.org wrote:
>>I'd be very surprised if many would claim that the bandwidth is a
>>major concern. The concern is the time. The questions in question
>>waste very precious time.
>Uh, hello,
Hello! :)
> time is bandwidth. When people refer to their news or mail reading
>bandwidth they are referring to how much information they personally have to
>sort through. This has been a standard idiom on USENET from the beginning, or
>at least since I joined in 1982. You might want to reread my message in this
>light. Pointless flames are bigger bandwidth wasters than sincere questions of
>possible general interest.
Well I certainly agree with you here. Pointless flames would be, but
not messages, even if strongly worded, that point people to better
resources. Those are informative and cut down tremendously on
similarly improper questions being asked in the future.
And I did misunderstand you. I thought by bandwidth you meant the
resources cosumed in propogating the message and storing / archiving
it. I hope you won't be too abrasive with me, a relative "newbie"
having been 9 years old in 1982, for not catching your meaning. :)
>>It's just not true. The "flamers," as you call them, aren't wasting
>>anyone's time except arguably their own at times.
>Funny, I could swear they're wasting mine. I click on a message hoping to find
>information and instead I find some stupid flame. If that's not a waste of
>time, what is?
I can't believe messages that are generally terse and contain info
like:
"perldoc perlref"
or
"Check out perlfaq4."
are more disruptive of anyone's time than the flood of questions that
would be present in the absence of such posts. The vast majority of
the posts we're talking about fall in this category.
Cheers,
Jeff
-------------------------------
Jeff Yoak jeff@yoak.com
------------------------------
Date: Sat, 21 Mar 1998 22:22:23 GMT
From: jeremy@youngman.demon.co.uk (JY)
Subject: Win95 glob for filenames returns values but not into array
Message-Id: <35143b96.15637298@news.demon.co.uk>
Hi
I'm trying to read a list of filenames into an array (pretty basic,
huh?) but can't seem to get it working.
I am running Windows95 using Perl for Win32 (build315).
I've checked and I have perlglob in my $PATH.
Here's my directory listing:
C:\xfer\cnt>dir *.tst
ZERO TST 1 21/03/98 19:12 zero.tst
1 file(s) 1 bytes
0 dir(s) 1,012,301,824 bytes free
Here's my Perl:
@counters = glob("*.tst");
$items = @counters;
print "debug number of elements is $items \n";
print "debug #1 is \"$counters[0]\" \n";
exit(0);
Here's the output:
C:\xfer\cnt>perl counters
zero.tst debug number of elements is 0
debug #1 is ""
C:\xfer\cnt>
Basically it looks as if the glob command is returning output because
i can see it on the screen (and when more files match they all
appear). However it doesn't get entered into the array @counters.
Are there any known probs in this area?
Thanks,
Jeremy
------------------------------
Date: 8 Mar 97 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 8 Mar 97)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V8 Issue 2154
**************************************
