[25407] in Perl-Users-Digest
Perl-Users Digest, Issue: 7652 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Jan 14 21:05:21 2005
Date: Fri, 14 Jan 2005 18: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: 7652
Today's topics:
Re: Advice on starting form based application <noreply@gunnar.cc>
Array generation poopdeville@gmail.com
Re: Array generation <abigail@abigail.nl>
Re: Array generation poopdeville@gmail.com
Re: Array generation <jl_post@hotmail.com>
Re: Array generation poopdeville@gmail.com
Re: convention regarding lexical filehandles <spamtrap@dot-app.org>
Re: convention regarding lexical filehandles <abigail@abigail.nl>
Re: daemonizing a process AND capture stdout, stderr <gyruss@hushmail.com>
Handling fractions of seconds in strftime/strptime skip@pobox.com
Re: Log File parser <1usa@llenroc.ude.invalid>
Re: Need help with Perl and MySQL database data load <nospam@bigpond.com>
Re: newbie pattern match question :-) <1usa@llenroc.ude.invalid>
Re: newbie pattern match question :-) <tadmc@augustmail.com>
Re: Opening a text file and editing its contents <1usa@llenroc.ude.invalid>
passing a hash reference to subroutine <abc@invalid.com>
Re: passing a hash reference to subroutine <1usa@llenroc.ude.invalid>
Store a single character AFTER a match toomanyjoes@mail.utexas.edu
Re: Tk: Call subroutine when MainWindow is realized? <lusol@Dragonfly.cc.lehigh.edu>
What!?! Code after __END_ ??? <jkrugman345@yahbitoo.com>
Re: What!?! Code after __END_ ??? <abigail@abigail.nl>
Re: What!?! Code after __END_ ??? <andy@andyh.co.uk>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 15 Jan 2005 01:11:37 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Advice on starting form based application
Message-Id: <34r5mdF4eipl9U1@individual.net>
dbmeyers23@yahoo.com wrote:
> I'd also like to write the contents to a file, then mail the contents
> out. I can get the "Client Name:" to show up in the email, but the
> variable is not showing up.
<snip>
> printf INT_EMAIL ("$$_[1]: ", $query->param( $$_[0] ), "\r\n");
That's because you are using the wrong function. You want print().
( printf() is for formating, and has nothing to do with whether you
print to a file. )
In addition to that, you probably don't want "\r\n", but just "\n". In
Perl, "\n" represents the newline for the current platform.
> `cat /usr/local/apache2/ads/xxx.txt | /bin/mail -u "ads"
> -s "$Subject" ads\@mail.com`;
As regards sending emails from Perl, you may want to study
perldoc -q "send mail"
Doing so will show you that there is no need to save the message body to
a file before mailing it out.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: 14 Jan 2005 16:23:59 -0800
From: poopdeville@gmail.com
Subject: Array generation
Message-Id: <1105748638.983929.45900@c13g2000cwb.googlegroups.com>
Hi everybody. I'm a bit new to Perl, and I'm having some trouble
getting it to do exactly what I'd like it to. Given an array of
numerals @data, I'm trying to generate a new array whose elements are
the fractions of minima over maxima of adjacent pairs in @data. Here's
my attempt (I've defined min and max elsewhere -- they compute the
minimum and maximum of arrays of arbitrary length, for generality)
@data = (1,2,4,8,16)
sub RR {
my $upper = $#_;
@LOF = min(($_[0], $_[1])) / max(($_[0], $_[1]));
for $i (1 .. $upper - 1) {
push @LOF, min($_[$i], $_[$i+1]) / max($_[$i], $_[$i+1]);
}
print @LOF, "\n";
}
RR(@data);
This is giving me the right *form* of answer, but instead of giving me
the .5.5.5.5 I expect, it's returning 0.510.50.25. Obviously, I've
misunderstood some convention. :-) Anybody see what's wrong?
Thanks,
'cid 'ooh
------------------------------
Date: 15 Jan 2005 00:36:46 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: Array generation
Message-Id: <slrncugpct.5am.abigail@alexandra.abigail.nl>
poopdeville@gmail.com (poopdeville@gmail.com) wrote on MMMMCLV September
MCMXCIII in <URL:news:1105748638.983929.45900@c13g2000cwb.googlegroups.com>:
-: Hi everybody. I'm a bit new to Perl, and I'm having some trouble
-: getting it to do exactly what I'd like it to. Given an array of
-: numerals @data, I'm trying to generate a new array whose elements are
-: the fractions of minima over maxima of adjacent pairs in @data. Here's
-: my attempt (I've defined min and max elsewhere -- they compute the
-: minimum and maximum of arrays of arbitrary length, for generality)
-:
-: @data = (1,2,4,8,16)
-: sub RR {
-: my $upper = $#_;
-: @LOF = min(($_[0], $_[1])) / max(($_[0], $_[1]));
-: for $i (1 .. $upper - 1) {
-: push @LOF, min($_[$i], $_[$i+1]) / max($_[$i], $_[$i+1]);
-: }
-: print @LOF, "\n";
-: }
-:
-: RR(@data);
Aarg. Another code snippet without identation. That's it.
Killfile, meet google groups. Google groups, meet my killfile.
Abigail
--
perl -wle 'eval {die ["Just another Perl Hacker"]}; print ${$@}[$#{@${@}}]'
------------------------------
Date: 14 Jan 2005 16:42:18 -0800
From: poopdeville@gmail.com
Subject: Re: Array generation
Message-Id: <1105749738.734347.195220@f14g2000cwb.googlegroups.com>
Fixing indentation, since this code is ugly without it:
poopdevi...@gmail.com wrote:
> Hi everybody. I'm a bit new to Perl, and I'm having some trouble
> getting it to do exactly what I'd like it to. Given an array of
> numerals @data, I'm trying to generate a new array whose elements are
> the fractions of minima over maxima of adjacent pairs in @data.
Here's
> my attempt (I've defined min and max elsewhere -- they compute the
> minimum and maximum of arrays of arbitrary length, for generality)
>
sub RR {
my $upper = $#_;
@LOF = min(($_[0], $_[1])) / max(($_[0], $_[1]));
for $i (1 .. $upper - 1) {
push @LOF, min($_[$i], $_[$i+1]) / max($_[$i], $_[$i+1]);
}
print @LOF, "\n";
}
>
> This is giving me the right *form* of answer, but instead of giving
me
> the .5.5.5.5 I expect, it's returning 0.510.50.25. Obviously, I've
> misunderstood some convention. :-) Anybody see what's wrong?
> Thanks,
> 'cid 'ooh
------------------------------
Date: 14 Jan 2005 17:05:59 -0800
From: "jl_post@hotmail.com" <jl_post@hotmail.com>
Subject: Re: Array generation
Message-Id: <1105750497.723933.322530@z14g2000cwz.googlegroups.com>
poopdevi...@gmail.com wrote:
>
> Here's my attempt (I've defined min and max
> elsewhere -- they compute the minimum and
> maximum of arrays of arbitrary length, for generality)
>
> @data = (1,2,4,8,16)
> sub RR {
> my $upper = $#_;
> @LOF = min(($_[0], $_[1])) / max(($_[0], $_[1]));
> for $i (1 .. $upper - 1) {
> push @LOF, min($_[$i], $_[$i+1]) / max($_[$i], $_[$i+1]);
> }
> print @LOF, "\n";
> }
>
> RR(@data);
>
> This is giving me the right *form* of answer,
> but instead of giving me the .5.5.5.5 I expect,
> it's returning 0.510.50.25. Obviously, I've
> misunderstood some convention. :-) Anybody
> see what's wrong?
I ran your program and it seems to run fine for me
(with the exception of the missing semicolon where you
first define your @data array).
Of course, I had to define my own min() and max()
functions, which is why I suspect that they are the
reasons your program is not running correctly. Try
running this code, which is essentially your exact
code but with min() and max() defined (and with
"use strict;" and "use warnings;"):
| #!/usr/bin/perl
| use strict;
| use warnings;
|
| sub min { $_[0] < $_[1] ? $_[0] : $_[1] }
| sub max { $_[0] > $_[1] ? $_[0] : $_[1] }
|
| sub RR {
| my $upper = $#_;
| my @LOF = min(($_[0], $_[1]))
| / max(($_[0], $_[1]));
| for my $i (1 .. $upper - 1) {
| push @LOF, min($_[$i], $_[$i+1])
| / max($_[$i], $_[$i+1]);
| }
| print "@LOF\n";
| }
|
| my @data = (1,2,4,8,16);
| RR(@data);
| __END__
Note that your RR() function is not the most ideal
way to write it. For one thing, you don't have to
set @LOF to a value and then loop from 1 to $upper - 1.
You could just declare @LOF, then loop from 0 to $upper - 1.
(I would also give @LOF and RR() more descriptive names
that would be more helpful to code maintainers that come
after you. (Believe me, they won't like it very
much not knowing what LOF and RR are supposed to stand
for.))
So I recommend you examine and test your min() and
max() functions. I have a feeling that's where your
error lies.
Hope this helps,
-- Jean-Luc
------------------------------
Date: 14 Jan 2005 17:40:49 -0800
From: poopdeville@gmail.com
Subject: Re: Array generation
Message-Id: <1105753249.369761.46600@f14g2000cwb.googlegroups.com>
jl_post@hotmail.com wrote:
> Note that your RR() function is not the most ideal
> way to write it. For one thing, you don't have to
> set @LOF to a value and then loop from 1 to $upper - 1.
> You could just declare @LOF, then loop from 0 to $upper - 1.
> (I would also give @LOF and RR() more descriptive names
> that would be more helpful to code maintainers that come
> after you. (Believe me, they won't like it very
> much not knowing what LOF and RR are supposed to stand
> for.))
>
> So I recommend you examine and test your min() and
> max() functions. I have a feeling that's where your
> error lies.
>
Yes! Actually, the functions min and max were operating correctly
(well, I'm pretty sure. I wasn't getting compile errors at all, and
the algorithm is *very* simple) but interacted badly with RR because
used $i as an index but failed to protect it:
sub max {
my $upper = @_; # instead of " my
$upper = $#_; "
my $max = $_[0]; # and
for ($i = 0, $i < $upper, $i++) { # " for my $i (0 ..
$upper) "
if ($max < $_[$i]) {
$max = $_[$i];
}
} return $max;
}
Thinking about what the two subroutines were doing together is making
my head hurt. :-) Thanks for your help and suggestions.
'cid 'ooh
------------------------------
Date: Fri, 14 Jan 2005 20:13:30 -0500
From: Sherm Pendley <spamtrap@dot-app.org>
Subject: Re: convention regarding lexical filehandles
Message-Id: <TJCdnYhLlqam83XcRVn-qg@adelphia.com>
Abigail wrote:
> And a - is a valid character in most file systems as well. Yet 'rm -r'
> doesn't remove the file. Is rm broken?
No, the user typed the wrong command. "rm -- -r" is the correct command to
use in that instance. That option is specifically mentioned in "man rm",
for the express purpose of supporting files that begin with -.
Why do you keep bringing up mistyped or incorrect commands, when that's not
even relevant? The issue is a program that breaks *when it's being used
correctly*.
I don't understand your reluctance on this issue, honestly. It's not as if
you need to jump through hoops or anything - the difference in programmer
effort between "open FOO, $bar" and "open FOO, '<', $bar" is negligible.
In my view, you've got it completely backwards. The real question is what
possible benefit would you get from *not* using 3-argument open()?
sherm--
--
Cocoa programming in Perl: http://camelbones.sourceforge.net
Hire me! My resume: http://www.dot-app.org
------------------------------
Date: 15 Jan 2005 01:37:15 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: convention regarding lexical filehandles
Message-Id: <slrncugsub.5au.abigail@alexandra.abigail.nl>
Sherm Pendley (spamtrap@dot-app.org) wrote on MMMMCLV September MCMXCIII
in <URL:news:TJCdnYhLlqam83XcRVn-qg@adelphia.com>:
__ Abigail wrote:
__
__ > And a - is a valid character in most file systems as well. Yet 'rm -r'
__ > doesn't remove the file. Is rm broken?
__
__ No, the user typed the wrong command. "rm -- -r" is the correct command to
__ use in that instance. That option is specifically mentioned in "man rm",
__ for the express purpose of supporting files that begin with -.
And in this case, the correct command is
perl-script './>file.txt'
__ Why do you keep bringing up mistyped or incorrect commands, when that's not
__ even relevant? The issue is a program that breaks *when it's being used
__ correctly*.
No, it's not being used correctly. Otherwise, it wouldn't break.
Why is it why you accept passing filenames in another ways then
exactly typing the filename to cat or rm, but when can't do that
with a Perl program, you balk?
__ I don't understand your reluctance on this issue, honestly. It's not as if
__ you need to jump through hoops or anything - the difference in programmer
__ effort between "open FOO, $bar" and "open FOO, '<', $bar" is negligible.
__
__ In my view, you've got it completely backwards. The real question is what
__ possible benefit would you get from *not* using 3-argument open()?
Then you have magic open. 3-arg open isn't magical.
Say you have a diff utility written in Perl. Magical open allows you to
get the difference from the output of two commands:
mydiff 'prog1 |' 'prog2 |'
Abigail
--
END {print "Hacker\n"}
CHECK {print "another "}
INIT {print "Perl " }
BEGIN {print "Just " }
------------------------------
Date: Sat, 15 Jan 2005 10:59:23 +1100
From: "Gyruss" <gyruss@hushmail.com>
Subject: Re: daemonizing a process AND capture stdout, stderr
Message-Id: <41e85cdb$1@dnews.tpgi.com.au>
"Brian McCauley" <nobull@mail.com> wrote in message
news: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.
>
To be honest I think that's a little crude.
There's some code in the 1997 perl journal that I think should do the trick,
the guts of it is below.
http://www.foo.be/docs/tpj/issues/vol2_1/tpj0201-0008.html
$READ_BITS = ''; # "bitlist" of parent filehandles
my($fh) = ('fh0000'); # indirect filehandle names
my($cr, $cw); # child read and write filehandles
foreach (@{$OPT{hosts}}) {
$cr = $fh++;
$CHILD{$ARG}->{pw} = $fh++;
pipe($cr, $CHILD{$ARG}->{pw}) or abort 'cr/pw pipe';
$CHILD{$ARG}->{pr} = $fh++;
$cw = $fh++;
pipe($CHILD{$ARG}->{pr}, $cw) or abort 'pr/cw pipe';
if ($CHILD{$ARG}->{pid} = fork) { # parent
close $cr;
close $cw;
$CHILD{$ARG}->{pw}->autoflush(1);
vec($READ_BITS, fileno($CHILD{$ARG}->{pr}), 1) = 1;
} elsif (defined($CHILD{$ARG}->{pid})) { # child
close $CHILD{$ARG}->{pr};
close $CHILD{$ARG}->{pw};
open(STDIN, "<&$cr") or abort 'STDIN open';
open(STDOUT, ">&$cw") or abort 'STDOUT open';
open(STDERR, ">&$cw") or abort 'STDERR open';
STDOUT->autoflush(1);
STDERR->autoflush(1);
exec("$LIBDIR/monds_client",$ARG,$PORT)
or abort 'exec';
} else {
abort 'fork';
} # if fork
} # for each monitored machine
------------------------------
Date: 14 Jan 2005 17:17:16 -0800
From: skip@pobox.com
Subject: Handling fractions of seconds in strftime/strptime
Message-Id: <1105751836.456124.69970@z14g2000cwz.googlegroups.com>
I'm looking for a solution (or ideas about a solution) to the problem
that strftime(3) and strptime(3) don't understand time increments of
less than one second. Most operating systems can provide times with
subsecond resolution and like Python I'm pretty sure Ruby, Perl and
Tcl have objects or packages that can manipulate such times in a sane
manner. I'm casting my net to a broader community than just Python
(where I generally hang out) to see if/how others have addressed this
problem.
Here's my typical use case. I generate log files with subsecond
resolution using Python's datetime module. By default it generates
printable timestamps in an ISO format that includes fractions of
seconds, e.g., "2005-01-14 18:56:54.546607". I often need to parse
such times, and therein lies the rub. Python's date parsing is based
on strptime(3) which can't handle fractions of seconds. I wind up
worming around the problem with a little hackery, but it bothers me
that given an otherwise complete solution to formatting and parsing
times I can't handle this common (for me) case.
I realize that other languages may not base their current time
formatting and parsing on strftime(3) and strptime(3), but I suspect
those two functions were at least the root of what is commonly used by
most languages. In my investigation I came across a DateTime module
in Perl that uses "%N" (or optionally "%nN" where n is a digit) to
identify integers as nanoseconds or some other subsecond time. I
belive "%3N" would cause "123" to be interpreted as 123 milliseconds,
for instance. I've considered extending "%S" to accept fractional
seconds or adding a new format specifier like "%F" to handle this
case.
I'm interested to know what solutions have been devised or considered
for other languages. (Has this been addressed in some more recent
version of the C or C++ standards I'm unaware of?) Rather than
reinventing the wheel I'd like to adopt an existing solution if
possible. At the very least I'd like to know how others have
approached the problem. I think there's an opportunity to add some
value that everyone can take advantage of.
Thanks for your time,
Skip Montanaro
skip@pobox.com
------------------------------
Date: 14 Jan 2005 23:31:48 GMT
From: "A. Sinan Unur" <1usa@llenroc.ude.invalid>
Subject: Re: Log File parser
Message-Id: <Xns95DEBC80E6B4Easu1cornelledu@132.236.56.8>
"jc8glp1hu" <jgarretthood@gmail.com> wrote in news:1105712217.077518.277530
@c13g2000cwb.googlegroups.com:
> 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
Ahem ... The OP responded:
"George Monappallil" <georgemj@sympatico.ca> wrote in
news:j0IFd.32940$b64.1069805@news20.bellglobal.com:
> Great...will do so surely.
>
> -G
It seems like he was fine with the answer he got.
> 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.
That understanding comes from asking "smart questions" and thinking about
the answers one gives.
> 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.
It is funny how you equate helping with posting crappy code.
It is the equivalent of giving wrong directions to a tourist instead of
admitting you don't know.
Ponder that for a few minutes.
Sinan.
------------------------------
Date: Sat, 15 Jan 2005 09:33:07 +1000
From: Gregory Toomey <nospam@bigpond.com>
Subject: Re: Need help with Perl and MySQL database data load
Message-Id: <34r35pF4dvivnU1@individual.net>
Oscar wrote:
> Hello,
>
> I'm kind of a newbie to Perl and MySQL and have researched this problem
> to death but still can't find something that works.
>
> I've written a script to load data into a MySQL database:
>
>> my $dbh = DBI->connect("dbi:mysql:sd_tst','localhost:3306','root',
>> 'XXXXXXX'",
>> {RaiseError => 1, AutoCommit => 1 }
>>
This looks odd. I use:
$dbh =DBI->connect("DBI:mysql:$database", "$user", "$password", {RaiseError
=> 1, PrintError => 0, AutoCommit => 1 });
Also see whether you can log on to mysql from the command line.
mysql -u user -ppassword database
gtoomey
------------------------------
Date: 14 Jan 2005 23:36:33 GMT
From: "A. Sinan Unur" <1usa@llenroc.ude.invalid>
Subject: Re: newbie pattern match question :-)
Message-Id: <Xns95DEBD4E7F4B9asu1cornelledu@132.236.56.8>
davidcsnow@yahoo.com wrote in news:1105742475.419709.52790
@c13g2000cwb.googlegroups.com:
> Thanks for the help guys - great advice there!!!
>
> The below does exactly what I was looking for, so thanks for the help,
> and for the advice on the doc.
>
> $text = "hello(world)";
> ($new) = $text =~ /\((.*)\)/;
You might also benefit from reading
perldoc -q matching
Sinan
------------------------------
Date: Fri, 14 Jan 2005 19:26:51 -0600
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: newbie pattern match question :-)
Message-Id: <slrncugsar.60j.tadmc@magna.augustmail.com>
davidcsnow@yahoo.com <davidcsnow@yahoo.com> wrote:
> The below does exactly what I was looking for,
Have you tried it with a string like this yet?
my $text = "hello(world) hello(dolly)";
> $text = "hello(world)";
> ($new) = $text =~ /\((.*)\)/;
Why aren't there "my" declarations on those statements?
You do have "use strict" turned on, don't you?
You are likely to want non-greedy matching:
my($new) = $text =~ /\((.*?)\)/;
or greedy-but-not-paren matching:
my($new) = $text =~ /\(([^)]*)\)/;
which is altogether too ugly, so let's do an "x"treme makeover:
my ($new) = $text =~ /
\( # an open paren
( # memory 1 contains...
[^)]* # ...chars that are not close parens
) # end of memory 1
\) # a close paren
/x;
or, if you _want_ to get more that just the first one:
my @new = $text =~ /
\( # an open paren
( # memory 1 contains...
[^)]* # ...chars that are not close parens
) # end of memory 1
\) # a close paren
/xg;
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texa
------------------------------
Date: 14 Jan 2005 23:47:33 GMT
From: "A. Sinan Unur" <1usa@llenroc.ude.invalid>
Subject: Re: Opening a text file and editing its contents
Message-Id: <Xns95DEBF2C42E9asu1cornelledu@132.236.56.8>
toomanyjoes@mail.utexas.edu wrote in news:1105740122.984904.253900
@c13g2000cwb.googlegroups.com:
> What you have written is EXACTLY what I am looking for!
Who is 'you'? What did he/she write? What are you responding to?
> I'm assuming the print command on the last line is the command
> that actually executes the changes above?
This statement is a tautology as the antecedent is false.
> My question is by using $ARGV[0] (What exactly is this doing in
> this case)
See
perldoc perlvar
> how does the compiler know what file $file is?
That is a really philosophical question. I do not see any variable called
$file in the nonexistent code your are referring to.
> Should I set ARGC[0] equal to the filename in a line above?
How would changing a line in your post accomplish anything?
> When I run the code as you have shown it I get no output and no
> changes are made to the text file.
That is to be expected when one runs non-existent code.
Sinan.
------------------------------
Date: Fri, 14 Jan 2005 23:06:24 GMT
From: ktom <abc@invalid.com>
Subject: passing a hash reference to subroutine
Message-Id: <QfYFd.7077$_56.2931@fe2.texas.rr.com>
is this a valid way to pass a hash to a subroutine?
&getBest( \%{$eventHash{$eventCnt}} ) ;
i know the eventHash is good and there are more hash entries for each
eventCnt as the contents can be accessed through normal methods like below
96 foreach my $prim ( keys %eventHash ) {
97 # foreach my $sec ( keys %{$eventHash{$prim}} ) {
98 foreach my $rdrb ( @rptOrderBasic ) {
99 # print "$prim, $sec, $eventHash{$prim}{$sec}\n" ;
100 print "$eventHash{$prim}{$rdrb}," ;
101
thanks
------------------------------
Date: 14 Jan 2005 23:25:04 GMT
From: "A. Sinan Unur" <1usa@llenroc.ude.invalid>
Subject: Re: passing a hash reference to subroutine
Message-Id: <Xns95DEBB5BF5B95asu1cornelledu@132.236.56.8>
ktom <abc@invalid.com> wrote in
news:QfYFd.7077$_56.2931@fe2.texas.rr.com:
> is this a valid way to pass a hash to a subroutine?
>
> &getBest( \%{$eventHash{$eventCnt}} ) ;
First, read
perldoc perlsub
on why you should not use the & above unless you need the specific features
it provides.
Second, please post the a short complete script that exhibits the problem
you are trying to solve rather than a mish-mash of punctuation.
You might find Data::Dumper useful in visualizing what gets passed to your
sub.
Sinan
------------------------------
Date: 14 Jan 2005 17:37:22 -0800
From: toomanyjoes@mail.utexas.edu
Subject: Store a single character AFTER a match
Message-Id: <1105753042.907689.36220@f14g2000cwb.googlegroups.com>
Hello I'm trying to edit a text file and after my script finishes save
that text file. One thing I need to do is save the character AFTER a
match into a variable.
while (<FILE>){
s/<(Ra|N\d)>//;
s!^(.\w\w)( \d+):(\d+)!$1~$2~$3!;
if (/<nsup>/)
# Then save the character
I've tried using the $POSTMATCH variable but it grabs the rest of the
line, I only want one character.
Also after I execute my replacements how do I save the changes to the
text file?
while (<FILE>){
s/<(Ra|N\d)>//;
s!^(.\w\w)( \d+):(\d+)!$1~$2~$3!;
}
#save the changes made??
close FILE
Thanks,
Joe
BTW I finally got the correct syntax to open a file!
#!/usr/local/bin/perl -w
use warnings;
use strict;
open FILE, '<', 'C:\gen.txt' or die "Could not open file. $!";
while (<FILE>){
s/<(Ra|N\d)>//;
s!^(.\w\w)( \d+):(\d+)!$1~$2~$3!;
print;
}
close FILE;
Thanks Guys!
------------------------------
Date: Sat, 15 Jan 2005 01:00:37 +0000 (UTC)
From: Steve Lidie <lusol@Dragonfly.cc.lehigh.edu>
Subject: Re: Tk: Call subroutine when MainWindow is realized?
Message-Id: <cs9pvl$5fcq$1@ws2.cc.lehigh.edu>
zentara <zentara@highstream.net> wrote:
> 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",
And why? ;) I'm always willing to learn more ...
> but I have been able to use threads with Tk, with 2 caveats.
OK, re-phrase: Tk is not thread safe. "can't use them" seemed
sufficient for a non-Tk group ;) BTW, we're still not in
comp.lang.perl.tk.
> 1. No passing objects around, only simple text and scalars.
> 2. Threads must be created before Tk is init'ed.
Similar to the fork() caveat that the child cannot touch in any way
parent Tk data structures.
>
> 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.
Another big reason "we" Tk-ers don't use threads is probably because
over the last decade their implementation has been a moving target,
and bug-prone. fork()/exec()/pipe() are better known and better
tested, etc. It's another idiom to learn, but, I and I'm sure others
would love to see/hear your experiences on the mailing list and
newsgroup.
Then maybe the following code would make more sense. Still the "no
passing objects" rule might be too hard to live with. Can you
explain more?
>
> #!/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__
>
>
>
>
------------------------------
Date: Sat, 15 Jan 2005 00:15:38 +0000 (UTC)
From: J Krugman <jkrugman345@yahbitoo.com>
Subject: What!?! Code after __END_ ???
Message-Id: <cs9nb9$cr5$1@reader2.panix.com>
When will Perl wonders *EVER* cease?
Despite *years* of programming in Perl I still come across legit
Perl code that I find as unfathomable as if I had just started
programming Perl one hour ago. And I'm not talking about the winner
of the Obfuscated Perl Contest.
What blindsids me this time around is in the CPAN module
Class::MethodMaker (v 1.12). About 90% of the code in
Class/MethodMaker.pm, which accounts for all the "supported methods"
for this module according to its documentation, appears *after*
the lines
1; # keep require happy
# ----------------------------------------------------------------------------
__END__
(See
http://search.cpan.org/src/FLUFFY/Class-MethodMaker-1.12/lib/Class/MethodMaker.pm.
The code for the most recent version of MethodMaker does the same
thing with __END__.)
What on earth is going on here? Every documentation I've managed
to find for __END__ says that the compiler doesn't go beyond it.
In the source prior to the __END__ there is no reading from <DATA>
and eval-ing the read text, and besides, this is a module not a
script, so reading from <DATA> would not work anyway.
How can this module work at all???
TIA!
jill
Perennial Perl Beginner
--
To s&e^n]d me m~a}i]l r%e*m?o\v[e bit from my a|d)d:r{e:s]s.
------------------------------
Date: 15 Jan 2005 00:41:45 GMT
From: Abigail <abigail@abigail.nl>
Subject: Re: What!?! Code after __END_ ???
Message-Id: <slrncugpm9.5au.abigail@alexandra.abigail.nl>
J Krugman (jkrugman345@yahbitoo.com) wrote on MMMMCLV September MCMXCIII
in <URL:news:cs9nb9$cr5$1@reader2.panix.com>:
??
??
?? What blindsids me this time around is in the CPAN module
?? Class::MethodMaker (v 1.12). About 90% of the code in
?? Class/MethodMaker.pm, which accounts for all the "supported methods"
?? for this module according to its documentation, appears *after*
?? the lines
??
?? 1; # keep require happy
??
?? # ----------------------------------------------------------------------------
??
?? __END__
??
?? (See
?? http://search.cpan.org/src/FLUFFY/Class-MethodMaker-1.12/lib/Class/MethodMaker.pm.
?? The code for the most recent version of MethodMaker does the same
?? thing with __END__.)
??
?? What on earth is going on here? Every documentation I've managed
?? to find for __END__ says that the compiler doesn't go beyond it.
?? In the source prior to the __END__ there is no reading from <DATA>
?? and eval-ing the read text, and besides, this is a module not a
?? script, so reading from <DATA> would not work anyway.
??
?? How can this module work at all???
The module also contains:
use AutoLoader 'AUTOLOAD';
"man AutoLoader" might be very helpful.
Abigail
--
perl -wle '$, = " "; sub AUTOLOAD {($AUTOLOAD =~ /::(.*)/) [0];}
print+Just (), another (), Perl (), Hacker ();'
------------------------------
Date: Sat, 15 Jan 2005 00:47:38 +0000
From: Andy Hassall <andy@andyh.co.uk>
Subject: Re: What!?! Code after __END_ ???
Message-Id: <drpgu0piap7ec9mijja5p9en1jdnt307cp@4ax.com>
On Sat, 15 Jan 2005 00:15:38 +0000 (UTC), J Krugman <jkrugman345@yahbitoo.com>
wrote:
>When will Perl wonders *EVER* cease?
Never, hopefully :-)
>Despite *years* of programming in Perl I still come across legit
>Perl code that I find as unfathomable as if I had just started
>programming Perl one hour ago. And I'm not talking about the winner
>of the Obfuscated Perl Contest.
>
>What blindsids me this time around is in the CPAN module
>Class::MethodMaker (v 1.12). About 90% of the code in
>Class/MethodMaker.pm, which accounts for all the "supported methods"
>for this module according to its documentation, appears *after*
>the lines
>
> 1; # keep require happy
>
> # ----------------------------------------------------------------------------
>
> __END__
>
>(See
>http://search.cpan.org/src/FLUFFY/Class-MethodMaker-1.12/lib/Class/MethodMaker.pm.
>The code for the most recent version of MethodMaker does the same
>thing with __END__.)
>
>What on earth is going on here? Every documentation I've managed
>to find for __END__ says that the compiler doesn't go beyond it.
>In the source prior to the __END__ there is no reading from <DATA>
>and eval-ing the read text, and besides, this is a module not a
>script, so reading from <DATA> would not work anyway.
>
>How can this module work at all???
http://search.cpan.org/~nwclark/perl-5.8.6/lib/AutoLoader.pm
"
To use AutoLoader, the author of a module has to place the definitions of
subroutines to be autoloaded after an __END__ token.
"
http://search.cpan.org/src/FLUFFY/Class-MethodMaker-1.12/lib/Class/MethodMaker.pm
"
use AutoLoader 'AUTOLOAD';
"
--
Andy Hassall / <andy@andyh.co.uk> / <http://www.andyh.co.uk>
<http://www.andyhsoftware.co.uk/space> Space: disk usage analysis tool
------------------------------
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 7652
***************************************
