[18985] in Perl-Users-Digest
Perl-Users Digest, Issue: 1180 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Jun 23 11:05:39 2001
Date: Sat, 23 Jun 2001 08:05:06 -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: <993308706-v10-i1180@ruby.oce.orst.edu>
Content-Type: text
Perl-Users Digest Sat, 23 Jun 2001 Volume: 10 Number: 1180
Today's topics:
Re: Ack! Newbie still suffering from C-brain! <iowa8_song8.REMOVE_EIGHTS_AND_THIS@hotmail.com>
Re: Converting COBOL numbers <shogue@securenet.net>
Re: Converting COBOL numbers <shogue@securenet.net>
Getting http file and parsing it. Help please. <whitey@wherever.com>
Re: Getting http file and parsing it. Help please. <solhell@bigfoot.com>
Re: help with mod_perl enabled "contact us" pages (for <ubl@schaffhausen.de>
How to detect 'Out of Space' <patelnavin@icenet.net>
Re: How to detect 'Out of Space' (Greg Andrews)
Re: How to detect 'Out of Space' <pne-news-20010623@newton.digitalspace.net>
Re: Possible to split GIF or JPG into 12 images? <gnarinn@hotmail.com>
Re: Problem reading large files (dumb question?) (Richard J. Rauenzahn)
Re: regular expression problem <wyzelli@yahoo.com>
Re: regular expression problem <bart.lateur@skynet.be>
Search and replace ONLY outside "quotes" <iowa8_song8.REMOVE_EIGHTS_AND_THIS@hotmail.com>
Re: Text Searching Script Problems <goldbb2@earthlink.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 23 Jun 2001 14:35:07 GMT
From: Weston Cann <iowa8_song8.REMOVE_EIGHTS_AND_THIS@hotmail.com>
Subject: Re: Ack! Newbie still suffering from C-brain!
Message-Id: <230620010842176483%iowa8_song8.REMOVE_EIGHTS_AND_THIS@hotmail.com>
> ...and moreso when you start using for, but as a synonym for foreach,
> rather than as a C-style for loop. :-)
>
> On a more practical note, you might want to read Effective Perl
> Programming by Joseph Hall (w/Randal Schwartz, but who cares about *him*
> ;-). Very good book for learning to write idiomatic Perl.
You may already be very familiar with regexps, so this may not not help,
but I didn't start thinking in perl until I checked out "Mastering
Regular Expressions with Perl" by Jeffrey Friedl from the library and
read the first few chapters.
This was about a year and a half after I first started using perl.
Now it's 5 years since I first started, and I think I really started
thinking in perl about a year ago. But nearly every month, some perl
idiom that could save me effort/time pops up. Hmmm.
I wonder which is harder: thinking in a foreign language or perl.
Weston
------------------------------
Date: Sat, 23 Jun 2001 01:09:20 -0400
From: "Sylvain Hogue" <shogue@securenet.net>
Subject: Re: Converting COBOL numbers
Message-Id: <9h287t$jei$1@news.securenet.net>
>Hello,
>I have 10 character strings like the list below >representing dollar
>amounts. I think they are some COBOL form such as "high punch" values,
>but maybe not.
>I tried all the unpack templates, and I would like not to have to load
>special packages because so far I use binary perl on Win32 and VMS.
>Any ideas as to what could be intended here and how to convert?
>Thanks.
>Will Cardwell
>000014364{
>000001026A
>000002760A
>000001620A
>000011160A
>000001026A
>000000744A
>000003810A
>000000732A
>000015052A
>000010560A
>000006435A
>000000360A
>000013759E
>000011160A
>000001980A
>000002472F
>000001819A
>000007440A
>000014560A
>000000700A
>000000640A
>000002910A
>000000340A
The last byte represent the last digit and the signe of the number
It is based on the Hex code of the last byte ( in EBCDIC code)
For the positives numbers
Hex code EBCDIC char value of the
C0 { 0
C1 A 1
C2 B 2
C3 C 3
C4 D 4
C5 E 5
C6 F 6
C7 G 7
C8 H 8
C9 I 9
For the negatives numbers
Hex code EBCDIC char value of the
D0 } 0
D1 J 1
D2 K 2
D3 L 3
D4 M 4
D5 N 5
D6 O 6
D7 P 7
D8 Q 8
D9 R 9
Then the number 000234A mean 2341
00234Q mean -2348
Cobol use fisrt half of the byte (C + or D -) to specify the signe and
the value of the last half for the digit.
But i you work in ASCII code you have to translate directly
from the character to the value and the signe of the last digit.
------------------------------
Date: Sat, 23 Jun 2001 01:22:40 -0400
From: "Sylvain Hogue" <shogue@securenet.net>
Subject: Re: Converting COBOL numbers
Message-Id: <9h287u$jei$2@news.securenet.net>
>Hello,
>I have 10 character strings like the list below >representing dollar
>amounts. I think they are some COBOL form such as "high punch" values,
>but maybe not.
>I tried all the unpack templates, and I would like not to have to load
>special packages because so far I use binary perl on Win32 and VMS.
>Any ideas as to what could be intended here and how to convert?
>Thanks.
>Will Cardwell
>000014364{
>000001026A
>000002760A
>000001620A
>000011160A
>000001026A
>000000744A
>000003810A
>000000732A
>000015052A
>000010560A
>000006435A
>000000360A
>000013759E
>000011160A
>000001980A
>000002472F
>000001819A
>000007440A
>000014560A
>000000700A
>000000640A
>000002910A
>000000340A
The last byte represent the last digit and the signe of the number
It is based on the Hex code of the last byte ( in EBCDIC code)
For the positives numbers
Hex code EBCDIC char value of the
C0 { 0
C1 A 1
C2 B 2
C3 C 3
C4 D 4
C5 E 5
C6 F 6
C7 G 7
C8 H 8
C9 I 9
For the negatives numbers
Hex code EBCDIC char value of the
D0 } 0
D1 J 1
D2 K 2
D3 L 3
D4 M 4
D5 N 5
D6 O 6
D7 P 7
D8 Q 8
D9 R 9
Then the number 000234A mean 2341
00234Q mean -2348
Cobol use fisrt half of the byte (C + or D -) to specify the signe and
the value of the last half for the digit.
But i you work in ASCII code you have to translate directly
from the character to the value and the signe of the last digit.
------------------------------
Date: Sat, 23 Jun 2001 08:45:03 GMT
From: Whitey <whitey@wherever.com>
Subject: Getting http file and parsing it. Help please.
Message-Id: <whitey-E3DB66.01450223062001@news1.rdc1.sfba.home.com>
I have the following code that I would like to have fetch the index page
and strip everything between the PETROLEUM tag and the BbgElogin2 text
to be spit out to a file. I, for the life of me, cannot get it to work
properly. I am getting 500 INTERNAL SERVER ERROR messages, and I cannot
track down a log file to tell me what's going wrong. I don't think this
file is complete, either. Could someone help me please?
#!/usr/bin/perl
use LWP::Simple;
use LWP::UserAgent;
$_ = get ("http://www.bloomberg.com/energy/index.html");
$data =~ /<!---------------PETROLEUM-----------------> (.*) <map
name="BbgELogin2">/m;
open (FH,"./file.txt") ||die"$!";
print FH $_;
close FH;
------------------------------
Date: Sat, 23 Jun 2001 11:28:31 GMT
From: Sol Hell <solhell@bigfoot.com>
Subject: Re: Getting http file and parsing it. Help please.
Message-Id: <3B347DD4.1090406@bigfoot.com>
You need to escape the "-" dash characters inside the regex.
Whitey wrote:
> I have the following code that I would like to have fetch the index page
> and strip everything between the PETROLEUM tag and the BbgElogin2 text
> to be spit out to a file. I, for the life of me, cannot get it to work
> properly. I am getting 500 INTERNAL SERVER ERROR messages, and I cannot
> track down a log file to tell me what's going wrong. I don't think this
> file is complete, either. Could someone help me please?
>
>
>
> #!/usr/bin/perl
>
> use LWP::Simple;
> use LWP::UserAgent;
>
> $_ = get ("http://www.bloomberg.com/energy/index.html");
> $data =~ /<!---------------PETROLEUM-----------------> (.*) <map
> name="BbgELogin2">/m;
> open (FH,"./file.txt") ||die"$!";
> print FH $_;
> close FH;
>
------------------------------
Date: Sat, 23 Jun 2001 14:37:33 +0100
From: Malte Ubl <ubl@schaffhausen.de>
Subject: Re: help with mod_perl enabled "contact us" pages (for a web site)
Message-Id: <3B349B9E.4045B371@schaffhausen.de>
Ryan Covert schrieb:
> Could someone point me in the right direction (and maybe even towards an
> example?) so that I can maybe get some actual form data to start sending
> properly? :)
You are saying you are programming for mod_perl but you dont know how to send
a mail based on form data? (I thought that would be the very first thing every-
body was doing with CGI. mod_perl seems like serious overkill; I'd
suggest
mod_sendmail :-)).
Besides that this is a quite complex topic if you are concerned about security,
especially about not being mail bombed.
Point in the right direction:
Open a pipe to a mail program (sendmail,...) print to it and then close
the pipe
or if you dont want to do that download a smtp client written in Perl
from CPAN
and use that.
Hope this helps,
->malte
------------------------------
Date: Sat, 23 Jun 2001 17:31:16 +0530
From: "Aman Patel" <patelnavin@icenet.net>
Subject: How to detect 'Out of Space'
Message-Id: <9h20d7$avcqo$1@ID-93885.news.dfncis.de>
Heres a small script (made up)
open ( FILE, ">test.file" )
print FILE "this is a test...";
close (FILE);
how do I know if the file system created the file?? does close return any
error?
heres a modified version which check to see if the server is out of space:
open( FILE, ">test.file" );
print FILE "test";
clsoe (FILE );
if ( -z "test.file" ) { #SERVER IS OUT OF SPACE, didnt create the file
#report error and exit
exit;
} esle {
unlink( "test.file"
}
#back to creating the file you wanted:
open ( FILE, ">test.file" )
print FILE "this is a test...";
close (FILE);
The check isnt that good, so i wanted your opinion.
------------------------------
Date: 23 Jun 2001 14:10:15 GMT
From: gerg@panix.com (Greg Andrews)
Subject: Re: How to detect 'Out of Space'
Message-Id: <9h2807$e3e$2@news.panix.com>
"Aman Patel" <patelnavin@icenet.net> writes:
>Heres a small script (made up)
>
>open ( FILE, ">test.file" )
>print FILE "this is a test...";
>close (FILE);
>
>how do I know if the file system created the file?? does close return any
>error?
>
All three of those functions (open, print, and close) can return
errors if they can't do their work because there's no enough space
on the filesystem.
-Greg
--
+++++ Greg Andrews +++ gerg@panix.com +++++
I have a map of the United States that's actual size
-- Steven Wright
------------------------------
Date: Sat, 23 Jun 2001 16:28:37 +0200
From: Philip Newton <pne-news-20010623@newton.digitalspace.net>
Subject: Re: How to detect 'Out of Space'
Message-Id: <tn99jto9ti6nf4qhiupfi4e8qribjnea7p@4ax.com>
On Sat, 23 Jun 2001 17:31:16 +0530, "Aman Patel" <patelnavin@icenet.net>
wrote:
> Heres a small script (made up)
>
> open ( FILE, ">test.file" )
> print FILE "this is a test...";
> close (FILE);
>
> how do I know if the file system created the file?? does close return any
> error?
Yes. That's why you should check the success not only of open(), but
also of close() if you're closing a file that you opened for writing to;
it can tell you whether you're out of space. (You can also check the
return value of each print(), if you want.)
> heres a modified version which check to see if the server is out of space:
> open( FILE, ">test.file" );
> print FILE "test";
> clsoe (FILE );
> if ( -z "test.file" ) { #SERVER IS OUT OF SPACE, didnt create the file
> #report error and exit
> exit;
> } esle {
> unlink( "test.file"
> }
That will only check whether the machine is completely out of space. But
imagine that it only has 100 KB left, then you can successully create
your dinky "test" file, but if you later try to write 200 KB to disk,
half of your data will end up in never-never-land. So this is a bad
test. (Never mind that the machine's disk might fill up between the test
and the time you attempt to actually write to the file.)
Cheers,
Philip
--
Philip Newton <nospam.newton@gmx.li>
Yes, that really is my address; no need to remove anything to reply.
If you're not part of the solution, you're part of the precipitate.
------------------------------
Date: Sat, 23 Jun 2001 09:02:00 +0000
From: gnari <gnarinn@hotmail.com>
Subject: Re: Possible to split GIF or JPG into 12 images?
Message-Id: <993286920.59347665682435.gnarinn@hotmail.com>
In article <Xns90C88863F1D96dragnetinternalysisc@207.35.177.135>,
Marc Bissonnette <dragnet@internalysis.com> wrote:
>
>I am wondering if it is possible to use Perl to split an image into 9 (or
>whatever number you wanted) separate images? I.e. if you had image.jpg
>which was (apologies for bad ASCII art)
>
>--------
>| |
>| 1.jpg|
>| |
>--------
>
>to split it into:
>
>-------------------
>|1.jpg|2.jpg|3.jpg|
>|-----|-----|-----|
>|4.jpg|5.jpg|6.jpg|
>|-----|-----|-----|
>|7.jpg|8.jpg|9.jpg|
>-------------------
>
If you want to do this in perl, you should check CPAN for
graphics modules such as GD.pm
It is likely that one of them should be able to help you with this.
gnari
------------------------------
Date: 22 Jun 2001 21:38:11 GMT
From: nospam@hairball.cup.hp.com (Richard J. Rauenzahn)
Subject: Re: Problem reading large files (dumb question?)
Message-Id: <993245891.256952@hpvablab.cup.hp.com>
"Christopher J. Mackie" <cjmackie@princeton.edu> writes:
>Apologies if this is a CompSci 101 question--I'm self-taught.
>
>I *really* need to read data out of a 14Gb binary file, convert it from
>double to float, and write it into another file. The perl script I wrote
>works great on smaller files, but every time I try to read() or sysread()
>the big file, I get a core dump (segmentation fault). I'm not keeping the
>data in memory--I write it out in 400Mb chunks. I know there are limits on
>how much memory a 32-bit computer can address, but I'm reading these files
>on the same machine that wrote them (an SGI Origin 2000), so it's got to be
>possible to read/write them somehow. Is this there something different
>about files over 2Gb, or am I just doing something stupid?
It would help to see all of the code -- I suspect you're running out
of memory by not actually flushing your buffer ever 400MB. But
why buffer at all? Let the OS and libraries do that for you.
>here's the code -- any ideas? And *thanks* in advance, --Chris
>==========================
>open(INFILE, "<$binfile") or die "oops!: $!";
>binmode(INFILE): # I've tried it with and without this, since TFM says it's
>not necessary on UNIX
>
>while (sysread(INFILE, $val, 8, 0)==8)
>{ # tried 'for' too--didn't work
> $val= pack("f", unpack("d", $val));
Why not just print out the bytes immediately to the new file? And you
may wish to use read() instead of sysread() -- it'll be a little more
efficient.
> push(@buffer, $val);
> ...
> #Code to write out and empty buffer each 400Mb--buffer is not the
>overflow problem.
> # The script bombs before *any* data are written out, so somewhere in
>the first loop.
I'd skip all this...
> ...
>} # end WHILE sysread
Or, simply...
#!/opt/perl5/bin/perl -w
use strict;
open OUT, ">d.dat" || die;
for (1 .. 1000) {
print OUT pack("d", $_);
}
open OUT, ">f.dat" || die;
open IN, "d.dat" || die;
$/ = \8;
while(<IN>) {
print OUT pack("f", unpack("d", $_));
}
close(OUT);
open(IN, "f.dat") || die;
$/ = \4;
while(<IN>) {
print unpack("f", $_) . "\n";
}
Any performance gain is probably found in rewriting the above so that
pack/unpack is called fewer times on larger buffers of data.
Also, if your platform needs it, add the binmode()'s back in.
Rich
--
Rich Rauenzahn ----------+xrrauenza@cup.hp.comx+ Hewlett-Packard Company
Technical Consultant | I speak for me, | 19055 Pruneridge Ave.
Development Alliances Lab| *not* HP | MS 46TU2
ESPD / E-Serv. Partner Division +--------------+---- Cupertino, CA 95014
------------------------------
Date: Sat, 23 Jun 2001 08:39:54 +0930
From: "Wyzelli" <wyzelli@yahoo.com>
Subject: Re: regular expression problem
Message-Id: <56YY6.2$5_.368@vic.nntp.telstra.net>
"Xtreme" <lxl22@visto.com> wrote in message
news:91ff860e.0106221022.505ce10d@posting.google.com...
> jacklam@math.uio.no (Peter J. Acklam) wrote in message
news:<cxclmmk388v.fsf@masterblaster.uio.no>...
> > lxl22@visto.com (Xtreme) wrote:
> >
> > > Assuming I have a string of the form "a_b_b_c" in which I don't
> > > know how many "b_" substrings it has, how can I, in one single
> > > s/// line replace every b_ for a "x_"? My main problem is that
> > > I don't know how to tell the re engine how to replace it the
> > > same number of times as it occurred.
> >
> > s/b_/x_/g;
> >
> > Peter
>
> Thanks, Peter. I had forgotten to mention that a,b and c can each be
> distinct or the same -- I don't know ahead of time, and that I don't
> want to replace a or c (i.e. not the first or last in the string). I
> figured it out in the mean time by going through (of all things) the
> faq:
> s/\G_b_/_x_/g;
> I still don't really grasp the \G, but it works!
It actually isn't necessary. s/_b_/_x_/g will also work fine.
Wyzelli
--
#Modified from the original by Jim Menard
for(reverse(1..100)){$s=($_==1)? '':'s';print"$_ bottle$s of beer on the
wall,\n";
print"$_ bottle$s of beer,\nTake one down, pass it around,\n";
$_--;$s=($_==1)?'':'s';print"$_ bottle$s of beer on the
wall\n\n";}print'*burp*';
------------------------------
Date: Sat, 23 Jun 2001 10:55:02 GMT
From: Bart Lateur <bart.lateur@skynet.be>
Subject: Re: regular expression problem
Message-Id: <ers8jtcqijhq1e3u50tibvjh9t9tfqleks@4ax.com>
Ren Maddox wrote:
>> s/\G_b_/_x_/g;
>> I still don't really grasp the \G, but it works!
>
>Wow.
>
>I'm not sure what's going on there, as \G does not appear to have a
>defined behavior in a global substitute. And the behavior it exhibits
>certainly isn't what I would expect. In fact, the behavior I see
>doesn't achieve your stated goal:
>
>perl <<'__END__'
>$_ = "b_b_b_b_b_b";
>s/\G_b_/_x_/g;
>print "$_\n";
>__END__
>b_b_b_b_b_b
Indeed it does nothing.
So what does \G do? It matches an anchor at the current position of pos,
i.e. right after the previous match. Witness:
$_ = "abc";
/b/g and s/\G/!/;
print;
-->
ab!c
You need the /g for the // or otherwise pos would be unaffected.
So this might work:
$_ = "b_a_b_b_c_b_a_b_c_b_a_";
while(/a_(?=(b_)+c)/g) {
s/\Gb_/x_/g;
}
print;
-->
b_a_x_x_c_b_a_x_c_b_a_
And it does. Note that it ONLY replaced the "b_"'s where they are
between "a_" and "c", as requested.
As for an explanation: /a_(?=(b_)+c)/g matches a sequence "a_b_b_c", but
the pos pointer get set right after the "a", as the b's and c are
matched in a lookahead pattern. then, the s/\G/ takes over, matching
only stuff that touches the end of the previous match, starting with
right after the "a", and then after every "b_", up to the "c". It stops
there.
I fear that pos is reset ater that, so the next match might begin back
at the beginning of the string, thank goodness without any harm done.
--
Bart.
------------------------------
Date: Sat, 23 Jun 2001 14:42:58 GMT
From: Weston Cann <iowa8_song8.REMOVE_EIGHTS_AND_THIS@hotmail.com>
Subject: Search and replace ONLY outside "quotes"
Message-Id: <230620010850084798%iowa8_song8.REMOVE_EIGHTS_AND_THIS@hotmail.com>
I've been running global searches and replaces on a number of html files
using a perl script. Up until now, I've just slurped the whole file into
a string, and done s///mg on the string.
I've been informed, however, that I shouldn't be searching and replacing
inside tags.
I'm wondering what the laziest way to accomplish this is. The one I can
think of right off the bat is to simply go through each file
char-by-char. If I encounter an open tag "<", I toggle to non-replace
mode, and don't come back to replace mode until ">". While I'm in
replace mode, I look for a sequence that matches what I'm trying to
replace. If I find it, I remember that index and do a substr on it.
Since tags don't nest within other tags, I figure this will work.
Is there another way to do it?
Weston
--
------------------------------
Date: Sat, 23 Jun 2001 03:59:34 -0400
From: Benjamin Goldberg <goldbb2@earthlink.net>
Subject: Re: Text Searching Script Problems
Message-Id: <3B344C66.2EEF9556@earthlink.net>
Austin wrote:
>
> Hello,
>
> The script pasted at the end of this message isn't functioning as
> expected. Basically it works in the form of this:
> http://localhost/cgi-bin/search.cgi?<max results>,<extra info (1 or
> 0)>,<keyword 1>,<keyword 2>,<keyword 3>,<keyword 4>,<keyword 5>.
What a strangly formatted query string. What generates this? Most
browsers generate a string like
http://host/path/blah.cgi?name1=param1&name2=param2&name3=...
Not
http://host/path/blah.cgi?param1,param2,param3
Are you absolutely sure that this is how your arguments are passed?
If the arguments are being passed in the normal, standard manner, then
you might consider using CGI.pm, rather than parsing on your own.
Anyway...
> Basically,
> it's going past the max limit and it's not reporting the max number of
> results (which should just be the number of lines in the open file
> handle <FILE>). Any help is MUCH appriciated.
>
> Also, if your looking to get something out of this, I can offer you a
> 468x60 banner spot on a high profile music site free for 90 days (no
> xxx).
>
> Cheers-
> Austin
>
> -- START CODE --
>
> #!/usr/bin/perl
use warnings;
use strict;
> if ($ENV{'QUERY_STRING'} eq "dump") {
> use IPC::Open2;
> $pid = open2(readit, writeit, "cat
> /home/newwave/public_html/mcm.inapnow.org/cgi-bin/edump/austin.cgi");
> waitpid $pid, 0;
> @script = <readit>;
> print "Content-type: text/html\n\n";
> foreach $key (@script) { print $key; }
> exit;
> }
What's the point of using open2 and cat? Seems like a dumb way to print out a script. Also, if that pathname there is the current script, then why not simply replace it with $0 ?
if( $ENV{QUERY_STRING} eq "dump" ) {
print "Content-type: text/plain\n\n"; # NOT text/html!
seek( DATA, 0, 0 );
local $/ = \ -s DATA;
print <DATA>;
exit 1;
}
> print "Content-type: text/html\n\n";
Is the data being printed out actually html?
> ($max, $extra, $keyword1, $keyword2, $keyword3, $keyword4, $keyword5) =
> split (',', $ENV{'QUERY_STRING'});
You're using globals. Why? You don't like lexicals? Also, why not
put the keywords in an array?
my ($max, $extra, @keywords) =
split (',', $ENV{QUERY_STRING});
> open FILE, "</home/newwave/public_html/mcm.inapnow.org/edump/infolink_wx.db"
This would be easier to read if you'd put, near the top of your file,
my $info_nx = "/home/newwave/public_html/mcm.inapnow.org/".
"edump/infolink_wx.db";
And then changed this line to be:
open FILE, "<", $info_nx
> or die "Cannot open info_nx.db: $!";
Smart... always, yes, always, check the return value of open.
> $max = $max + 1;
> $results = 0;
Some reason not to use ++ for incrementing $max ?
Also, you should make $results a lexical.
my $results = 0;
Actually, you don't need this, since you could just use the scalar value
of @results... which you also didn't declare anywhere.
my @results;
>
> if ($results < $max) {
> while (<FILE>) { if (/$keyword1/i and /$keyword2/i and /$keyword3/i and
> /$keyword4/i and /$keyword5/i) { $res[$results] = "$_"; last if ($results +=
> 1) > $max } }
> }
Go through the file, and get all lines for which all keywords match.
I guess you don't mind that keywords can't contain commas... Also,
if you don't get $max many results, you end up going through the whole
file. It does NOT automatically get reset to the beginning. You have
to do that explicitly.
> if ($results < $max) {
> while (<FILE>) { if (/$keyword1/i and /$keyword2/i and /$keyword3/i and
> /$keyword4/i or /$keyword5/i) { $res[$results] = "$_"; last if ($results +=
> 1) > $max } }
> }
> if ($results < $max) {
> while (<FILE>) { if (/$keyword1/i and /$keyword2/i and /$keyword3/i or
> /$keyword4/i or /$keyword5/i) { $res[$results] = "$_"; last if ($results +=
> 1) > $max } }
> }
> if ($results < $max) {
> while (<FILE>) { if (/$keyword1/i and /$keyword2/i or /$keyword3/i or
> /$keyword4/i or /$keyword5/i) { $res[$results] = "$_"; last if ($results +=
> 1) > $max } }
> }
> if ($results < $max) {
> while (<FILE>) { if (/$keyword1/i or /$keyword2/i or /$keyword3/i or
> /$keyword4/i or /$keyword5/i) { $res[$results] = "$_"; last if ($results +=
> 1) > $max } }
> }
Lots of repetitive code. You could do it better. I would move the file
open down into here.
my $lastline;
if( @results < $max ) LOOP: {
@keywords = map { qr/$_/i } @keywords;
chomp (my @slurp = do {
open my $file, "<", $info_nx
or die "Couldn't open info_nx.db: $!";
<$file>
});
$lastline = $slurp[-1];
for( @slurp ) MATCH: {
next MATCH if( !/$x/ ) for my $x (@keywords);
last LOOP if push(@results, $_) > $max;
}
for( @slurp ) MATCH: {
my $m = 1;
$m &&= /$x/ for my $x (@keywords[0..3]);
next MATCH unless $m || /$keywords[4]/;
last LOOP if push(@results, $_) > $max;
}
for( @slurp ) MATCH: {
my $m = 1;
$m &&= /$x/ for my $x (@keywords[0..2]);
$m ||= /$x/ for my $x (@keywords[3..4]);
next MATCH unless $m;
last LOOP if push(@results, $_) > $max;
}
for( @slurp ) MATCH: {
my $m = 1;
$m &&= /$x/ for my $x (@keywords[0..1]);
$m ||= /$x/ for my $x (@keywords[2..4]);
next MATCH unless $m;
last LOOP if push(@results, $_) > $max;
}
for( @slurp ) MATCH: {
for my $x (@keywords) {
if( /$x/ ) {
last LOOP if push(@results, $_) > $max;
next MATCH;
}
}
}
} # end of LOOP block.
> if ($extra) {
> $rescnt = 0;
> foreach $key (@res) {
> $x = $info = $link = "";
> ($x, $info, $link) = split('\|', $key);
> $rescnt++ if ($x ne "") and ($info ne "") and ($link ne "");
> }
> while (!(eof(FILE))) {
> $line = (<FILE>);
> }
> ($x, $info, $link) = split('\|', $line);
> print "Out of a possible <B>$x</B>, there was <B>1</B> result.\n\n" if
> ($rescnt eq "1");
> print "Out of a possible <B>$x</B>, there were <B>$rescnt</B> results.\n\n"
> if ($rescnt ne "1");
> }
Your indenting style could be better.
if( $extra ) {
my $res_count = 0;
for (@result) LINE: {
my ($x, $info, $link) = split('\|', $key);
++$res_count
if( $x ne "" or $info or $link );
}
my $x = $lastline + 0;
print "Out of a possible " . $x . " there ";
print (($res_count == 1) ? "was" : "were");
print "$res_count result";
print "s" if $res_count != 1;
print ".\n\n";
}
> foreach $key (@res) {
> $x = $info = $link = "";
> ($x, $info, $link) = split('\|', $key);
> print "<B>Item $x<B> -> <A HREF=\"$link\">$info</A>\n" if ($x ne "") and
> ($info ne "") and ($link ne "");
> }
> close (FILE);
> exit;
foreach my $line (@results) {
my ($x, $info, $link) = split('\|', $key);
print qq[<B>Item $x<B> -> <A HREF="$link">$info</A>\n]
if( $x ne "" or $info or $link );
}
__END__
--
The longer a man is wrong, the surer he is that he's right.
------------------------------
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 1180
***************************************
