[11328] in Perl-Users-Digest
Perl-Users Digest, Issue: 4929 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Feb 18 10:07:34 1999
Date: Thu, 18 Feb 99 07:03:17 -0800
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Thu, 18 Feb 1999 Volume: 8 Number: 4929
Today's topics:
FAQ 5.17: How can I lock a file? <perlfaq-suggestions@perl.com>
Re: FAQ 5.6: How can I make a filehandle local to a sub (Bernie Cosell)
Re: File creation problem !!Someone has to know this!! <aqumsieh@matrox.com>
Re: Finding a hash key based on regexp <aqumsieh@matrox.com>
Re: Finding a hash key based on regexp <aqumsieh@matrox.com>
Re: HELP stripping NEWLINE character <aqumsieh@matrox.com>
Re: HELP! Why is this not working? <aqumsieh@matrox.com>
Re: How do you copy a text file to the body of an e-mai <aqumsieh@matrox.com>
HTML::Entities -- ??BUG?? <shapirojs@my-dejanews.com>
Re: Interleaving two lists? <aqumsieh@matrox.com>
Re: Is there a perl script for finding out who fingered <aqumsieh@matrox.com>
MS Script Control and ActivePerl PerlScript kojun@nri.com
Re: none <aqumsieh@matrox.com>
Re: perl password example <aqumsieh@matrox.com>
Problem passing arrays and hashes to subroutines. <oliver.james.jh@bhp.com.au>
Re: reading a file <aqumsieh@matrox.com>
Re: reading a whole file into a string <aqumsieh@matrox.com>
RECIPE: Unpublished Tales from the PCB, 1 of 2 <tchrist@mox.perl.com>
Re: Redirectiong STDERR <aqumsieh@matrox.com>
Re: reverse ? <aqumsieh@matrox.com>
Re: Speed Up Perl <aqumsieh@matrox.com>
SRC: amarank <tchrist@mox.perl.com>
Re: STDERR of system call in variable? <aqumsieh@matrox.com>
Re: using filehandels in parent objects <tchrist@mox.perl.com>
Re: Vital parts of $1 missing <aqumsieh@matrox.com>
Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 18 Feb 1999 07:18:53 -0700
From: Tom Christiansen <perlfaq-suggestions@perl.com>
Subject: FAQ 5.17: How can I lock a file?
Message-Id: <36cc214d@csnews>
(This excerpt from perlfaq5 - Files and Formats
($Revision: 1.34 $, $Date: 1999/01/08 05:46:13 $)
part of the standard set of documentation included with every
valid Perl distribution, like the one on your system.
See also http://language.perl.com/newdocs/pod/perlfaq5.html
if your negligent system adminstrator has been remiss in his duties.)
How can I lock a file?
Perl's builtin flock() function (see the perlfunc manpage for details)
will call flock(2) if that exists, fcntl(2) if it doesn't (on perl
version 5.004 and later), and lockf(3) if neither of the two previous
system calls exists. On some systems, it may even use a different form
of native locking. Here are some gotchas with Perl's flock():
1 Produces a fatal error if none of the three system calls (or their close
equivalent) exists.
2 lockf(3) does not provide shared locking, and requires that the
filehandle be open for writing (or appending, or read/writing).
3 Some versions of flock() can't lock files over a network (e.g. on NFS
file systems), so you'd need to force the use of fcntl(2) when you
build Perl. See the flock entry of the perlfunc manpage, and the
INSTALL file in the source distribution for information on building
Perl to do this.
For more information on file locking, see also the section on "File
Locking" in the perlopentut manpage if you have it (new for 5.006).
--
A power tool is not a toy. Unix is a power tool.
------------------------------
Date: Thu, 18 Feb 1999 14:38:47 GMT
From: bernie@fantasyfarm.com (Bernie Cosell)
Subject: Re: FAQ 5.6: How can I make a filehandle local to a subroutine? How do I pass filehandles between subroutines? How do I make an array of filehandles?
Message-Id: <36ce255d.40041074@news.supernews.com>
Tom Christiansen <perlfaq-suggestions@perl.com> wrote:
} (This excerpt from perlfaq5 - Files and Formats
} ($Revision: 1.34 $, $Date: 1999/01/08 05:46:13 $)
In this routine:
} sub findme {
} local *HostFile;
} open(HostFile, "</etc/hosts") or die "no /etc/hosts: $!";
} local $_; # <- VERY IMPORTANT
} while (<HostFile>) {
} print if /\b127\.(0\.0\.)?1\b/;
} }
} # *HostFile automatically closes/disappears here
} }
Why do you have to localize $_?
/Bernie\
--
Bernie Cosell Fantasy Farm Fibers
bernie@fantasyfarm.com Pearisburg, VA
--> Too many people, too few sheep <--
------------------------------
Date: Mon, 15 Feb 1999 13:24:41 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: File creation problem !!Someone has to know this!!
Message-Id: <x3ylnhz4j9z.fsf@tigre.matrox.com>
Patrick Fong <patfong@yoyo.cc.monash.edu.au> writes:
> My problem is that I want to create a file and write data to it using
> Perl. Or any other languages.
Perl is fine for that. What other languages do you have in mind?
> The file name is supplied by the client in the Web browser and the data is
> written to it upon form submission.
good.
> What I have tried is the following
>
> 1) $filename = "$FORM{'filename'}".".txt";
did you check the contents of $filename here?
> open (RECORD, "+>filename");
1) always check the return value of open() to see whether it succeeded or
not.
2) filename should be $filename ... or else your script is creating a
file called "filename".
3) Using "+>" clobbers the file first. If you don't care about the
previous contents of your file, just use ">$filename" .. else use
"+<"
open RECORD, ">$filename" or die "Can't create $filename: $!\n";
> print RECORD "...form data...";
>
> My problem is that the file isnt created. So I dont really think that Perl
It probably was created under the name "filename". To be sure, make
the modification I outlined above and re-run your script.
> can create a file? So am I right?? Is there any other languages that
No. Perl can create files just fine. Did you read the documentation on
open() ??
> creates a file... besides Java (becoz I hate java :-))?? Can someone tell
Almost all languages can create files. What use is a language if it
can't read and write to files?
> me how to do it pls? I think that this problem is pretty common... and
> that you can create files trivially(?) but I sure dont know how to do it.
One solution would be to read the documentation.
> This problem has been bothering me for ages!!!
Hmm.. are you THAT old?
There are things called "Documentation" and "FAQs" that many people
spend endless hours creating for you to consult when you have
problems. Did you look at them?
PS. You have a long signature. Cut it down to four lines max please.
Ala
------------------------------
Date: Tue, 16 Feb 1999 11:43:39 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Finding a hash key based on regexp
Message-Id: <x3y3e46jo3o.fsf@tigre.matrox.com>
Zack <zack44@altavista.net> writes:
> if (exists $hash{/(whatever)/} ) ...
Well, the only thing I can think of (which uses a loop anyway) is:
@keys = grep { /whatever/ } keys %hash;
I doubt if there's a Better Way.
Ala
------------------------------
Date: Wed, 17 Feb 1999 15:42:01 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Finding a hash key based on regexp
Message-Id: <x3ypv7869uu.fsf@tigre.matrox.com>
bart.lateur@skynet.be (Bart Lateur) writes:
> @matchkeys = grep { /(whatever)/ ) keys %hash;
^^^
TYPO: should be }
> or maybe even:
>
> %match = map { /(whatever)/?($_ => $hash{$_}):() } kays %hash;
^^^^
TYPO: should be keys
> which uses a map+grep simulated in just a map.
>
> Now, if there's a certain logic to the matches you're trying to
> accomplish, you could build some index. For example, if you're searching
> for a start letter, you could build an index for each letter, with as
> value an array of all keys that start with this letter. You might end up
> with an average tenfold increase speed, as compared to the original.
Yeah, but you waste a lot of space. If the origianl hash (as he
mentions) has 72,000 keys, I can't imagine what the size of this hash
would be! Then again, it might not be a big issue (depending on his
priorities).
Ala
------------------------------
Date: Mon, 15 Feb 1999 13:44:27 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: HELP stripping NEWLINE character
Message-Id: <x3yg1874id0.fsf@tigre.matrox.com>
nguyen.van@imvi.bls.com writes:
> The best way to strip newline is read every input in and use "chomp" ( not
> chop ). Chomp function is specially designed to remove "\n".
Just to be politically correct (and a pain in the butt), chomp()
removes the last character from a string if and only if it matches
the current value of the input record separator $/ (which is "\n" by
default).
Back to the regular program ...
------------------------------
Date: Wed, 17 Feb 1999 16:09:00 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: HELP! Why is this not working?
Message-Id: <x3yk8xg68lv.fsf@tigre.matrox.com>
see_my_sig@to_email_me.ca writes:
> Please help me find what is wrong with the piece below. I am going
> NUTS!!!
Then you probably overlooked something very obvious.
> while (<QF>) {
> print ">> $_"; #added to help me understand what's going on
> if (m'</tr'i) {$last;}
Changing that $last to last, I got your script to work
beautifully. Does that do it for you?
> }
HTH,
Ala
------------------------------
Date: Wed, 17 Feb 1999 13:12:22 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: How do you copy a text file to the body of an e-mail note?
Message-Id: <x3yvhh06gsd.fsf@tigre.matrox.com>
"Bob Flanagan" <no@not.net> writes:
>
> I have a text file called reginfo.txt and want to copy it to the body of a
> e-mail note and mail it. I haven't been able to get this to work. I can
> sometimes get a single line to be sent, but no more. The following is the
> code that I am using:
>
> sub mailadd{
> open(TXT,"reginfo.txt");
always check what open() does, just in case it doesn't do what you
expect it to:
open TXT, "reginfo.txt" or return "ERROR: can't open 'reginfo.txt'";
> my $body = <TXT>;
This will read the first line of the file. If you want to read the
whole file into one scalar, you have to do this:
my $body;
{ local $/ = undef; $body = <TXT> }
If you want to read the whole file into an array, you have to do this:
my @body = <TXT>;
> close(TXT);
again, it is advisable to check the return value of close().
> open (MAIL, "|$mailprog $in{'address'}") || die "Can't open
> $mailprog!\n";
> print MAIL "From: $admin_email\n";
> print MAIL "Subject: The Office Sentinel Mailing List\n";
This will confuse your mail program. The email header should be
separated from the email body by an empty line. Add the following:
print MAIL "\n";
> print MAIL "$body\n";
You might have to modify the above statement (if you slurp the whole
file into @body instead of $body).
> close (MAIL)
|| return "ERROR: Wasn't able to send mail";
> }
HTH,
Ala
------------------------------
Date: Thu, 18 Feb 1999 14:05:10 GMT
From: shapirojs.no@spam.hotmail.com <shapirojs@my-dejanews.com>
Subject: HTML::Entities -- ??BUG??
Message-Id: <7ah6mg$9t0$1@nnrp1.dejanews.com>
I'm using HTML::LinkExtor and links such as
<a href='myscript.cgi?next=1&chapter=0'>
are coming out as 'myscript.cgi?next=1&chapter;=0'
Pop the lid on HTML::Entities and we find:
sub decode_entities
{
......
s/(&\#(\d+);?)/$2 < 256 ? chr($2) : $1/eg;
s/(&\#[xX]([0-9a-fA-F]+);?)/$c = hex($2); $c < 256 ? chr($c) : $1/eg;
#s/(&(\w+);?)/$entity2char{$2} || "$1;"/eg; <-------------- Happens here
..........
}
----------- end of HTML::Entities excerpt
I don't see why we're (possibly) adding a semi-colon.
A buzz through dejanews yields an old posting of 'striphtml',
#########################################################
# striphtml ("striff tummel")
# tchrist@perl.com
# version 1.0: Thu 01 Feb 1996 1:53:31pm MST
# version 1.1: Sat Feb 3 06:23:50 MST 1996
# (fix up comments in annoying places)
#########################################################
#########################################################
# finally we'll translate all &valid; HTML 2.0 entities
#########################################################
s{ (
& # an entity starts with a semicolon
(
\x23\d+ # and is either a pound (#) and numbers
| # or else
\w+ # has alphanumunders up to a semi
)
;? # a semi terminates AS DOES ANYTHING ELSE (XXX)
)
} {
$entity{$2} # if it's a known entity use that
|| # but otherwise
$1 # leave what we'd found; NO WARNINGS (XXX)
}gex; # execute replacement -- that's code not a string
----------- end of striphtml excerpt
So there's a difference of opion here. How to resolve it?
I'm guessing the (XXX) in strophtml means we're dealing with something iffy.
Is the sample href I gave above technically invalid? I didn't write it, I'm
just parsing stuff I find on the web.
What is a mere mortal to do? Me, I'm planning on customizing my
HTML::Entities to use:
s/(&(\w+);)/$entity2char{$2} || "$1"/eg;
Am I running some risk that I don't know about? I know there's a
bug/inconsistency here. Is it in HTML::Entities::decode(), in the HTML spec,
or in the href?
Curious,
jonathan
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Tue, 16 Feb 1999 10:23:04 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Interleaving two lists?
Message-Id: <x3yaeyejru0.fsf@tigre.matrox.com>
"Howard Jones" <hjones@vossnet.co.uk> writes:
> chomp($first_line = <STDIN>);
> @fieldnames=split(/\t/,$firstline);
>
> chomp($nextline = <STDIN>);
> @values=split(/\t/,$nextline);
>
> # the hard bit
> %data = {magic code} @fieldnames, @values;
Use a hash slice:
@data{@fieldnames} = @values;
HTH,
Ala
------------------------------
Date: Mon, 15 Feb 1999 13:33:20 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Is there a perl script for finding out who fingered me???
Message-Id: <x3yk8xj4ivj.fsf@tigre.matrox.com>
seong joon bae <seongbae@students.uiuc.edu> writes:
> I have been trying to figure out a perl script that shows me who have
> fingered me.
> Is that possible?
No!
You can know the last time someone fingered you though (not
guaranteed). Just check the last access time of your .plan file.
------------------------------
Date: Thu, 18 Feb 1999 14:24:43 GMT
From: kojun@nri.com
Subject: MS Script Control and ActivePerl PerlScript
Message-Id: <7ah7r0$asr$1@nnrp1.dejanews.com>
Does anybody know how to use PerlScript with MS Script Control 1.0?
I defined a subroutine called "Test1" in both VBscript and Perlscript, and I
tried to invoke Run method on MS Script Control with parameter "Test1".
For VBScript it worked, but it didn't for PerlScript.
I examined the Procedures.Count method and found that no procedures are define
in the case of PerlScript.
I'm using IE4.01 SP1 and ActivePerl newest build version.
-----------== Posted via Deja News, The Discussion Network ==----------
http://www.dejanews.com/ Search, Read, Discuss, or Start Your Own
------------------------------
Date: Wed, 17 Feb 1999 16:03:02 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: none
Message-Id: <x3ylnhw68vt.fsf@tigre.matrox.com>
Fernando Tanzania <revjack@radix.net> writes:
> :perl -wle 'print "Prime" if (0 x shift) !~ m 0^\0?$|^(\0\0+?)\1+$0'
>
> Use of uninitialized value at -e line 1.
Maybe you didn't notice, but the above one-liner access @ARGV by using
shift(). If you supply a number to it, it would work.
% perl -wle 'print "Prime" if (0 x shift) !~ m 0^\0?$|^(\0\0+?)\1+$0' 17
Prime
Ala
------------------------------
Date: Mon, 15 Feb 1999 11:45:53 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: perl password example
Message-Id: <x3yn22f4nun.fsf@tigre.matrox.com>
Pavel Aubuchon-Mendoza <paubucho@aug.edu> writes:
>
> I don't think that's right... the range [a-zA-Z0-9] is only 62 characters,
> and the square root 4096 is 64...
But, the actual set of characters that Randal (see below) pointed out
is:
[a-zA-Z0-9/.]
which has 64 characters indeed. It is right.
> "Randal L. Schwartz" wrote:
>
> > >>>>> "Bob" == Bob Walton <walton@frontiernet.net> writes:
> >
> > Bob> Paul, the salt value is chosen randomly. There are two printable
> > Bob> characters in the salt, for 4096 possible salt values.
> >
> > I presume you mean "Two characters from the set of [a-zA-Z0-9/.]",
> > but you didn't say that, and I want to make sure that everyone playing
> > along at home knows what you mean too.
------------------------------
Date: Thu, 18 Feb 1999 14:57:09 -0000
From: "James Oliver" <oliver.james.jh@bhp.com.au>
Subject: Problem passing arrays and hashes to subroutines.
Message-Id: <7ah9gr$p2n@gossamer.itmel.bhp.com.au>
Hello,
I have a question regarding passing both an array and a hash as the argument
of a subroutine.
Specifically I want to be able to perform something like this:
sub
my_sub
{
my(%hash,@array) = @_;
# Function operations.
}
my_sub(%hash, @array);
However, when I do this it seems that the hash contains all but the last
element of the array, and the array contains a single element. I am sure I
am doing something stupid, so if you could please provide a pointer I would
be extremely appreciative.
Thankyou in anticipation of your help.
Cheers,
James
------------------------------
Date: Mon, 15 Feb 1999 13:39:33 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: reading a file
Message-Id: <x3yhfsn4il6.fsf@tigre.matrox.com>
Martin Pales <M.Pales@alcatel.de> writes:
> dan wrote:
> >
> > how can i have the script read the file until it reaches a certain
> > string and then stop? for the sake of argument, lets say $search =
> > "12345"
>
> The easiest way seems to be the following one:
>
> #!/usr/bin/perl
>
> $search = "12345";
>
> print "content-type:text/html\n";
>
> open(TEST, "template.txt");
> while(<TEST>) {
> if(/$search/) {
> last;
> }
> print $_;
> }
> close(TEST);
No .. The easiest way would be:
{ local $/ = $search; $string = <TEST> }
> > also, how can i get it to read the file from $search on? thanks for your
> > help
>
> #!/usr/bin/perl
>
> $found = 0;
> #search = "12345";
>
> print "content-type:text/html\n";
>
> open(TEST, "template.txt");
> while(<TEST>) {
> if(/$search/) {
> $found = 1;
> next;
> }
> if($found) {
> print $_;
> }
> }
> close(TEST);
Again:
{ local $/ = $search; $before = <TEST> }
{ undef $/; $after = <TEST> }
Ala
------------------------------
Date: Tue, 16 Feb 1999 11:05:23 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: reading a whole file into a string
Message-Id: <x3y7ltijpvg.fsf@tigre.matrox.com>
Mike Arms <marms@sandia.gov> writes:
> undef $/; open(IN, $fn); $s = <IN>; close(IN);
> print length($s) . "\n"; # Some test to see if it read whole file
As a note, always try to localize any changes to your global variables
as you might forget (later on in the program) the changes you have
made.
{ undef $/; local @ARGV = ($fn); $s = <> }
Ala
------------------------------
Date: 18 Feb 1999 07:39:46 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: RECIPE: Unpublished Tales from the PCB, 1 of 2
Message-Id: <36cc2632@csnews>
When preparing the Perl Cookbook, a few of the recipes didn't make
it to press. One was amarank, published in my amazon.com interview.
Here's another. It's one of those recipes without "real" measurements.
Adjust seasonings and proportions until you're happy with it.
HOT AND SOUR CRUNCHY RICE SALAD (serve chilled)
The base:
several cups black (or brown) rice, cooked rinced and drained
(you may wish to add wild "rice", also).
(I usually start with about 2 cups uncooked rice for this)
The crunchy bits: (don't cook any of these)
sweet, !green bell peppers (red or orange or yellow), sliced
red or white onions, sliced
green onions plus their tops, chopped
hot chiles (finely minced or sliced) (a few serranos should be fine)
fresh ginger and/or galangal, chopped (lots!)
toasted pecans, chopped
The squishy bits:
your favorite mushrooms, sliced and lightly cooked (steamed)
(flash-steamed baby peas would work ok here, too)
dried currants (or sultanas or raisins, etc), soaked
pinapple, mandarin segments, or fresh grapes, sliced
plus any packing syrup included in canned fruit
The savory bits:
juice and zest of 1 or 2 fresh lemons (or limes)
fruit-flavored vinegar (ume plum or raspberry)
soy or tamari sauce
hoisin sauce (or plum sauce, perhaps)
maple syrup (*real* stuff only; or else optional honey)
fresh herbs (cilantro and/or mint), chopped
white pepper (a bit)
toasted sesame oil (optional) [chile spiced?]
The garnishing bits:
serve on a bed of fresh greens or reds, like
kale, spinach, radiccio, or romaine lettuce
fresh bean sprouts or enoki mushrooms on the side
wedge of lemon/lime
fruit garnish (strawberries, oranges, etc)
The beverage:
A chilled, white or blush wine of some body and character (fruity
and/or smokey), would work well here; something like a chablis
would be too wimpy, but a strong red would probably be too heavy;
perhaps a fume blanc or some such. Or else have some fruit
juice. If it's for Sunday bunch, mimosas work nicely.
--
"That's okay. Anyone whose opinion he cares about already knows that
he doesn't care about their opinion."
--Larry Wall
------------------------------
Date: Tue, 16 Feb 1999 11:13:58 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Redirectiong STDERR
Message-Id: <x3y6792jph6.fsf@tigre.matrox.com>
"Jalil Feghhi" <jalilf@home.com> writes:
> I would like to redirect STDERR to a file. How should I do that?
open F, ">somefile" or die "$!\n";
*STDERR = *F;
print STDERR "something"; # this will go into somefile
------------------------------
Date: Wed, 17 Feb 1999 12:59:34 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: reverse ?
Message-Id: <x3yww1g6hdl.fsf@tigre.matrox.com>
John Diener <diener@darwin.ucsc.edu> writes:
> my manuals. i could not find anything in our perl man page on 'reverse'
> either.
% perldoc -f reverse
=item reverse LIST
In a list context, returns a list value consisting of the elements
of LIST in the opposite order. In a scalar context, concatenates the
elements of LIST, and returns a string value consisting of those bytes,
but in the opposite order.
print reverse <>; # line tac, last line first
undef $/; # for efficiency of <>
print scalar reverse <>; # byte tac, last line tsrif
This operator is also handy for inverting a hash, although there are some
caveats. If a value is duplicated in the original hash, only one of those
can be represented as a key in the inverted hash. Also, this has to
unwind one hash and build a whole new one, which may take some time
on a large hash.
%by_name = reverse %by_address; # Invert the hash
------------------------------
Date: Wed, 17 Feb 1999 15:59:03 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Speed Up Perl
Message-Id: <x3yn22c692g.fsf@tigre.matrox.com>
fl_aggie@thepentagon.com (I R A Aggie) writes:
>
> On 17 Feb 1999 09:04:15 -0500, Clay Irving <clay@panix.com> wrote:
>
> + How do you expect anyone to tell you how to speed up your program
> + without posting the program? The usual answer in this case is improve
> + line 17...
>
> No, you fool! Its line 21!
I believe lines 17 thru 21 (inclusive) can be safely deleted without
any loss of functionality. The real problem lies in the OS. Switch to
Linux and go get a refund for Winblows from Micro$oft.
Ala
------------------------------
Date: 18 Feb 1999 07:27:39 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: SRC: amarank
Message-Id: <36cc235b@csnews>
#!/usr/local/bin/perl -w
# amarank -- rank amazon books, keyed by publisher, author, title or subject.
# tchrist@perl.com
#
# version 1.1, Mon Aug 31 06:48:06 MDT 1998
# original version
# version 1.2, Wed Nov 18 08:04:11 MST 1998
# updated for amazon formatting changes
# removed book dimensions from output
# version 1.3, sol0@Lehigh.EDU, 1998/11/13.
# Add -b (brief output) and -m (max search).
# Re-issue "More" POST requests as needed to get all (or -m) hits.
# Fix fdie() to actually print errors.
# version 1.4, sol0@Lehigh.EDU, 1998/11/24.
# Add -p (publisher search). The code's getting a bit crufty - any more
# enhancements will force me (or someone) into re-write mode!
# version 1.5, sol0@Lehigh.EDU, 1998/11/28.
# ??
use subs qw/link/;
use strict;
use Carp;
use Getopt::Std;
use Text::Wrap qw($columns &wrap);
use HTML::FormatText;
use HTML::Parse;
use HTML::TreeBuilder;
use HTTP::Request;
use HTTP::Request::Common qw(GET POST);
use HTTP::Response;
use LWP::UserAgent;
use URI::URL;
$columns = 75;
my $version = 1.5;
my $opt_m_def = 2 * 50;
sub UNKNOWN { 999999999 }
sub usage {
print STDERR "$0: @_\n" if @_;
die <<EO_USAGE
v${version} usage: $0 [-s] [-t] [-a] [-p] [-b] [-v] [-r] [-w columns] [-n count] [-m hits] pattern(s)
-s search on subject
-t search on title [DEFAULT]
-a search on author
-p search on publisher
-r raw output only, don't rank first (faster output)
-b brief ranked output (truncataed at -w columns)
-m max limit search to at most int( (m-1)/50 + 1 ) * 50 hits [DEFAULT: $opt_m_def]
-n num show only the first n books
-w cols wrap at this many columns [DEFAULT: $columns]
-v debugging
pattern[s] is the search string list
EO_USAGE
}
$| = 1;
my(
$browser, # the virtual browser we'll use as user agent
$curreq, # the current HTTP request object
$response, # the current HTTP response object
$content, # raw HTML of
$which_search, # subject, author, or title
$form,
$formatter,
$hint2, # "More" POST hint2
$hint3, # "More" POST hint3
$his_base,
$hitlist,
$bookcount,
$next_screen,
$search_string,
$url,
%opts,
%Desc,
%ISBN_Rank,
%ISBN_Title,
%Seen_ISBN,
);
sub fdie { croak sprintf join ' ', @_ }
sub dprint { print STDERR @_ if $opts{'v'} }
@opts{qw!s t a p!} = (0,0,0,0);
getopts("rstapbvm:n:w:", \%opts) || usage("argument error");
if ($opts{"w"}) {
$columns = $opts{"w"};
}
$opts{m} ||= $opt_m_def;
if ( $opts{"s"} + $opts{"t"} + $opts{"a"} + $opts{p} > 1 ) {
usage("only one of opts s, t, a and p allowed.");
}
$which_search = $opts{"t"} ? 'title'
: $opts{"s"} ? 'subject'
: $opts{"a"} ? 'author'
: 'title';
$search_string = "@ARGV" || ($opts{p} ? "o'reilly" : "perl tk");
dprint "ss=$search_string\n";
$browser = LWP::UserAgent->new();
$browser->agent("amarank/$version");
$url = "http://www.amazon.com/";
link 'Full search:\s*(?:<BR>\s*)?<a href\s*=\s*"([^"]*)">';
dprint "new url=$url\n";
if ($opts{p}) {
link '(\/exec\/obidos\/subst\/search\/publication\-date.*?)">';
dprint "goto publisher search page at $url\n";
link '<B>Search by Publisher and/or Publication Date.*?<form[^>]*?action\s*=\s*"([^"]+)".*?</form>';
dprint "publisher search is at $url\n";
$curreq = POST $url, [
"type1" => 'Publisher',
"word1" => $search_string,
"mode " => "exact",
"submit" => "Search Now",
];
$hint2 = 8;
$hint3 = 66;
}else {
link 'Enter\s*Author.*?Title.*?<form[^>]*?action\s*=\s*"([^"]+)".*?</form>';
dprint "a-t-s search is at $url\n";
$curreq = POST $url, [
"author" => $which_search eq 'author' && $search_string,
"author-mode" => "full",
"title" => $which_search eq 'title' && $search_string,
"title-mode" => "word",
"subject" => $which_search eq 'subject' && $search_string,
"subject-mode" => "word",
"submit" => "Search Now",
];
$hint2 = 5;
$hint3 = 51;
}
$curreq->referer($his_base->as_string);
if (($response = $browser->request($curreq))->is_error()) {
fdie "Failed to lookup $url: %s\n", $response->status_line;
}
$hitlist = $response->content();
$opts{m} -= 50;
dprint "$hitlist!\n";
my ($new_url, $cs, $start);
$start = 50;
while ( ($opts{m} > 0) and (
($new_url, $cs) = $hitlist =~
m/<form\s+.*action="(.*subsequent-query\/qid=.*?)">.*?name="subsequent-query"\s+value="(.*?)">/is)) {
$opts{m} -= 50;
dprint "continue search $cs at hit $start\n";
my $new_url = url($new_url, $his_base);
$curreq = POST $new_url, [
'subsequent-query' => $cs,
'start' => $start,
'hint2' => $hint2,
'hint3' => $hint3,
'hint4' => 1,
'hint5' => '',
'domain' => 48,
'submit' => 'More',
];
$curreq->referer($his_base->as_string);
if (($response = $browser->request($curreq))->is_error()) {
fdie "Failed to lookup $url: %s\n", $response->status_line;
}
$hitlist =~ s/subsequent-query//g;
$hitlist .= $response->content;
$start += 50;
}
dprint "OK, start processing hits ...\n";
HIT:
while ($hitlist =~ m{
<b> \s*
<a \s+ href \s* = \s*
" (/exec/obidos/ASIN/([0-9X]+))/[^"]+" \s* >
(.*?)
</a></b>(.*)
}xig )
{
my($bookurl, $isbn, $title, $text) = ($1,$2,$3,$4);
next HIT if $Seen_ISBN{$isbn}++; # top few are dups
last HIT if $opts{'n'} && ++$bookcount > $opts{'n'};
for ($title) {
s/&/&/g;
s/</</g;
s/>/>/g;
s/"/"/g;
}
$ISBN_Title{$isbn} = $title;
print STDERR "[ISBN $isbn: $title]\n" if $opts{'v'} || !$opts{'r'}
and not $opts{b};
$url = url($bookurl, $his_base)->abs . "/t";
$curreq = GET $url;
$response = $browser->request($curreq);
if ($response->is_error()) {
printf "Failed to lookup $url: %s\n", $response->status_line;
exit(1);
}
my $data = $response->content;
$data =~ s/<\/?t[rhd].*?>//isg; # they have bad html in here
my $html = parse_html($data);
my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 500);
my $ascii = $formatter->format($html);
for ($ascii) {
my($rank) = /Amazon\.com\s+Sales\s+Rank:\s*([\d,]+)/;
($ISBN_Rank{$isbn} = $rank || UNKNOWN) =~ s/,//g;
s/.*\|\s*\n//s;
s/\[(TABLE|FORM) NOT SHOWN\]//gs;
s/Learn more about.*?ordering//si;
s/-----.*$//s;
s/\r//g;
s/^ +$//g;
s/^Our Price.*//m;
s/Our Price.*//m;
s/\s*;\s*Dimensions.*//;
s/Try express shopping with\s*//;
s/1-ClickSM and Gift Click\s*//;
s/^You Save.*//m;
s/(?=List Price)/\n/;
s/\n{2,}/\n/g;
unless ($opts{'r'}) {
$Desc{$isbn} = $_;
} else {
print map { wrap("", " ", $_) . "\n" } split /\n/;
print "\n";
}
}
} # end HIT
exit if $opts{'r'};
my $pub_ord = 0;
if ($opts{b}) {
print "\n";
print " " if $opts{p};
printf "%13s %9s %s %s\n\n", qw/ISBN Rank Title-Author/;
}
for my $isbn ( sort { $ISBN_Rank{$a} <=> $ISBN_Rank{$b} } keys %ISBN_Rank ) {
$_ = $Desc{$isbn};
if ($opts{b}) {
$pub_ord++;
my($t, $a) = (split /\n/)[0..1];
my $isbn2 = $isbn;
$isbn2 =~ s/(\d)(\d{5})(\d{3})(.)/$1-$2-$3-$4/;
printf("%3d ", $pub_ord) if $opts{p};
print substr(sprintf("%13s %9s %s %s", $isbn2,
($ISBN_Rank{$isbn} == UNKNOWN) ? "Unknown" :
commify($ISBN_Rank{$isbn}), $t, $a), 0, $columns - 1), "\n";
} else {
s/(Amazon\.com\s+Sales\s+Rank:.*\n)//;
print "Rank: ", ($ISBN_Rank{$isbn} == UNKNOWN)
? "Unknown"
: commify($ISBN_Rank{$isbn}),
"\n";
print map { wrap("", " ", $_) . "\n" } split /\n/;
print "\n";
}
}
print "\n" if $opts{b};
my $dups = 0;
print "\n";
foreach (keys %Seen_ISBN) {
my $count = $Seen_ISBN{$_};
next if $count == 1;
print "ISBN $_ found $count times\n";
$dups += $count;
}
print $dups, " duplicates\n" if $dups > 0;
sub commify {
my $text = reverse $_[0];
$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
return scalar reverse $text;
}
sub link {
# Link to a web page and extract the URL of the next page.
#
# We're given an incoming URL in $url; use it to fetch a web page,
# then extract the next URL using the supplied regular expression
# and update $url for our next invokation (globals galore!). The
# regexp's first subexpresion must be the new URL's pattern ($1).
my($regex) = @_;
$curreq = GET($url);
if (($response = $browser->request($curreq))->is_error()) {
fdie "Failed to lookup $url: %s\n", $response->status_line;
}
$his_base = $response->base;
dprint "His base is $his_base\n";
unless ($response->content =~ /$regex/is) {
die "couldn't find regex $regex\n" . $response->content;
}
$url = url($1, $his_base);
} # end link
--
I don't know if it's what you want, but it's what you get. :-)
--Larry Wall in <10502@jpl-devvax.JPL.NASA.GOV>
------------------------------
Date: Wed, 17 Feb 1999 15:32:32 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: STDERR of system call in variable?
Message-Id: <x3yr9ro6aan.fsf@tigre.matrox.com>
Stefan Etschberger <ste@hl.siemens.de> writes:
> I've got a system call of a UNIX program in a perl script. How do i
> redirect the STDERR output of this program to a perl variable?
% perldoc -f open
(scroll down a bit)
You may also, in the Bourne shell tradition, specify an EXPR beginning
with "E<gt>&", in which case the rest of the string is interpreted as the
name of a filehandle (or file descriptor, if numeric) which is to be
duped and opened. You may use & after E<gt>, E<gt>E<gt>, E<lt>, +E<gt>,
+E<gt>E<gt>, and +E<lt>. The
mode you specify should match the mode of the original filehandle.
(Duping a filehandle does not take into account any existing contents of
stdio buffers.)
Here is a script that saves, redirects, and restores STDOUT and
STDERR:
(I deleted the script .. go look for it yourself)
HTH,
Ala
------------------------------
Date: 18 Feb 1999 06:53:53 -0700
From: Tom Christiansen <tchrist@mox.perl.com>
Subject: Re: using filehandels in parent objects
Message-Id: <36cc1b71@csnews>
[courtesy cc of this posting sent to cited author via email]
In comp.lang.perl.misc,
renenyffenegger@my-dejanews.com writes:
:package A;
:sub new {
: my $type = shift;
: my $self = {};
: open FH, "/foo/bar";
:
: bless $self, $type;
:}
package A;
sub new {
my $type = shift;
my $self = {};
local *FH;
open(FH, "/foo/bar") || die $#!
$self->{"Handle here"} = *FH;
bless $self, $type;
}
Later
$obj = "A"->new();
print { $obj->{"Handle here"} } "data\n";
--tom
--
I use `batshit' in an idiosyncratic fashion. --Andrew Hume
------------------------------
Date: Tue, 16 Feb 1999 11:40:53 -0500
From: Ala Qumsieh <aqumsieh@matrox.com>
Subject: Re: Vital parts of $1 missing
Message-Id: <x3y4somjo8a.fsf@tigre.matrox.com>
Mark <admin@asarian-host.org> writes:
> $sites{'vtdomains'} = 'domain_one.org'.
> '|domain_two.org|domain_three.org'.
> '|domain_four.org';
[snip]
> $whoami = $1 if ($from =~ /([\w\.\+\-]+\@$sites{'vtdomains'})/i);
I can see two problems here.
1) check out the precedence of your |'s. Read perlre.
2) The dots in $sites{'vtdomain'} will have a special meaning (match
any character except a newline) in the regexp. Use \Q\E. Read perlre.
read perlre.
HTH,
Ala
------------------------------
Date: 12 Dec 98 21:33:47 GMT (Last modified)
From: Perl-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Special: Digest Administrivia (Last modified: 12 Dec 98)
Message-Id: <null>
Administrivia:
Well, after 6 months, here's the answer to the quiz: what do we do about
comp.lang.perl.moderated. Answer: nothing.
]From: Russ Allbery <rra@stanford.edu>
]Date: 21 Sep 1998 19:53:43 -0700
]Subject: comp.lang.perl.moderated available via e-mail
]
]It is possible to subscribe to comp.lang.perl.moderated as a mailing list.
]To do so, send mail to majordomo@eyrie.org with "subscribe clpm" in the
]body. Majordomo will then send you instructions on how to confirm your
]subscription. This is provided as a general service for those people who
]cannot receive the newsgroup for whatever reason or who just prefer to
]receive messages via e-mail.
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.misc (and this Digest), send your
article to perl-users@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
The Meta-FAQ, an article containing information about the FAQ, is
available by requesting "send perl-users meta-faq". The real FAQ, as it
appeared last in the newsgroup, can be retrieved with the request "send
perl-users FAQ". Due to their sizes, neither the Meta-FAQ nor the FAQ
are included in the digest.
The "mini-FAQ", which is an updated version of the Meta-FAQ, is
available by requesting "send perl-users mini-faq". It appears twice
weekly in the group, but is not distributed in the digest.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V8 Issue 4929
**************************************
