[19748] in Perl-Users-Digest
Perl-Users Digest, Issue: 1943 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Oct 17 00:11:44 2001
Date: Tue, 16 Oct 2001 21:10:10 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Message-Id: <1003291810-v10-i1943@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Tue, 16 Oct 2001 Volume: 10 Number: 1943
Today's topics:
Memory leak in timelocal? (Miko O'Sullivan)
Re: Need cgi script jh123@nc.rr.com
Re: Need cgi script jh123@nc.rr.com
Re: Need cgi script <tintin@snowy.calculus>
Re: Need perl help please!!!!!! <uri@sysarch.com>
Re: newbie question - how to rename files with Perl? <goldbb2@earthlink.net>
Re: Objects: Setting defaults and calling themselves?? <Jon.Ericson@jpl.nasa.gov>
Problems with this code (randy5235)
Re: putting $1..$9 into a replacement string such as $r (=?ISO-8859-1?Q?sh=F2wd=F6g?=)
Re: Searching and splitting.. (Miko O'Sullivan)
Re: String To List <goldbb2@earthlink.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 16 Oct 2001 15:05:37 -0700
From: miko@idocs.com (Miko O'Sullivan)
Subject: Memory leak in timelocal?
Message-Id: <db27ea77.0110161405.464fdabf@posting.google.com>
I seem to be getting a memory leak in Time::Local::timelocal().
Here's exact code that shows the problem:
=== BEGIN code ===================
#!/usr/local/bin/perl -wT
use strict;
use lib '/home/miko/CpanLib/modules/lib/site_perl/5.6.0/i386-linux';
use Devel::Leak;
use Time::Local;
my ($handle);
Devel::Leak::NoteSV($handle);
# test for the leak
{
my $tl = timelocal(10, 45, 13, 10, 9, 2001);
print "\$tl: $tl\n\n";
}
Devel::Leak::CheckSV($handle);
=== END code ===================
Here's the output:
=== BEGIN output ===================
$tl: 1002735910
new 0x81647e8 :
new 0x81647f4 :
new 0x8164800 :
new 0x816480c :
new 0x8164818 :
new 0x8164824 :
new 0x8164830 :
new 0x816483c :
new 0x8164848 :
new 0x8164854 :
new 0x8164860 :
new 0x816486c :
new 0x8164878 :
new 0x8164884 :
new 0x8164890 :
new 0x8164938 :
new 0x8164944 :
new 0x8164950 :
new 0x816495c :
new 0x8164968 :
new 0x8164974 :
new 0x8164980 :
new 0x816498c :
new 0x8164998 :
new 0x815f0f4 :
new 0x815f118 :
new 0x815f208 :
new 0x815f394 :
=== END output ===================
I'm using Perl v5.6.0 built for i386-linux in Linux. The lib
referenced in the third line of code has nothing in it but Devel::Leak
(which, I suppose, could actually be the whole problem).
I've traced the problem as far as the following line in
Time::Local::cheat:
@g = gmtime($guess);
If I return a bogus just before that line then no leaks occur.
However, just running that command on its own passing the same values
into gmtime as $guess doesn't produce any leaks.
So, is this a bug in Time::Local, a bug in my code, in my head, or in
the very fabric of the Universe?
-Miko
------------------------------
Date: Tue, 16 Oct 2001 22:02:28 GMT
From: jh123@nc.rr.com
Subject: Re: Need cgi script
Message-Id: <3bccaf77.1278975@news-server>
On Tue, 16 Oct 2001 13:06:36 +0100, James Coupe <james@zephyr.org.uk>
wrote:
>In message <3bcc1bb2.554385@news-server>, jh123@nc.rr.com writes
>>Sorry if I posted off-topic... but how is this question off-topic?
>
>Soliciting for programmers you wish to write a script for you is best
>conducted in "jobs" groups.
Man, you are very adept at being unhelpful. Sorry I intruded your
little world.
>
>>I'm looking for a perl application (cgi script).
>
>Those two terms are not interchangeable.
>
I'm aware they are not interchangeable. My statement above does not
imply they are interchangeable. The statement clarifies that the perl
application I am seeking will happen to be a cgi script.
>--
>James Coupe PGP Key: 0x5D623D5D
>And if it's all right, I'd kind've like to be your lover EBD690ECD7A1F
>'Cause when you're with me I can't help but be B457CA213D7E6
>So desperately, uncontrollably happy 68C3695D623D5D
------------------------------
Date: Tue, 16 Oct 2001 22:06:06 GMT
From: jh123@nc.rr.com
Subject: Re: Need cgi script
Message-Id: <3bccb04a.1489505@news-server>
On Tue, 16 Oct 2001 18:58:04 GMT, Uri Guttman <uri@sysarch.com> wrote:
>>>>>> "BL" == Bart Lateur <bart.lateur@skynet.be> writes:
>
> BL> On-topic here is technical questions, like "how do you do this
> BL> better?". You want a prepackaged script. You don't seem to care
> BL> how it works. That is off-topic. If you're looking for free
> BL> scripts, search the web for "free cgi scripts". Like, uh, here
> BL> :<http://cgi.resourceindex.com/>
>
>eww, sending him to matt wright's place? shame on you!
>
>uri
>
>--
>Uri Guttman --------- uri@sysarch.com ---------- http://www.sysarch.com
>SYStems ARCHitecture and Stem Development ------ http://www.stemsystems.com
>Search or Offer Perl Jobs -------------------------- http://jobs.perl.org
I've already searched the web exhaustively for such a script and
haven't found it. That's why, as my last resort, I am here, hoping
that someone might have run across the script or might be using one
(and be able to provide it).
------------------------------
Date: Wed, 17 Oct 2001 09:36:05 +1000
From: "Tintin" <tintin@snowy.calculus>
Subject: Re: Need cgi script
Message-Id: <Mw3z7.5$Be1.44076@news.interact.net.au>
<jh123@nc.rr.com> wrote in message news:3bccb04a.1489505@news-server...
> I've already searched the web exhaustively for such a script and
> haven't found it. That's why, as my last resort, I am here, hoping
> that someone might have run across the script or might be using one
> (and be able to provide it).
Try alt.comp.perlcgi.freelance
------------------------------
Date: Tue, 16 Oct 2001 23:37:34 GMT
From: Uri Guttman <uri@sysarch.com>
Subject: Re: Need perl help please!!!!!!
Message-Id: <x7lmib5f6i.fsf@home.sysarch.com>
that block of line noise is not executable perl. try pasting in code and
maybe someone could read it and help you. also try to reduce the code to
the shortest you can that shows your problem.
also a better subject line would help a lot.
uri
--
Uri Guttman --------- uri@sysarch.com ---------- http://www.sysarch.com
SYStems ARCHitecture and Stem Development ------ http://www.stemsystems.com
Search or Offer Perl Jobs -------------------------- http://jobs.perl.org
------------------------------
Date: Tue, 16 Oct 2001 23:41:41 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: newbie question - how to rename files with Perl?
Message-Id: <3BCCFDF5.F6890CD3@earthlink.net>
Brehm wrote:
>
> Hello-
>
> I was hoping to dive into Perl by learning how to do a simple task.
>
> I spend quite a bit of time renaming files. I would like a script /
> program I write to do this for me.
> For example, I do the following to all files:
That means you want File::Find
>
> -removing "_-_" & replacing with "-"
> -converting to lowercase
> -replacing an empty space with "_"
The first is s///, the second lc, and the third is tr//.
Since for each file, you probably want to do all of these to it, have
the wanted sub make a copy of $_, do the transformations on it, and if
the new name differs from the old, rename the file.
find( sub {
my $foo = $_;
$foo =~ s/_-_/-/g; $foo = lc $foo; $foo =~ tr/ /_/s;
rename( $_, $foo ) if $foo ne $_;
}, @directories );
--
"What does stupid old man mean pidgin talk? Shampoo does not talk like a
bird."
------------------------------
Date: 16 Oct 2001 14:14:43 +0000
From: Jon Ericson <Jon.Ericson@jpl.nasa.gov>
Subject: Re: Objects: Setting defaults and calling themselves??
Message-Id: <86669fd63w.fsf@jon_ericson.jpl.nasa.gov>
Ed Kulis <ekulis@apple.com> writes:
> The elementary operasions called from a script like this:
No warnings and no strictures. This is a bad sign that you haven't
read this newsgroup very long.
> package main;
I've never seen this before. This is a script right? You are already
in package main, so this does nothing.
> use lib ".";
This is ok for testing, I guess, but it will break when you call the
script from some other directory. Consider using absolute pathing and
the PERLLIB environment variable.
> use CrmRcs;
> use CrmUtil;
Presumably these have something to do with Revision Control System
(RCS). Have you looked at the modules on CPAN?
<http://search.cpan.org> Unless you have a really good reason to
re-invent the wheel, you probably shouldn't.
Some advice on asking technical questions: Try to ask focused
questions. It seems like what you were asking could be phrased in a
sentence or two. If you have an example it should be only what you
need to illustrate the problem. Often times it's easiest to use
really generic names like foo or $a, so that people know you are
talking about "some function" or "some variable". Ideally someone
should be able to copy and paste your code to see what you are talking
about.
Jon
--
"Consider carefully what you hear," he continued. "With the measure
you use, it will be measured to you--and even more. Whoever has
will be given more; whoever does not have, even what he has will be
taken from him." -- Mark 4:24-25 (NIV)
------------------------------
Date: 16 Oct 2001 20:45:41 -0700
From: randy5235@hotmail.com (randy5235)
Subject: Problems with this code
Message-Id: <ccc7100a.0110161945.49bf4fdd@posting.google.com>
ok here's the situation. I found some code for a basic chat program:
mainly using io::socket and io::select
I'm pretty well a noob to perl so I decide to start tinkering with
this code
no problems..... as long as the user that is telnetting in uses the
quit command to close the socket. if they just close the telnet
program(instead of using the quit command) about 10 to 20 seconds
after they do so my CPU gets hammered (100% useage) and bam I have to
kill the process. I assume that its trying to resend the info (and of
course cannot) but it just keeps trying?
what i'm looking for is a way to close the connection if the client is
unreachable. I assume that would solve this problem :)
I'm not asking for the code to do this but really more about how to
test the connections to test for validity really(like I said just
writing this to learn more)
heres the code:
#!/usr/bin/perl
use IO::Socket;
use IO::Select;
$max_msglen = 1024; #maximum message length
$max_clients = 10; #maximun number of clients allowed
$port = 1234; #port service runs on
$timeout = 10;
#create new socket for client
$new_client = IO::Socket::INET->new(Proto=>"tcp", LocalPort=>$port,
Listen=>$max_clients, Reuse=>1);
$sel = IO::Select->new($new_client);
print "listening at port $port\n";
while (@ready = $sel->can_read) {
foreach $client (@ready) {
if ($client == $new_client) {
$add = $client->accept;
$sel->add($add);
$message = " *** * * \r\n
* * * * * \r\n
* * * * * * \r\n
*** * * ****\r\n";
sendall($message);
}
else {
$msg = "";
$nread = sysread($client, $msg, $max_msglen);
chop($msg); chop($msg);
if ($msg eq "quit") { print "user is trying to quit";
$message = "[User ".$client->peerhost.":".$client->peerport." left
| ".($sel->count - 2)." user(s) online]\r\n";
sendall($message);
$sel->remove($client);
close $client;
}
elsif ($msg eq "nick") {
print "user trying to set nickname";
$message = "Please enter your nickname: ";
sendonly($message);
}
elsif ($nread) {
$message = "[".$client->peerhost.":".$client->peerport."]
".$msg."\n";
sendnotall("$message\r");
}
}
}
}
sub sendonly { print $username;
my ($msg) = @_;
foreach ($sel->can_write($timeout))
{if ($_ eq $client)
{syswrite($_, $msg, length($msg)) }}
}
sub sendall { print $username;
my ($msg) = @_;
foreach ($sel->can_write($timeout))
{syswrite($_, $msg, length($msg)) }
}
sub sendnotall { print $username;
my ($msg) = @_;
foreach ($sel->can_write($timeout))
{if ($_ ne $client)
{syswrite($_, $msg, length($msg)) }}
}
sub getmsg {
my ($handle) = @_;
my $msg = "";
do {
$nread = sysread($handle, $in, 1024);
$msg .= $in;
} while ($nread > 0);
return($msg);
}
------------------------------
Date: 16 Oct 2001 18:48:29 -0700
From: showdog@my-deja.com (=?ISO-8859-1?Q?sh=F2wd=F6g?=)
Subject: Re: putting $1..$9 into a replacement string such as $repl="=csinfo$1$2^$3"
Message-Id: <187c116b.0110161748.7437cc17@posting.google.com>
mgjv@tradingpost.com.au (Martien Verbruggen) wrote in message news:<slrn9soeru.di2.mgjv@martien.heliotrope.home>...
> On 16 Oct 2001 06:27:46 -0700,
> shòwdög <showdog@my-deja.com> wrote:
> > Bernard El-Hagin <bernard.el-hagin@lido-tech.net> wrote in message news:<slrn9sno35.85e.bernard.el-hagin@gdndev25.lido-tech>...
> >> On 15 Oct 2001 14:44:07 -0700, shòwdög <showdog@my-deja.com> wrote:
>
> [snippage of quoting stuff]
>
> > [snip some more]
>
> Maybe you want
>
> eval "\$strText =~ s/$search/$repl/gi";
>
> or maybe you don't. This eval is going to be terribly slow.
> Maybe you should take a step back, and describe at a higher level what
> it is you need to do. We may have better ideas to solve the problem.
>
> Martien
This is what worked at least in one context:
use strict;
my $search = '(foo)';
my $repl = '"this is $1. hi there."';
my $strText = 'foo foo';
$strText =~ s/$search/$repl/giee;
print $strText, "\n";
__END__
this is foo. hi there. this is foo. hi there.
NOW. Here is the higher level description:
I'm working on a project to convert text documents into SGML format.
This data passes through many filters, programs, etc. before it
conforms to the company's SGML DTD.
There are literally hundreds of embedded codes (entities, elements,
formatting codes) that need to be converted into codes that the
programmers will then convert into XML/SGML entities and elements.
I chose as a solution to store these search/replace pairs in a simple
text file, as
search|repl
I chose the pipe symbol as a delimiter because it appears in none of
the expressions.
Immediately I saw three classes of conversions:
1. foo|bar # This was simple.
2. =it(\d+)|<emph typestyle="it">$1</emph> # this is what we just
solved
and the third, which I haven't tested yet:
3. =(\d+)m|&emspace;&emspace;&emspace; # <- up to $1 times
In 3, I need to get the value of $1 and print $1 entities. Should I
do this by making the rhs an expression?
THE CONSTRAINT:
The text file that contains the search and replace tokens has to be
editable by developers without knowledge of the internal workings --
the abstract concept is search|replace, and the text file can contain
no code other than regular expression language. I suppose I can use
the e modifier s///e for case three and write a function on $1
s{=(\d+)m}{f($1)}e
to return the replace expression?
So this is the high level description. I need suggestions for case 3
above specifically. Thanks for all of your help!
------------------------------
Date: 16 Oct 2001 17:08:27 -0700
From: miko@idocs.com (Miko O'Sullivan)
Subject: Re: Searching and splitting..
Message-Id: <db27ea77.0110161608.4a56072e@posting.google.com>
web_forums@yahoo.com (Drew) wrote in message news:<59c77510.0110160857.36405162@posting.google.com>...
> $datafile = "password.txt"|| die "Can't Open $datafile:
> $!\n";;
All you're testing there is if a string was successfully assigned to a
variable. It probably was. The "or die" thing should go below:
open(INF,$datafile) or die "can't open data file: $!";
Personally I never display the path of data files in my CGI's. It's
just too interesting to some people.
> @mydata = <INF>;
That slurps the whole data file into an array, which in this case is
quite unneccesary. Pull in one line at a time. Try this (untested):
my $user;
LINELOOPER:
foreach my $line (<INF>) {
chomp $line;
# I like to remove spaces around the delimiter,
# let's me keep things tidy
my ($name, $pw) = split(/\s*:\s*/, $line);
if (
($name eq $FORM{'name'}) &&
# you ARE encrypting your passwords, right?
($pw eq crypt($FORM{'pw'}, $FORM{'pw'}) )
) {
$user = $name;
last LINELOOPER;
}
}
close(INF) or die "unable to close data file: $!";
unless (defined $user) die "couldn't find user";
# do stuff
BTW, be sure you're using tainting, strict, and warnings. If anybody
tries to talk you out of using them, pity that person and ignore their
advice.
------------------------------
Date: Tue, 16 Oct 2001 23:31:09 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: String To List
Message-Id: <3BCCFB7D.4937B46B@earthlink.net>
Jay wrote:
>
> Thanks Jeff.
>
> Unfortunately, I spent almost an hour to figure out the proper queries
> for SQL and develop code for that. You explained the same in few
> lines :-)
>
> The need in my case is to get multiple inputs from user, including
> patterns.
> Eg. (field1 dr* p*) ( field2 a*n ^pu )
> and optionally from field 3 and field 4 .
Are these supposed to be glob type patterns, or regular expressions?
> So far, I am not able to get these multiple queries in one single
> string.
Huh?
> I was hoping something like CGI scripts, where the contents sent by
> the browser are escaped to properly pass, even the special characters.
Thats what placeholders and bind param are for, so that you don't have
to worry about escaping.
Let's suppose that the above are meant to be glob-type regular
expressions.
$_ = $cgi->param("the_query");
my (@where, @bind, %select);
# this parses things like "(field1 dr* p*) ( field2 a*n ^pu )"
while( m[\G \s* \( \s* (\S*) ((?: \s+ ([^\s)]+) )*) \s* \) ]gcx ) {
my ($field, $patterns) = ($1, $2);
my @values = split ' ', $patterns;
push @bind, $field, $_ for @values;
push @where, "(" . join(" OR ", map "? LIKE ?", @values) . ")"
if @values;
$select{$field} = 1;
}
# if there's anything but whitespace left over, die.
die "Badly formatted query" unless m[\G\s*\z];
if( $dbi is NOT MS Access ) {
# most databases use % and _ for glob-type wildcards.
# MSAccess uses * and ? for glob-type wildcards.
$_->[1] =~ tr/*?/%_/ foreach @where;
}
# I'm not sure what DBI::AnyData uses for LIKE... If the author of it
# was smart, he'd have used File::Glob, in which case it's * and ?
# so you would get rid of the above line.
my $sql_query = qq[
SELECT ] . join( ", ", keys %select ) . qq[
FROM thetable
WHERE ] . join( " AND ", @where );
my $sth = $dbi->prepare( $sql_query );
$sth->execute( @bind );
> Worst case scenario is to limit the queries to fixed values:
> "-f1 alpha beta charlie, -f2 orange mango ...., -f3 ...."
>
> I would like to split this string on the 'comma' and then call SQL
> query.
Actually, it wouldn't be all that different from the code above,
*except* that the while loop would be a bit changed:
while( m[\G \s* (\S*) ((?: \s+ ([^\s,]+) )*) \s* , ]gcx ) {
my ($field, $patterns) = ($1, $2);
$field =~ s/^-f(\d+)$/field$1/; # turn "-f1" into "field1"
my @values = split ' ', $patterns;
....
}
Oh, and you might want to change the sql query string to use = instead
of LIKE... or you might want to use RLIKE, for patterns which are
regular expressions.
About parsing... there are lots of modules out there, which will let you
do just about anything you want. If you want to define a complicated
syntax [and neither your example with the parens nor the one with the
commas are especially complicated], consider using Parse::RecDescent.
--
"What does stupid old man mean pidgin talk? Shampoo does not talk like a
bird."
------------------------------
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.
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 1943
***************************************
