[12037] in Perl-Users-Digest
Perl-Users Digest, Issue: 5637 Volume: 8
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed May 12 08:07:58 1999
Date: Wed, 12 May 99 05:00:18 -0700
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Wed, 12 May 1999 Volume: 8 Number: 5637
Today's topics:
Re: "Text file busy" error (Timothy Larson)
Re: "Text file busy" error (Bart Lateur)
Conditional search and replace within a text file <hawkwynd@adelphia.net>
Re: Conditional search and replace within a text file <this.is@not.my.address.ok>
Re: From Oracle to Sybase in Perl (Dave Cross)
How "&#xxx;" and "%xx" convert to characters? <ataols@lanet.lv>
Re: How "&#xxx;" and "%xx" convert to characters? (Johannes K. Lehnert)
Re: How "&#xxx;" and "%xx" convert to characters? <gellyfish@gellyfish.com>
Re: Link -> auto generated page - question <andreas73@my-dejanews.com>
Re: MS-HTML must die! (Lack Mr G M)
problem with MIME::Lite module <david@icon.screaming.net>
send a PDF file <mpajot@club-internet.fr>
Re: Sorting is too slow for finding top N keys... - BEN (Marko R. Riedel)
Re: Sorting is too slow for finding top N keys... - BEN (Marko R. Riedel)
Re: Ten Tips toward *DIVERSITY COMPLIANCE* in Web Desig (Lack Mr G M)
When do i use GET and POST with form ? (Austin Ming)
Re: Where can I get a free ad. rotator? (Bob Trieger)
Re: Why no Net::FTP with ActivePerl? <gellyfish@gellyfish.com>
Special: Digest Administrivia (Last modified: 12 Dec 98 (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 10 May 1999 14:42:25 GMT
From: larsot2@krypton.mankato.msus.edu (Timothy Larson)
Subject: Re: "Text file busy" error
Message-Id: <7h6r8h$ko0$1@nitrogen.mankato.msus.edu>
In article <37302bb5.1393007@news.skynet.be>,
Bart Lateur <bart.lateur@skynet.be> wrote:
>Timothy Larson wrote:
>
>>OK, I'm not trying to overwrite anything intentionally. All I know is that
>>I will get one or two runs out of the script (from the command line or
>>web hits, whatever) and then the "text file busy" errors start in. If I
>>wait long enough they stop, and I can use the script a few more times. I'm
>>admittedly a newbie to using Perl, but this doesn't happen with CGI's I
>>have written in other languages. Is there something special I need to
>>do in Perl to say "Hey, I'm done now" other than simple program termination?
>>I can't very well have a CGI that only works half the time, now, can I?
>>:)
>
>Platform? I don't think you can get a "file busy" error on Unix. On
>other platforms, yes, but that's because of implicit file locking. Unix
>gladly lets multiple programs open a file for writing at the same time
>(urgh!). Not so on Windows, DOS, or Mac, to name a few.
>
>On those platforms, try making the script wait a while (see sleep()) and
>then retry.
>
>Maybe you're suffering from some sort of file caching problem. Explicit
>flushing should then solve that. Close the file explicitely, that might
>help.
>
> Bart.
Thanks, I will try closing my data files explicitly. However, given that
Perl is (in general) so good with error messages, you'd think it would tell
me that it is my data files that are busy, not the perl files.
I'm not very hopeful on this one, because I've hit the same problem a few
times with a form-to-email script that doesn't open data files.
My platform, BTW, is linux 2.0.34. We're running perl5 here, too.
Tim
------------------------------
Date: Wed, 12 May 1999 10:51:47 GMT
From: bart.lateur@skynet.be (Bart Lateur)
Subject: Re: "Text file busy" error
Message-Id: <373a5c92.451648@news.skynet.be>
Timothy Larson wrote:
>Thanks, I will try closing my data files explicitly. However, given that
>Perl is (in general) so good with error messages, you'd think it would tell
>me that it is my data files that are busy, not the perl files.
This makes me wonder. As other people have pointed out to me, you can
get this error message if you're trying to overwrite a script while it's
running.
You're not, by any chance, attempting to write the output to the script
file itself, are you? You could get that effect if using $0 as the file
name.
Bart.
------------------------------
Date: Wed, 12 May 1999 11:17:04 GMT
From: "Hawkwynd" <hawkwynd@adelphia.net>
Subject: Conditional search and replace within a text file
Message-Id: <Qqd_2.1993$5g5.19120@server1.news.adelphia.net>
I'm having a problem with coding this program, where I need to remove a
word, if no other text follows that word on a line.
foreach(@myarray)
next unless /^\d{2}_(\d{4})\.txt$/i;
open(INF,"$file_dir/$_");
open(OUTF,">$outdir/$1");
while(<INF>) {
# here, we remove 2 characters from the file
tr/\014\015/ /d;
# Does the word NOTES: have anything following it on this line?
next if /^NOTES:$/i;
# The next line is incorrect, and need help with the correct syntax to
remove
# the word NOTES: (colon also) from the textfile, if nothing else follows it
on a line.
tr/^NOTES:$/ /d;
print OUTF;
------------------------------
Date: Wed, 12 May 1999 12:45:02 +0100
From: Bob MacCallum <this.is@not.my.address.ok>
Subject: Re: Conditional search and replace within a text file
Message-Id: <373969BE.673A9B53@not.my.address.ok>
Hawkwynd wrote:
>
> I'm having a problem with coding this program, where I need to remove a
> word, if no other text follows that word on a line.
>
snip
>
> tr/^NOTES:$/ /d;
>
you might want to check in the manual for the difference between
m/abc/ or /abc/;
s/abc/xyz/;
and
tr/abc/xyz/;
--
from bob maccallum - email me at
initial.surname@icrf.icnet.uk
------------------------------
Date: Wed, 12 May 1999 12:01:43 GMT
From: dave@dave.org.uk (Dave Cross)
Subject: Re: From Oracle to Sybase in Perl
Message-Id: <373a6d5c.18279125@news.demon.co.uk>
On 11 May 1999 08:25:50 GMT, Laurent de LASTEYRIE
<lasteyrie@iname.com> wrote:
>I'm not really sure to be in the good newsgroups, but if anyone has an
>
>idea about the good one, all suggest are welcome.
>I found some examples of DBI using Oracle, but when i try with Sybase, i
>t doesn't work.
>Here is the script :
>
>#!/usr/bin/perl
>
>package Sybase::Sybperl;
>use Carp;
>require Exporter;
>require AutoLoader;
>use Sybase::DBlib;
>
>$bcp = new Sybase::DBlib sa,;
>my $sql = qq{SELECT id, name, title FROM zempl};
>my $sth = $bcp->prepare($sql);
>$sth->execute();
>my($id, $name, $title);
>$sth->bind_column(undef,\$id, \$name, \$title);
>while ($sth->fetch()) {
> print "$name, $title, $id\n";
>}
>$sth->finish();
>
>If anyone can say what going wrong in this script, it will really help m
>e...
>
I think your major problem is trying to use DBI methods on a SybPerl
object. Either use DBD::Sybase or read your SybPerl docs for the
correct methods.
Dave...
Dave Cross <dave@dave.org.uk>
<http://www.dave.org.uk>
------------------------------
Date: Wed, 12 May 1999 08:47:51 GMT
From: Ansis Ataols Berzins <ataols@lanet.lv>
Subject: How "&#xxx;" and "%xx" convert to characters?
Message-Id: <7hbf7o$li1$1@nnrp1.deja.com>
I search for the best way how to convert characters presented
in form "&#xxx;" and "%xx" to normal characters.
Thanks,
--
Ansis Ataols Berzins
http://ansis.folklora.lv/
http://maskacka.folklora.lv/
--== Sent via Deja.com http://www.deja.com/ ==--
---Share what you know. Learn what you don't.---
------------------------------
Date: 12 May 1999 09:14:41 GMT
From: lehnert@jupiter.uni-trier.de (Johannes K. Lehnert)
Subject: Re: How "&#xxx;" and "%xx" convert to characters?
Message-Id: <7hbgq1$6k4$2@fu-berlin.de>
In article <7hbf7o$li1$1@nnrp1.deja.com>,
Ansis Ataols Berzins <ataols@lanet.lv> writes:
> I search for the best way how to convert characters presented
> in form "&#xxx;" and "%xx" to normal characters.
Hi,
I don't know about your "%xx" thing, but for HTML entities you can use
HTML::Entities.
Bye
Johannes K.
--
Johannes K. Lehnert E-Mail: lehnert@stud.informatik.uni-trier.de
WWW: http://www.informatik.uni-trier.de/CIP/lehnert/
------------------------------
Date: 12 May 1999 11:30:12 +0100
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: How "&#xxx;" and "%xx" convert to characters?
Message-Id: <37395834@newsread3.dircon.co.uk>
Ansis Ataols Berzins <ataols@lanet.lv> wrote:
> I search for the best way how to convert characters presented
> in form "&#xxx;" and "%xx" to normal characters.
>
You would use HTML::Entities to decode the first
and URI::Escape to decode the second - that is if I have guessed what
you mean correctly.
However I am not sure that *you* know what the significance of these
things are - you might consider looking at:
<http://www.rfc-editor.org/rfc/rfc1866.txt> for an explanation of the first
<http://www.rfc-editor.org/rfc/rfc1738.txt> for the second.
/J\
--
Jonathan Stowe <jns@gellyfish.com>
------------------------------
Date: Wed, 12 May 1999 11:16:50 GMT
From: Andreas <andreas73@my-dejanews.com>
Subject: Re: Link -> auto generated page - question
Message-Id: <7hbnuv$rls$1@nnrp1.deja.com>
Yes, sort of. But there are different images to different links, but
maybe I could figure that one out for myself no that im on the right
track. Thank4s
Andreas
In article <37393720@newsread3.dircon.co.uk>,
Jonathan Stowe <gellyfish@gellyfish.com> wrote:
> Andreas <andreas73@my-dejanews.com> wrote:
> > Ok here4s the uncovered question, how to autogenerate a page from a
link
> > that is related to an image, which will be viewed on the generated
page?
> > Didn4t I say that before?
> > ??
>
> You mean :
>
> #!/usr/bin/perl -w
>
> use strict;
>
> use CGI qw(:standard);
>
> print header,
> start_html(-title => 'A page with an image on it'),
> img( -src => 'someimage.gif'),
> end_html;
>
> Or do I misunderstand ?
>
> /J\
> --
> Jonathan Stowe <jns@gellyfish.com>
>
--== Sent via Deja.com http://www.deja.com/ ==--
---Share what you know. Learn what you don't.---
------------------------------
Date: Wed, 12 May 1999 11:50:09 BST
From: gml4410@ggr.co.uk (Lack Mr G M)
Subject: Re: MS-HTML must die!
Message-Id: <1999May12.115009@ukwit01>
In article <MPG.11a2d09ffa328077989a37@nntp.hpl.hp.com>, lr@hpl.hp.com (Larry Rosler) writes:
|>
|> I promised to redo the demoroniser (British spelling) in one page.
Now why is this though to be the British spelling? I quote, from
Usage&Abusage (Eric Partridge: Penguin Books, ISBN 0 14 051.024 9):
"-ize and -ise, ver-endings.
Fowler, in "Modern English Usage", has an admirable article on the
subject. The following summary rule is based on "The O.E.D's" article
(at -ize). You will be safe if you make every verb, every derivation
noun or participal adjective, conform to the -z type, for this suffix
comes, whether direct or via Latin or French, from the Greek -izein; to
employ -ise is to flout etymology and logic. Moreover, whether the
spelling be -ise, or -ize, the pronunciation is -ize; another reason
for using it."
(And another reason for using -ize is to exercise the "z" key on the
keyboard.)
--
----------- Gordon Lack ----------------- gml4410@ggr.co.uk ------------
The contents of this message *may* reflect my personal opinion. They are
*not* intended to reflect those of my employer, or anyone else.
------------------------------
Date: Wed, 12 May 1999 12:53:58 +0100
From: "David Craig" <david@icon.screaming.net>
Subject: problem with MIME::Lite module
Message-Id: <f2e_2.635$T3.1592@newsr2.u-net.net>
I'm sure I'm doing something really stupid, but I can't seem to get the
MIME::Lite module to work. I have installed Lite.pm into the /cgi-bin/
directory on the web server, and trying to run the script below. Can anyone
spot what I am doing wrong?
I am getting a 500 Internal Server Error
The server encountered an internal error or misconfiguration and was unable
to complete your request.
Any Ideas? Thanks
David
#!/usr/bin/perl
use MIME::Lite;
# Create a new single-part message, to send a GIF file:
$msg = new MIME::Lite
>From =>'test2@thewebserver.com',
To =>'test2@mycompany.com',
Cc =>'again@mycompany.com',
Subject =>'Test email',
Type =>'image/gif',
Encoding =>'base64',
Path =>'u-net_logo.gif';
MIME::Lite->send('sendmail', "/usr/lib/sendmail");
$msg->send;
print "Content-type: text/html\n\n";
print <<EOF;
<html>
<head><title>Success</title></head>
<body>
<FONT SIZE="2" FACE="arial, helvetica">
<center>
<table border=0 width=100% height=100%>
<tr>
<td valign=center><center><FONT SIZE="3" FACE="arial, helvetica"><b>Mail
sent correctly
</td>
</tr>
</table>
</body>
</html>
EOF
------------------------------
Date: Wed, 12 May 1999 12:48:33 +0200
From: "Kevin" <mpajot@club-internet.fr>
Subject: send a PDF file
Message-Id: <7hbm92$mgl$1@front7.grolier.fr>
Hi,
My goal is to send a PDF file to the client, I know the header
"Content-type: application/pdf" but what do I have to do then ? (the
navigator is supposed to ask the surfer if he wants to read the file or save
it on the disk)
Other little question (I have no reference book on Perl)
- How can I get the first or the third letter of a string $string
- How can I get the date in my perl script under an Unix server (do I have
to use "exec")
- How can I generate random numbers
That's all
Regards
Sylvain
------------------------------
Date: 12 May 1999 11:27:17 +0200
From: mriedel@neuearbeit.de (Marko R. Riedel)
Subject: Re: Sorting is too slow for finding top N keys... - BENCH I
Message-Id: <lzk8uey6x6.fsf_-_@linux_sexi.neuearbeit.de>
I compared Larry's latest to QuickSelect with median-of-three pivoting
and this is what I found.
[SNIP] > ./qselvslrtime1.pl 8192 512 1 8
constructing permutations ... done.
Benchmark: timing 8 iterations of LRosler, QselInPlace...
LRosler: 102 wallclock secs (98.58 usr + 0.00 sys = 98.58 CPU)
QselInPlace: 7 wallclock secs ( 7.14 usr + 0.00 sys = 7.14 CPU)
#! /usr/bin/perl -w
#
use Benchmark;
sub qsel {
local ($aref, $min, $max, $lower, $upper) = @_;
local ($temp, $pivot, $i, $j);
return $aref if($lower>=$upper);
if($lower==$upper-1){
if($$aref[$lower]>$$aref[$upper]){
$temp=$$aref[$lower];
$$aref[$lower]=$$aref[$upper];
$$aref[$upper]=$temp;
}
return $aref;
}
if($upper-$lower>=2){
my $c01=$$aref[$lower] <=> $$aref[$lower+1];
my $c02=$$aref[$lower] <=> $$aref[$lower+2];
my $c12=$$aref[$lower+1] <=> $$aref[$lower+2];
my $median=0;
if(($c01!=1 && $c12!=1) ||
($c01!=-1 && $c12!=-1)){
$median=1;
}
if(($c02!=1 && $c12!=-1) ||
($c02!=-1 && $c12!=1)){
$median=2;
}
if($median){
$temp=$$aref[$lower];
$$aref[$lower]=$$aref[$lower+$median];
$$aref[$lower+$median]=$temp;
}
}
$pivot=$$aref[$lower];
$i=$lower+1; $j=$upper;
while($i<=$j){
while($i<=$j && $$aref[$i]<$pivot){
$$aref[$i-1]=$$aref[$i];
$i++;
};
while($i<=$j && $$aref[$j]>=$pivot){ $j-- };
if($i<=$j-1){
$temp=$$aref[$i];
$$aref[$i]=$$aref[$j];
$$aref[$j]=$temp;
}
}
$$aref[$i-1]=$pivot;
&qsel($aref, $min, $max, $lower, $i-2)
if($i>$lower+1 && $min<$i-1);
&qsel($aref, $min, $max, $i, $upper)
if($i<$upper && $max>=$i);
return $aref;
}
sub makeperm {
local ($size)=@_;
local ($i);
local @perm=(-1) x $size;
local @source=(0..$size-1);
for($i=$size; $i>0; $i--){
$invs=int(rand($i));
$perm[$source[$invs]]=$i;
splice @source, $invs, 1;
}
return \@perm;
}
sub extremes { # Return the N extreme-valued elements of an array or a hash.
my ($ref, $n, $num, $max) = @_;
$n && $n > 0 or return ();
my $refref = $ref && ref $ref || "";
my $array = $refref eq 'ARRAY' ? 1 : $refref eq 'HASH' ? 0 : die
"First argument '$ref' isn't a reference to an array or a hash.\n";
my ($j, @out) = 0;
if ($num && ref $num eq 'CODE') { # Binary insertion.
while (defined(my $key = $array ? $ref->[$j++] : each %$ref)) {
next if @out == $n &&
do { ($a, $b) = ($key, $out[-1]); &$num > 0 };
my ($lo, $hi, $i) = (0, scalar @out);
for ($i = int($hi/2); $lo < $hi; $i = $lo + int(($hi - $lo)/2)) {
($a, $b) = ($key, $out[$i]);
my $comp = &$num;
if ($comp > 0) { $lo = $i + 1 }
elsif ($comp < 0) { $hi = $i }
else { last };
}
splice @out, $i, 0, $key;
--$#out if @out > $n;
}
return @out;
}
$max = $max ? -1 : +1; # Descending sort if max is TRUE.
if ($array) { # Linear insertion (fewer perl-ops).
while (defined(my $key = $ref->[$j++])) {
next if @out == $n && $max == ($num ? $key <=> $out[-1]
: $key cmp $out[-1]);
my $i = 0;
++$i while $i < @out && $max == ($num ? $key <=> $out[$i]
: $key cmp $out[$i]);
splice @out, $i, 0, $key;
--$#out if @out > $n;
}
} else { # Linear insertion (fewer perl-ops).
while (my ($key, $val) = each %$ref) {
next if @out == $n && $max == ($num ? $val <=> $ref->{$out[-1]}
: $val cmp $ref->{$out[-1]});
my $i = 0;
++$i while $i < @out &&
$max == ($num ? $val <=> $ref->{$out[$i]}
: $val cmp $ref->{$out[$i]});
splice @out, $i, 0, $key;
--$#out if @out > $n;
}
}
@out
}
MAIN: {
local ($size, $elements, $maxmin, $count)=@ARGV;
local (@perma, @permb, $i, $min, $max);
$|=1;
if($maxmin){
$max=$size-1; $min=$max-$elements+1;
} else{
$min=0; $max=$elements-1;
}
print 'constructing permutations ... ';
for($i=0; $i<$count; $i++){
my ($ref, @copy);
$ref=&makeperm($size);
@copy=@$ref[0..$size-1];
$perma[$i]=$ref;
$permb[$i]=\@copy;
}
print "done.\n";
$i=0; timethese
($count,
{
QselInPlace => sub
{
&qsel($perma[$i++], $min, $max, 0, $size-1)
},
LRosler => sub
{
&extremes($permb[--$i], $max-$min+1, 1, $maxmin);
}
}
);
}
------------------------------
Date: 12 May 1999 11:33:57 +0200
From: mriedel@neuearbeit.de (Marko R. Riedel)
Subject: Re: Sorting is too slow for finding top N keys... - BENCH II
Message-Id: <lziu9yy6m2.fsf_-_@linux_sexi.neuearbeit.de>
I also ran QuickSelect on Larry's sample data. (The algorithm is the
same and makes no use of the properties of hashes. It copies key data
that the user may not not be interested in.) I had to disambiguate
keys (hash values) by randomization in order to prevent QuickSelect
from going quadratic.
[SNIP] > ./lrosler1.pl 6 < lrosler.dat
ZZYYXXWWVVUUTTSSRRQQ
ZZYYXXWWVVUUTTSSRRQQ
AABBCCDDEEFFGGHHIIJJ
aAbBcCdDeEfFgGhHiIjJ
aAbBcCdDeEfFgGhHiIjJ
zZyYxXwWvVuUtTsSrRqQ
31012
79 59 56 52 50 41 41 37 37 37 33 32 32 31 31 31 31 30 30 30
79 59 56 52 50 41 41 37 37 37 33 32 32 31 31 31 31 30 30 30
Benchmark: timing 6 iterations of Internal, Qsel, Sortsub...
Internal: 30 wallclock secs (28.53 usr + 0.03 sys = 28.56 CPU)
Qsel: 31 wallclock secs (30.76 usr + 0.01 sys = 30.77 CPU)
Sortsub: 58 wallclock secs (55.79 usr + 0.02 sys = 55.81 CPU)
#!/usr/bin/perl -w
#
use strict;
sub qsel {
my ($aref, $min, $max, $lower, $upper) = @_;
my ($temp, $pivot, $i, $j);
return $aref if($lower>=$upper);
if($lower==$upper-1){
if(($$aref[$lower]->[1]>$$aref[$upper]->[1]) ||
($$aref[$lower]->[1]==$$aref[$upper]->[1] &&
$$aref[$lower]->[2]>$$aref[$upper]->[2])){
$temp=$$aref[$lower];
$$aref[$lower]=$$aref[$upper];
$$aref[$upper]=$temp;
}
return $aref;
}
if($upper-$lower>=2){
my $c01=$$aref[$lower]->[1] <=> $$aref[$lower+1]->[1] ||
$$aref[$lower]->[2] <=> $$aref[$lower+1]->[2];
my $c02=$$aref[$lower]->[1] <=> $$aref[$lower+2]->[1] ||
$$aref[$lower]->[2] <=> $$aref[$lower+2]->[2];
my $c12=$$aref[$lower+1]->[1] <=> $$aref[$lower+2]->[1] ||
$$aref[$lower+1]->[2] <=> $$aref[$lower+2]->[2];
my $median=0;
if(($c01!=1 && $c12!=1) ||
($c01!=-1 && $c12!=-1)){
$median=1;
}
if(($c02!=1 && $c12!=-1) ||
($c02!=-1 && $c12!=1)){
$median=2;
}
if($median){
$temp=$$aref[$lower];
$$aref[$lower]=$$aref[$lower+$median];
$$aref[$lower+$median]=$temp;
}
}
$pivot=$$aref[$lower];
$i=$lower+1; $j=$upper;
while($i<=$j){
while($i<=$j &&
($$aref[$i]->[1]<$pivot->[1] ||
($$aref[$i]->[1]==$pivot->[1] &&
$$aref[$i]->[2]<$pivot->[2]))){
$$aref[$i-1]=$$aref[$i];
$i++;
};
while($i<=$j &&
($$aref[$j]->[1]>$pivot->[1] ||
($$aref[$j]->[1]==$pivot->[1] &&
$$aref[$j]->[2]>=$pivot->[2]))){
$j--;
};
if($i<=$j-1){
$temp=$$aref[$i];
$$aref[$i]=$$aref[$j];
$$aref[$j]=$temp;
}
}
$$aref[$i-1]=$pivot;
&qsel($aref, $min, $max, $lower, $i-2)
if($i>$lower+1 && $min<$i-1);
&qsel($aref, $min, $max, $i, $upper)
if($i<$upper && $max>=$i);
return $aref;
}
sub toarray {
my ($href) = @_;
my (@array, $key, $value, $pos);
$pos=0; $array[$pos++]=
do { my (@alloc) =
($key, $value, int(rand(1<<16))); \@alloc }
while(($key, $value) = each %$href);
return \@array;
}
sub extremes { # Return N extreme-valued elements of array or hash.
my ($ref, $n, $num, $max) = @_;
my $ref_type = $ref && ref $ref || "";
my $hash = $ref_type eq 'HASH' ? 1 : $ref_type eq 'ARRAY' ? 0 :
die "First argument '$ref' must be a reference to array or hash.\n";
$n && $n > 0 or return ();
$max = $num && ref $num eq 'CODE' ? 0 : $max ? -1 : +1;
my @out;
for (my $j = 0;
defined(my $key = $hash ? each %$ref : $ref->[$j++]); ) {
next if @out == $n &&
($max ? $max == ($hash ? $num ? $ref->{$key} <=> $ref->{$out[-1]}
: $ref->{$key} cmp $ref->{$out[-1]}
: $num ? $key <=> $out[-1]
: $key cmp $out[-1])
: do { ($a, $b) = ($key, $out[-1]); &$num > 0 });
my ($lo, $hi, $i) = (0, scalar @out);
for ($i = int($hi/2); $lo < $hi; $i = $lo + int(($hi - $lo)/2)) {
my $comp =
$max ? $max * ($hash ? $num ? $ref->{$key} <=> $ref->{$out[$i]}
: $ref->{$key} cmp $ref->{$out[$i]}
: $num ? $key <=> $out[$i]
: $key cmp $out[$i])
: do { ($a, $b) = ($key, $out[$i]); &$num };
if ($comp > 0) { $lo = $i + 1 }
elsif ($comp < 0) { $hi = $i }
else { last };
}
splice @out, $i, 0, $key;
--$#out if @out > $n;
}
@out
}
# extremes() returns the extreme N values of a list, or the keys of the
# extreme N values of a hash. When the aggregate is very large and the
# number of values N is relatively small, this function is much more
# efficient than sorting the entire aggregate and returning a slice from
# the appropriate end of the sorted list.
#
# extremes(ref, n, num, max)
# ref = reference to array or hash
# n = maximum number of elements to return
# num = sort numeric if TRUE, sort lexicographic if FALSE
# max = maxima descending if TRUE, minima ascending if FALSE
#
# Trailing FALSE arguments may be omitted. More complex sorting
# comparisons may be done using a standard sorting subroutine as the
# third argument.
#
# The algorithm for this function, and an initial implementation, were
# presented by Michel Dalle, 8 May 1999.
#
# Larry Rosler, 10 May 1999
#*********************************************************************
my @array = ( 'A' .. 'Z', 'A' .. 'Z' );
print extremes(\@array, 20, sub { $b cmp $a }), "\n";
print extremes(\@array, 20, 0, 1), "\n"; # lexicographic, maxima
print extremes(\@array, 20), "\n"; # lexicographic, minima
my %hash;
@hash{ 'a' .. 'z', 'A' .. 'Z' } = ( 1 .. 26, 1 .. 26 );
print extremes(\%hash, 20, sub { $hash{$a} <=> $hash{$b} }), "\n";
print extremes(\%hash, 20, 1), "\n"; # numeric, minima
print extremes(\%hash, 20, 1, 1), "\n"; # numeric, maxima
%hash = ();
for (my $key = 'aaaa'; <STDIN>; ) {
my ($value, $number) = /(\d+)\s+(\d+)/;
$hash{$key++} = $value while $number--;
}
print scalar keys %hash, "\n"; # (that's 31012 entries)
print map("$hash{$_} ", extremes(\%hash, 20, 1, 1)), "\n";
my $aref = &toarray(\%hash);
&qsel($aref, $#$aref-19, $#$aref, 0, $#$aref);
foreach(reverse @$aref[$#$aref-19..$#$aref]) { print "$_->[1] "; };
print "\n";
my $itcount = (shift || 1);
$aref = &toarray(\%hash);
use Benchmark;
timethese($itcount, {
Qsel => sub { my @copy=@$aref[0..$#$aref];
&qsel(\@copy, $#$aref-199, $#$aref,
0, $#$aref) },
Internal => sub { extremes(\%hash, 200, 1, 1) },
Sortsub => sub { extremes(\%hash, 200,
sub { $hash{$b} <=> $hash{$a} }) }
});
__END__
------------------------------
Date: Wed, 12 May 1999 11:04:04 BST
From: gml4410@ggr.co.uk (Lack Mr G M)
Subject: Re: Ten Tips toward *DIVERSITY COMPLIANCE* in Web Design
Message-Id: <1999May12.110404@ukwit01>
In article <7h9n93$3lj$1@ffx2nh3.news.uu.net>, "Matt Kruse" <mkruse@rens.com> writes:
|>
|> >4) Make sure that you use nothing but standard HTML. Never ever use
|> > MS-HTML -- ever.
|>
|> Again, I disagree. I recently wrote a system which required IE5 to
|> function correctly. I required all users to use IE5. Either they chose
|> to comply and use the system, or they chose not to use the system. It's
|> that simple. Again... generalizing way too much.
No, they didn't *chose* not to use the system - they were *forced* to
not use the system. There is a big difference. You have now locked
that system into IE (presumably). So why did you make it a Web
application at all?
--
----------- Gordon Lack ----------------- gml4410@ggr.co.uk ------------
The contents of this message *may* reflect my personal opinion. They are
*not* intended to reflect those of my employer, or anyone else.
------------------------------
Date: 12 May 1999 11:49:28 GMT
From: austin95002887@yahoo.com (Austin Ming)
Subject: When do i use GET and POST with form ?
Message-Id: <7hbps8$kip$9@justice.csc.cuhk.edu.hk>
When do i use GET and POST with form ?
Kevin
http://i.am/heshe
------------------------------
Date: Wed, 12 May 1999 10:37:34 GMT
From: sowmaster@juicepigs.com (Bob Trieger)
Subject: Re: Where can I get a free ad. rotator?
Message-Id: <7hbkh4$4q4$2@fir.prod.itd.earthlink.net>
"michael.shiah" <michael.shiah@cdc.com> wrote:
>As title.
get lost!
------------------------------
Date: 12 May 1999 09:53:39 +0100
From: Jonathan Stowe <gellyfish@gellyfish.com>
Subject: Re: Why no Net::FTP with ActivePerl?
Message-Id: <37394193@newsread3.dircon.co.uk>
leonandrews@my-dejanews.com wrote:
> Hi,
>
> Can anyone tell me why Net::FTP no longer seems to be available with
> ActivePerl using PPM? Are there any issues which may have caused it to
> be removed from the Net family of modules?
>
Sorry ? I have build 515 on this machine and I certainly do have it - if
you dont you should be able to install libnet with PPM no problem.
/J\
--
Jonathan Stowe <jns@gellyfish.com>
------------------------------
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 5637
**************************************
