[25404] in Perl-Users-Digest
Perl-Users Digest, Issue: 7649 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Jan 14 14:05:30 2005
Date: Fri, 14 Jan 2005 11:05:12 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Fri, 14 Jan 2005 Volume: 10 Number: 7649
Today's topics:
Re: [perl-python] 20050113 looking up syntax <jurgenex@hotmail.com>
Re: another 'POST from perl' question <spamtrap@dot-app.org>
Basic Question: Local Forms <jeannegoodman@yahoo.com>
Re: Basic Question: Local Forms <nobull@mail.com>
Re: Basic Question: Local Forms <jeannegoodman@yahoo.com>
Re: Basic Question: Local Forms <usa1@llenroc.ude.invalid>
Re: daemonizing a process AND capture stdout, stderr <nobull@mail.com>
Re: daemonizing a process AND capture stdout, stderr (Anno Siegel)
Re: Log File parser (Anno Siegel)
Re: Log File parser <jgibson@mail.arc.nasa.gov>
Re: Log File parser <spamtrap@dot-app.org>
Re: Log File parser <spamtrap@dot-app.org>
Re: Loop through a text file line by line <news@chaos-net.de>
Re: portable no warnings "uninitialized" <nobull@mail.com>
Re: Random Functionality <nobull@mail.com>
Re: Regular expression lookahead question <jurgenex@hotmail.com>
Re: Regular expression lookahead question <gregaryh@juno.com>
Re: Regular expression lookahead question xhoster@gmail.com
Re: Regular expression lookahead question xhoster@gmail.com
Re: Tk: Call subroutine when MainWindow is realized? <zentara@highstream.net>
Win32::API memory leak? <gargoyle@no.spam>
Re: Works great! <nobull@mail.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 14 Jan 2005 16:24:45 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: [perl-python] 20050113 looking up syntax
Message-Id: <hnSFd.16$No1.10@trnddc01>
Xah Lee wrote:
> ---------------------
>
> for perl syntax lookup, use perldoc in the command line. For example:
> perldoc perl
Wrong. That command will give you a high-level overview of Perl but tell you
nothing about the syntax.
To lookup the Perl syntax you would have to use
perldoc perlsyn
> use 'perldoc -f functionName' for specific function. example:
> perldoc -f qq
BS. That will tell you what a function does, it doesn't tell you anything at
all about the syntax of Perl.
BTW: Why on earth are you using qq() as an example? That doc page just
points you to 'perldoc perlop'.
> note that keywords cannot be looked up with -f. For basic keywords
> like
>
> if, while..., use
> perldoc perlop
BS. What gave you the idea that keywords were operators? Of course keywords
can be found where they belong, in the syntax definition of the language,
but not in the operator section of the documentation.
Why don't you just stop posting this nonsense?
jue
------------------------------
Date: Fri, 14 Jan 2005 13:36:04 -0500
From: Sherm Pendley <spamtrap@dot-app.org>
Subject: Re: another 'POST from perl' question
Message-Id: <W_CdnZTdtfyJjHXcRVn-qw@adelphia.com>
JD wrote:
> I found it strange, but the instructions from the rep state, "When using
> AIM, you will need to post a series of name/value pairs to us, in a
> query string format:
> https://secure.authorize.net/gateway
transact.dll?x_login=YOURLOGINID&x_tran_key=YOURTRANSACTIONKEY
>
> "AIM is a secure server to secure server connection that uses a string
> POST."
>
> I guess I don't really know what a string post is.
I had a look at the "AIM Implementation Guide", and you're right - the
support reps is clueless. A "string post" is nonsense the support rep made
up, that's what it is. Ignore the idiot behind the phone and believe the
docs, which state the requirements quite clearly:
To implement AIM, a developer would design a script that does the
following:
1. Securely obtains all of the information needed to process a
transaction.
2. Initiates a secure HTTPS form POST from their server to
https://secure.authorize.net/gateway/transact.dll
...
There's no mention at all of a query_string in the above. Just ignore the
red herring from the clueless support rep, and do an ordinary POST with the
name/value pairs that are listed in AIM_guide.pdf.
sherm--
--
Cocoa programming in Perl: http://camelbones.sourceforge.net
Hire me! My resume: http://www.dot-app.org
------------------------------
Date: 14 Jan 2005 08:45:34 -0800
From: "jeannegoodman@yahoo.com" <jeannegoodman@yahoo.com>
Subject: Basic Question: Local Forms
Message-Id: <1105721134.716676.240450@c13g2000cwb.googlegroups.com>
When I want to create a form, I usually use FrontPage. I want to create
a form that would be used only on a local network.
I want to be able to have someone fill out a form in the lobby, the
data is sent to a text file, the office person clicks a button and it
populates the database with the most recently entered data.
I can take care of the population part. I just need you to point me in
the right direction to create a form where the data is stored an a
local computer.
Thanks,
Jeanne
------------------------------
Date: Fri, 14 Jan 2005 17:33:57 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: Basic Question: Local Forms
Message-Id: <cs8vge$sum$1@sun3.bham.ac.uk>
jeannegoodman@yahoo.com wrote:
> When I want to create a form, I usually use FrontPage. I want to create
> a form that would be used only on a local network.
>
> I want to be able to have someone fill out a form in the lobby, the
> data is sent to a text file, the office person clicks a button and it
> populates the database with the most recently entered data.
>
> I can take care of the population part. I just need you to point me in
> the right direction to create a form where the data is stored an a
> local computer.
What are you talking about?
No, seriously, what are you talking about?
Where you you think Perl fits in?
What sort of forms are these?
How much control do you have over what software is runnning on the
machines where this is happening?
I suspect you are talking about HTML forms. In general Perl does not
run in web browsers (although ActiveState do something called PerlScript
which works on at least one browser). In general script running
within web browsers have to use Javascript. And in general they cannot
access the local filesystem (otherwise any website you visit could read
all your private files).
You probably should consider installing a web server. A good one should
cost you $0.00.
------------------------------
Date: 14 Jan 2005 10:40:12 -0800
From: "jeannegoodman@yahoo.com" <jeannegoodman@yahoo.com>
Subject: Re: Basic Question: Local Forms
Message-Id: <1105728012.338034.72850@c13g2000cwb.googlegroups.com>
Brian,
Well, perhaps I'm in the wrong place. I was looking for some kind of
CGI script that would transfer the data to an ascii file.
I have next to no control over the the software and no ability to get a
webserver.
I was imagining I could create a simple HTML form where the information
would post to an ascii file. Do I belong in a Java Group?
Jeanne
> jeannegoodman wrote:
>
> > When I want to create a form, I usually use FrontPage. I want to
create
> > a form that would be used only on a local network.
Brian McCauley wrote:
> How much control do you have over what software is runnning on the
> machines where this is happening?
>
> I suspect you are talking about HTML forms. In general Perl does not
> run in web browsers (although ActiveState do something called
PerlScript
> which works on at least one browser). In general script running
> within web browsers have to use Javascript. And in general they
cannot
> access the local filesystem (otherwise any website you visit could
read
> all your private files).
>
> You probably should consider installing a web server. A good one
should
> cost you $0.00.
------------------------------
Date: Fri, 14 Jan 2005 14:02:20 -0500
From: "A. Sinan Unur" <usa1@llenroc.ude.invalid>
Subject: Re: Basic Question: Local Forms
Message-Id: <pan.2005.01.14.19.01.48.155085@llenroc.ude.invalid>
In article <1105728012.338034.72850@c13g2000cwb.googlegroups.com> posted
on Fri, 14 Jan 2005 10:40:12 -0800, jeannegoodman@yahoo.com wrote:
[ Please do not top-post. If you do not know what that means, please
refer to the posting guidelines for this group.
]
> Well, perhaps I'm in the wrong place. I was looking for some kind of
> CGI script that would transfer the data to an ascii file.
You seem to be interested in writing "some kind of CGI script" and also
seem not to know that running CGI scripts requires a web server. You would
best to check out CGI related information (google is your friend) and
setup a web server to run locally on your computer (Apache comes to mind).
When you get that set up working, and start writing a CGI script in Perl,
feel free to post here for help with any problems you encounter.
> I have next to no control over the the software and no ability to get a
> webserver.
How on earth is that possible? On second thought, I don't really want to
know.
> I was imagining I could create a simple HTML form where the information
> would post to an ascii file.
http://www.w3.org/CGI/
> Do I belong in a Java Group?
Only you can decide that.
--
A. Sinan Unur
usa1@llenroc.ude.invalid -- remove invalid and
reverse each component for email address.
------------------------------
Date: Fri, 14 Jan 2005 17:24:09 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: daemonizing a process AND capture stdout, stderr
Message-Id: <cs8ut7$shg$2@sun3.bham.ac.uk>
Gyruss wrote:
> I've written a front end that kicks off various unix processes. I want to
> completely daemonize each process so that even if a user were to kill his
> front end, the process would continue to run without interruption. This
> isn't too difficult to accomplish, there's even a module that will do it all
> for you: Proc::Daemon.
>
> The tricky bit is that I want to be able to capture stdout and stderr from
> the script in my front end.
>
> How can I daemonize a process but still capture it's output?
Am I missing something here? You direct the output to a file and use
File::Tail.
------------------------------
Date: 14 Jan 2005 17:39:20 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: daemonizing a process AND capture stdout, stderr
Message-Id: <cs9048$are$1@mamenchi.zrz.TU-Berlin.DE>
Gyruss <gyruss@hushmail.com> wrote in comp.lang.perl.misc:
>
> "Michele Dondi" <bik.mido@tiscalinet.it> wrote in message
> news:t4afu0pqki2oupjkarsqv66lvat5gvb7r2@4ax.com...
[...]
> > Given that it's not entirely clear to me what you really want to do,
>
> The result I want is to have my child process live on if the parent process
> is killed. The parent process should just read stderr and stdout from the
> child process. I want to 'daemonize' the child process (it's not really the
> right term), not the parent process.
The term "demonize" can mean all sorts of things to different people,
including separation from a controlling terminal, becoming a process
group leader and probably more.
Normally, a process *is* immune to the parent's death. Since the kid
writes to handles the parent will close on termination, it will receive
a sigpipe when that happens. Is that your problem? If so, just ignore
(or handle) the PIPE signal in the kid. Look for "SIG" in perlvar for
details.
Anno
------------------------------
Date: 14 Jan 2005 18:00:52 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Log File parser
Message-Id: <cs91ck$are$2@mamenchi.zrz.TU-Berlin.DE>
jc8glp1hu <jgarretthood@gmail.com> wrote in comp.lang.perl.misc:
Please provide some context of what you are replying to.
> So, are people on google groups to criticize or help people out?
Both. On clpm, we help people correct their code, and we criticize code
that is posted. The two activities are not very different, and both help
develop the Perl language.
And it's not "google groups" you are on, it's Usenet, which is independent
and far older than google groups. Google runs an archive and an interface.
That's of great merit, but it doesn't make them the same thing.
[...]
> If someone asks you to do something in perl, why do you even waste your
...but the solution you posted wasn't really in Perl. The two calls
to grep would have been better part of some shell script. That's
what the "yuck" was about, no more, no less.
[rant snipped]
Anno
------------------------------
Date: Fri, 14 Jan 2005 10:12:03 -0800
From: Jim Gibson <jgibson@mail.arc.nasa.gov>
Subject: Re: Log File parser
Message-Id: <140120051012038293%jgibson@mail.arc.nasa.gov>
In article <1105712217.077518.277530@c13g2000cwb.googlegroups.com>,
jc8glp1hu <jgarretthood@gmail.com> wrote:
> Sorry for the rant, I am not out to make anyone feel bad or offend
> anyone. I am just having some sympathy for the thread starter who asked
> a question and didn't get what he wanted because I have been told
> before to go somewhere and read up, which is what I did, but I still
> didn't "understand" what I was doing.
>
> Sherm is right too, head to the site he suggested to learn some more
> about it if you so desire because Perl is a really neat language.
>
> So, sorry to anyone I offended. I just feel strongly about helping
> people when they ask for it because we all have struggled with
> something new before.
>
While your attempt at being helpful was admirable, the problem is that
you posted a very poor solution of the poster's problem. Your program
unnecessarily created two child processes and required reading the log
file twice instead of just once. A better solution would read the log
file within the Perl program, look for the words, and send an e-mail if
it encounters any of them. Something like (untested):
use strict;
use warnings;
my $logfile = 'errors.log';
open my $fh, '<', $logfile or die("Can't open $logfile: $!");
my @errors;
while( <$fh> ) {
push @errors, $_ if( /WARN/ or /ERROR/ ); # could combine regexes
}
if( @errors ) {
# send e-mail
}
If no one commented upon your poor attempt at solving the problem, both
the OP and any other reader unfamiliar with Perl might think that your
solution was a good one. So thanks for trying, but the next time you
feel the need to post a helpful article, think twice. I have been
programming in Perl for 10 years now, and I always have to think twice
about posting (and make sure I test before posting).
----== Posted via Newsfeeds.Com - Unlimited-Uncensored-Secure Usenet News==----
http://www.newsfeeds.com The #1 Newsgroup Service in the World! >100,000 Newsgroups
---= East/West-Coast Server Farms - Total Privacy via Encryption =---
------------------------------
Date: Fri, 14 Jan 2005 13:42:48 -0500
From: Sherm Pendley <spamtrap@dot-app.org>
Subject: Re: Log File parser
Message-Id: <W_CdnZfdtfw1j3XcRVn-qw@adelphia.com>
Anno Siegel wrote:
> and far older than google groups. Google runs an archive and an
> interface. That's of great merit,
Well... the archive is of great merit anyway. From what I've seen so far,
the interface is basically worthless.
sherm--
--
Cocoa programming in Perl: http://camelbones.sourceforge.net
Hire me! My resume: http://www.dot-app.org
------------------------------
Date: Fri, 14 Jan 2005 13:56:30 -0500
From: Sherm Pendley <spamtrap@dot-app.org>
Subject: Re: Log File parser
Message-Id: <5NudnQJaa8tCiHXcRVn-rg@adelphia.com>
jc8glp1hu wrote:
> So, are people on google groups to criticize or help people out?
Whoa, hold on a second. Launching a child "grep" process is unnecessary in
this case, inefficient, and won't even work on many Windows systems. And
your code does it *twice*.
Michele was commenting on the code you posted, not on the fact that you
posted code.
sherm--
--
Cocoa programming in Perl: http://camelbones.sourceforge.net
Hire me! My resume: http://www.dot-app.org
------------------------------
Date: 14 Jan 2005 16:16:09 GMT
From: Martin Kissner <news@chaos-net.de>
Subject: Re: Loop through a text file line by line
Message-Id: <slrncufs28.43n.news@maki.homeunix.net>
Michele Dondi wrote :
> On 14 Jan 2005 10:24:09 GMT, Martin Kissner <news@chaos-net.de> wrote:
>
>>> Not exactly. From 'perldoc perlop':
>>> [...]
>>
>>In <yzdu0ponibh.fsf@invalid.net> Arndt wrote to me:
>>| The "diamond" operator <> is described in perlop and perlopentut.
>>| You read from STDIN by using the normal Unix syntax:
>>|
>>| ./myperlscript.pl < file
>>
>>This worked for me.
>
> So what?!?
I was not sure if I have expressed myself correctly so tried to clear
up what I meant.
--
Epur Si Muove (Gallileo Gallilei)
------------------------------
Date: Fri, 14 Jan 2005 17:55:13 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: portable no warnings "uninitialized"
Message-Id: <cs90om$bv$1@sun3.bham.ac.uk>
Gunnar Hjalmarsson wrote:
> Brian McCauley wrote:
>
>> Gunnar Hjalmarsson wrote:
>>
>>> DKW wrote:
>>>
>>>> If I rephrase my question:
>>>> Can you at runtime check for existence for a module, and use (or no)
>>>> it if it exists?
>>>
>>>
>>> For an ordinary module you can do e.g.:
>>>
>>> BEGIN { eval "use SomeModule" }
>>>
>>> but the problem with "warnings" is that it's a pragma whose effect is
>>> set lexically.
>>
>> BEGIN {
>> eval {
>> require warnings;
>> warnings->unimport('uninitialized');
>> }
>> }
>
> Hmm.. So
>
> no warnings 'uninitialized';
>
> does only affect the current block, while
>
> warnings->unimport('uninitialized');
>
> is more widely applied. Is the latter file scoped or dynamically scoped?
The glib answer is that dynamic scope at compile time becomes lexical
scope at runtime.
That's not really the whole story but it's a starting point.
The point is that...
no warnings 'uninitialized';
...is short for...
BEGIN {
require warnings;
warnings->unimport('uninitialized');
}
...which in turn is more or less a bit like ...
BEGIN {
${^WARNING_BITS} &= ~some_constant_denoting_uninitialised;
}
The point is that what is happening is that the value of the special
variable ${^WARNING_BITS} that's getting changed at compile time. This
special variable is pushed every time the compiler starts to compile a
new block and poped when it compeletes the compilation of the block.
During the compilation the bits of ${^WARNING_BITS} control compile time
warnings. Somehow the generated opcode tree also remembers the relevant
bits of ${^WARNING_BITS} from when it was generated so that runtime
errors behave as lexically scoped too.
Note the closing brace of the BEGIN block does not undo the effect of
the code within the BEGIN block because the code in a BEGIN block is
executes as soon as the complier has passed the closign brace.
------------------------------
Date: Fri, 14 Jan 2005 17:21:54 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: Random Functionality
Message-Id: <cs8up0$shg$1@sun3.bham.ac.uk>
Scott Bryce wrote:
> Brian McCauley wrote:
>
>> my @sub_list =
>> map { \&$_ }
>> grep { exists(&$_) }
>> map {"MyModule::Handlers::$_"}
>> sort keys %MyModule::Handlers::;
>
> Unfortunately, that is a little over my head. I'll spend some time
> looking at the docs and see if I can figure out what that code is doing.
Working backwards..
(*) get all the symbol names in the MyModule::Handlers package
(*) prefix them to make them fully qualified symbol names
(*) filter down to only those symbols declared as subroutines
(*) get CODErefs for those subroutines
(*) store them in an array
> It occurs to me that the package containing the subroutines in question
> could be in the script itself rather than in an external file.
No, but I'd (perhaps mistakenly) got the impression that these were
something that is configured on the custommer site rather than being an
integral part of the module you were writing.
If the subroutines are logically part of the module you're writting then
they can simply go in the same file but it would seem a tidy division to
put then in their own .pm file anyhow.
> This gives me something to work with. Would this be better than pushing
> references to anonymous subroutines on to a list (as in the example code
> I posted in the OP), or is this just another way to do it? To answer
> that question, I would probably have to define "better."
This is just another way. IMNSHO it makes the source look neater. The
big advantage of named subroutines (particularly if they have mnemonic
names rather than just Sub_1, Sub_2 etc) is that their names show up in
stack dumps.
------------------------------
Date: Fri, 14 Jan 2005 16:32:11 GMT
From: "Jürgen Exner" <jurgenex@hotmail.com>
Subject: Re: Regular expression lookahead question
Message-Id: <fuSFd.20$No1.6@trnddc01>
Peroli wrote:
> [...]... If u r scared about parsing
> & charecters as entity in an xml file, y dont u use a CDATA section.
Ok, English is not my native language, but this sentence fails my parsing
routines so badly that even the exception handler gives up. I can't even
guess what you might have meant.
jue
------------------------------
Date: 14 Jan 2005 08:42:23 -0800
From: "zeebster" <gregaryh@juno.com>
Subject: Re: Regular expression lookahead question
Message-Id: <1105720943.564515.25030@z14g2000cwz.googlegroups.com>
I just wanted to know if my regexp syntax was correct.
Here is the situation in more detail. I have a stack of xml files that
were generated by a script that was good enough to protect the special
characters in most of the elements but left out a couple (there is a
filename element for instance that contains the full path to a file on
the users harderive and the path contains unprotected ampersands). I am
trying to do a search and replace of all these ampersand but I do not
want to match the ones that are in front of protected entities. For
example it should match Browning & Associates but not Browning &
Associates. Of course the latter is the intended output after the
replace has finished. I ran the aforementioned regexp from the command
line using grep to test it and it returned 0 matches. This is what I
meant by it not working since I know there are dozens of these. I do
not yet have code to display since I was trying to understand the
regexp I should use first.
------------------------------
Date: 14 Jan 2005 17:24:35 GMT
From: xhoster@gmail.com
Subject: Re: Regular expression lookahead question
Message-Id: <20050114122435.399$ya@newsreader.com>
"zeebster" <gregaryh@juno.com> wrote:
> I just wanted to know if my regexp syntax was correct.
Were the syntax not correct, Perl would have notified you of this fact
by reporting a syntax error.
...
> I ran the aforementioned regexp from the command
> line using grep to test it and it returned 0 matches.
So, you obviously used some code to do this, no? Where is that code?
How do we know that it is the regex that failed to do it's jobs, as
opposed to the part of your code that responds (or is supposed to respond)
to the results returned by the regex?
> This is what I
> meant by it not working since I know there are dozens of these. I do
> not yet have code to display since I was trying to understand the
> regexp I should use first.
Obviously you do have code to display. You just choose not to display
it. No skin of my nose.
Xho
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service $9.95/Month 30GB
------------------------------
Date: 14 Jan 2005 17:29:23 GMT
From: xhoster@gmail.com
Subject: Re: Regular expression lookahead question
Message-Id: <20050114122923.671$WI@newsreader.com>
"Matt Garrish" <matthew.garrish@sympatico.ca> wrote:
> <xhoster@gmail.com> wrote in message
> news:20050113190603.775$I8@newsreader.com...
> > "zeebster" <gregaryh@juno.com> wrote:
> >> I am trying to parse an xml file for unprotected ampersands (&)
> >> I do not want to match ampersand characters that preceed a protected
> >> entity such as in the case of < or >
> >> After hours of copious searches I found something that looked like it
> >> would work using lookaheads:
> >> &(?!quot|lt|gt|amp)
> >
> > Don't you want to force a ';' after the entities?
> >
>
> It's also not a valid way to alternate options,
What is not valid about it?
> and you still need to
> check what is there:
>
> /&(?:(?!(quot|lt|gt|amp)).*);/
Hunh?
Xho
--
-------------------- http://NewsReader.Com/ --------------------
Usenet Newsgroup Service $9.95/Month 30GB
------------------------------
Date: Fri, 14 Jan 2005 11:57:12 -0500
From: zentara <zentara@highstream.net>
Subject: Re: Tk: Call subroutine when MainWindow is realized?
Message-Id: <o1ufu0hv324a8pojum75maj9v0kchnn1dh@4ax.com>
On Thu, 13 Jan 2005 13:50:06 +0000 (UTC), Steve Lidie
<lusol@Dragonfly.cc.lehigh.edu> wrote:
>Now, back to threads. You can't use them,
It may be presumptuous of me to argue with the "teacher",
but I have been able to use threads with Tk, with 2 caveats.
1. No passing objects around, only simple text and scalars.
2. Threads must be created before Tk is init'ed.
In this example, I start 3 threads before Tk is started, and put them
to sleep. I control them with shared vars. It look more complicated
than it actually is, because I add an activity bar, and have 3 worker
threads, intead of one, with the associated hash complexities. This
concept can easily be used to start a worker thread to communicate with
the card. The thread can report back it's findings to Tk thru shared
variables, and you could manipulate you window accordingly.
#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use Tk;
use Tk::ActivityBar;
use Tk::Dialog;
my $data = shift || ' '; #sample code to pass to thread
my %shash;
#share(%shash); #will work only for first level keys
my %hash;
my %workers;
my $numworkers = 3;
foreach my $dthread(1..$numworkers){
share ($shash{$dthread}{'go'});
share ($shash{$dthread}{'progress'});
share ($shash{$dthread}{'timekey'}); #actual instance of the thread
share ($shash{$dthread}{'frame_open'}); #open or close the frame
share ($shash{$dthread}{'handle'});
share ($shash{$dthread}{'data'});
share ($shash{$dthread}{'pid'});
share ($shash{$dthread}{'die'});
$shash{$dthread}{'go'} = 0;
$shash{$dthread}{'progress'} = 0;
$shash{$dthread}{'timekey'} = 0;
$shash{$dthread}{'frame_open'} = 0;
$shash{$dthread}{'handle'} = 0;
$shash{$dthread}{'data'} = $data;
$shash{$dthread}{'pid'} = -1;
$shash{$dthread}{'die'} = 0;
$hash{$dthread}{'thread'} = threads->new(\&work,$dthread);
}
my $mw = MainWindow->new(-background => 'gray50');
my $lframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
->pack(-side =>'left' ,-fill=>'y');
my $rframe = $mw->Frame( -background => 'gray50',-borderwidth=>10 )
->pack(-side =>'right',-fill =>'both' );
my %actives = (); #hash to hold reusable numbered widgets used for
downloads
my @ready = (); #array to hold markers indicating activity is needed
my $activity = $lframe->ActivityBar()->pack(-side => 'top',-anchor =>
'n');
#make 3 reusable downloader widget sets-------------------------
foreach(1..$numworkers){
push @ready, $_;
#frames to hold indicator
$actives{$_}{'frame'} = $rframe->Frame( -background => 'gray50' );
$actives{$_}{'stopbut'} = $actives{$_}{'frame'}->Button(
-text => "Stop Worker $_",
-background => 'lightyellow',
-command => sub { } )->pack( -side => 'left', -padx => 10 );
$actives{$_}{'label1'} = $actives{$_}{'frame'} ->Label(
-width => 3,
-background => 'black',
-foreground => 'lightgreen',
-textvariable => \$shash{$_}{'progress'},
)->pack( -side => 'left' );
$actives{$_}{'label2'} = $actives{$_}{'frame'} ->Label(
-width => 1,
-text => '%',
-background => 'black',
-foreground => 'lightgreen',
)->pack( -side => 'left' );
$actives{$_}{'label3'} = $actives{$_}{'frame'} ->Label(
-text => '',
-background => 'black',
-foreground => 'skyblue',
)->pack( -side => 'left',-padx =>10 );
}
#--------------------------------------------------
my $button = $lframe->Button(
-text => 'Get a worker',
-background => 'lightgreen',
-command => sub { &get_a_worker(time) }
)->pack( -side => 'top', -anchor => 'n', -fill=>'x', -pady =>
20 );
my $text = $rframe->Scrolled("Text",
-scrollbars => 'ose',
-background => 'black',
-foreground => 'lightskyblue',
)->pack(-side =>'top', -anchor =>'n');
my $repeat;
my $startbut;
my $repeaton = 0;
$startbut = $lframe->Button(
-text => 'Start Test Count',
-background => 'hotpink',
-command => sub {
my $count = 0;
$startbut->configure( -state => 'disabled' );
$repeat = $mw->repeat(
100,
sub {
$count++;
$text->insert( 'end', "$count\n" );
$text->see('end');
}
);
$repeaton = 1;
})->pack( -side => 'top', -fill=>'x', -pady => 20);
my $stoptbut = $lframe->Button(
-text => 'Stop Count',
-command => sub {
$repeat->cancel;
$repeaton = 0;
$startbut->configure( -state => 'normal' );
})->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20 );
my $exitbut = $lframe->Button(
-text => 'Exit',
-command => sub {
foreach my $dthread(keys %hash){
$shash{$dthread}{'die'} = 1;
$hash{$dthread}{'thread'}->join
}
if ($repeaton) { $repeat->cancel }
#foreach ( keys %downloads ) {
# #$downloads{$_}{'repeater'}->cancel;
#}
# $mw->destroy;
exit;
})->pack( -side => 'top',-anchor => 'n', -fill=>'x', -pady => 20
);
#dialog to get file url---------------------
my $dialog = $mw->Dialog(
-background => 'lightyellow',
-title => 'Get File',
-buttons => [ "OK", "Cancel" ]
);
my $hostl = $dialog->add(
'Label',
-text => 'Enter File Url',
-background => 'lightyellow'
)->pack();
my $hostd = $dialog->add(
'Entry',
-width => 100,
-textvariable => '',
-background => 'white'
)->pack();
$dialog->bind( '<Any-Enter>' => sub { $hostd->Tk::focus } );
my $message = $mw->Dialog(
-background => 'lightyellow',
-title => 'ERROR',
-buttons => [ "OK" ]
);
my $messagel = $message->add(
'Label',
-text => ' ',
-background => 'hotpink'
)->pack();
$mw->repeat(10, sub{
if(scalar @ready == $numworkers){return}
foreach my $set(1..$numworkers){
$actives{$set}{'label1'}->
configure(-text =>\$shash{$set}{'progress'});
if(($shash{$set}{'go'} == 0) and
($shash{$set}{'frame_open'} == 1))
{
my $timekey = $shash{$set}{'timekey'};
$workers{ $timekey }{'frame'}->packForget;
$shash{$set}{'frame_open'} = 0;
push @ready, $workers{$timekey}{'setnum'};
if((scalar @ready) == 3)
{ $activity->configure(-value => 0) }
$workers{$timekey} = ();
delete $workers{$timekey};
}
}
});
$mw->MainLoop;
###################################################################
sub get_a_worker {
my $timekey = shift;
$hostd->configure( -textvariable => \$data);
if ( $dialog->Show() eq 'Cancel' ) { return }
#----------------------------------------------
#get an available frameset
my $setnum;
if($setnum = shift @ready){print "setnum->$setnum\n"}
else{ print "no setnum available\n"; return}
$workers{$timekey}{'setnum'} = $setnum;
$shash{$setnum}{'timekey'} = $timekey;
$workers{$timekey}{'frame'} = $actives{$setnum}{'frame'};
$workers{$timekey}{'frame'}->pack(-side =>'bottom', -fill => 'both' );
$workers{$timekey}{'stopbut'} = $actives{$setnum}{'stopbut'};
$workers{$timekey}{'stopbut'}->configure(
-command => sub {
$workers{$timekey}{'frame'}->packForget;
$shash{ $workers{$timekey}{'setnum'} }{'go'} = 0;
$shash{ $workers{$timekey}{'setnum'} }{'frame_open'} = 0;
push @ready, $workers{$timekey}{'setnum'};
if((scalar @ready) == $numworkers)
{ $activity->configure(-value => 0) }
$workers{$timekey} = ();
delete $workers{$timekey};
});
$workers{$timekey}{'label1'} = $actives{$setnum}{'label1'};
$workers{$timekey}{'label1'}->configure(
-textvariable => \$shash{$setnum}{'progress'},
);
$workers{$timekey}{'label2'} = $actives{$setnum}{'label2'};
$workers{$timekey}{'label3'} = $actives{$setnum}{'label3'};
$workers{$timekey}{'label3'}->configure(-text => $timekey);
$activity->startActivity();
$shash{$setnum}{'go'} = 1;
$shash{$setnum}{'frame_open'} = 1;
#--------end of get_file sub--------------------------
}
##################################################################
sub work{
my $dthread = shift;
$|++;
while(1){
if($shash{$dthread}{'die'} == 1){ goto END };
if ( $shash{$dthread}{'go'} == 1 ){
eval( system( $shash{$dthread}{'data'} ) );
foreach my $num (1..100){
$shash{$dthread}{'progress'} = $num;
print "\t" x $dthread,"$dthread->$num\n";
select(undef,undef,undef, .5);
if($shash{$dthread}{'go'} == 0){last}
if($shash{$dthread}{'die'} == 1){ goto END };
}
$shash{$dthread}{'go'} = 0; #turn off self before returning
}else
{ sleep 1 }
}
END:
}
######################################################
__END__
--
I'm not really a human, but I play one on earth.
http://zentara.net/japh.html
------------------------------
Date: Fri, 14 Jan 2005 17:15:38 GMT
From: gargoyle <gargoyle@no.spam>
Subject: Win32::API memory leak?
Message-Id: <_6TFd.7507$BP1.5093@bignews4.bellsouth.net>
I'm using Win32::API to access the FindFirstFile() system call. It
works, but repeated calls have the effect of increasing Perl's memory
footprint (looking at the 'Process' tab of taskmgr.exe in Win2000 Server).
Here's the script that exhibits this behavior. I commented out the call
to FindNextFile() since even the original FFF call is enough to show
the problem.
Is there a bug in Win32::API? Or is my code at fault?
use strict;
use warnings;
use Data::Dumper; $Data::Dumper::Indent=1; $Data::Dumper::Sortkeys=1;
use Win32::API;
#$Win32::API::DEBUG = 1;
use constant ERROR_NO_MORE_FILES => 18;
use constant INVALID_HANDLE_VALUE => -1;
Win32::API::Struct->typedef('FILETIME', qw(
DWORD dwLowDateTime;
DWORD dwHighDateTime;
));
Win32::API::Struct->typedef('WIN32_FIND_DATA', qw(
DWORD dwFileAttributes;
FILETIME ftCreationTime;
FILETIME ftLastAccessTime;
FILETIME ftLastWriteTime;
DWORD nFileSizeHigh;
DWORD nFileSizeLow;
DWORD dwReserved0;
DWORD dwReserved1;
TCHAR cFileName[260];
TCHAR cAlternateFileName[14];
));
my $FindFirstFile = Win32::API->new('kernel32.dll', 'FindFirstFile', 'PS', 'N') or die $^E;
my $FindNextFile = Win32::API->new('kernel32.dll', 'FindNextFile', 'NS', 'I') or die $^E;
my $FindClose = Win32::API->new('kernel32.dll', 'FindClose', 'N', 'I') or die $^E;
while (1) {
DirList(@ARGV);
print "\n----- Hit ENTER to continue -----\n";
<STDIN>;
}
sub DirList {
my $searchDir = shift;
my $FileInfo = Win32::API::Struct->new('WIN32_FIND_DATA');
my $searchHandle = $FindFirstFile->Call("$searchDir\\*", $FileInfo);
die $^E if ($searchHandle == INVALID_HANDLE_VALUE);
# do {
print 'filename = ',$FileInfo->{cFileName},"\n";
# print Dumper($FileInfo);
# } while (my $result = $FindNextFile->Call($searchHandle, $FileInfo));
#
# if (Win32::GetLastError() != ERROR_NO_MORE_FILES) {
# die $^E;
# }
$FindClose->Call($searchHandle) or die $^E;
}
------------------------------
Date: Fri, 14 Jan 2005 18:14:33 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: Works great!
Message-Id: <cs91t1$ph$1@sun3.bham.ac.uk>
Tad McClellan wrote:
> Jim Gibson <jgibson@mail.arc.nasa.gov> wrote:
>
>
>>The local declaration creates a
>>temporary variable within the innermost enclosing block:
>
>
>
> No it doesn't.
>
> It creates a temporary *value* for a variable.
That statement is possibly correct but misleading. Different people
mean different things by "the variable" and "the value of the variable".
local($foo) temporarily changes the scalar slot in the GLOB *foo to
point to a different SV.
Arguably this _is_ creating a temporary *value* for a variable.
However, I would expect on reading your statement that local() "creates
a temporary *value* for a variable" that many people would expect the
following code to print 'foo'. Actually it prints 'bar'.
our $v = 'bar';
my $r=\$v;
local $v = 'foo';
print "$$r\n";
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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.
#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 V10 Issue 7649
***************************************
