[31394] in Perl-Users-Digest
Perl-Users Digest, Issue: 2646 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Oct 22 16:09:47 2009
Date: Thu, 22 Oct 2009 13:09:05 -0700 (PDT)
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, 22 Oct 2009 Volume: 11 Number: 2646
Today's topics:
Re: FAQ 8.37 How do I find out if I'm running interacti <brian.d.foy@gmail.com>
Re: Getting current time in milliseconds <kst-u@mib.org>
Re: Getting current time in milliseconds <smallpond@juno.com>
Re: Getting current time in milliseconds <RedGrittyBrick@spamweary.invalid>
Indirection in a hash <dn.perl@gmail.com>
Re: Indirection in a hash <mritty@gmail.com>
Re: Indirection in a hash (Jens Thoms Toerring)
Re: Indirection in a hash <derykus@gmail.com>
Re: Learning OO, object creation query. <justin.0908@purestblue.com>
Re: Learning OO, object creation query. <justin.0908@purestblue.com>
Re: Want to write a script to note specific IP addresse <hongyi.zhao@gmail.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 22 Oct 2009 14:45:21 -0500
From: brian d foy <brian.d.foy@gmail.com>
Subject: Re: FAQ 8.37 How do I find out if I'm running interactively or not?
Message-Id: <221020091445215441%brian.d.foy@gmail.com>
In article <slrnhdutfg.arc.nospam-abuse@chorin.math.berkeley.edu>, Ilya
Zakharevich <nospam-abuse@ilyaz.org> wrote:
> On 2009-10-21, brian d foy <brian.d.foy@gmail.com> wrote:
> >> > 8.37: How do I find out if I'm running interactively or not?
> Given that it cannot be done programmatically, I think that the answer
> should be modifed in the following way:
All good suggestions, and I'll add it to my to do list.
Thanks,
------------------------------
Date: Wed, 21 Oct 2009 20:22:02 -0700
From: Keith Thompson <kst-u@mib.org>
Subject: Re: Getting current time in milliseconds
Message-Id: <lnk4youn8l.fsf@nuthaus.mib.org>
Jürgen Exner <jurgenex@hotmail.com> writes:
> Keith Thompson <kst-u@mib.org> wrote:
>>Jürgen Exner <jurgenex@hotmail.com> writes:
>>> laredotornado <laredotornado@zipmail.com> wrote:
>>>>I'm on a Mac OS 10.5.6 with Perl 5.8.8. From a shell script (/bin/
>>>>sh), do you know how I could use perl to get the current time in
>>>>milliseconds (or microseconds)
>>>
>>> perldoc Time::HiRes
>>>
>>>> and store the value in a shell variable?
>>>
>>> That is impossible because child processes cannot alter variables of the
>>> parent process. See "perldoc -q env" for a possible workaround.
>>
>>But a child process can certainly modify its own environment in
>>response to the output of something it invokes.
>
> But then it is acting as a new parent process, not as a child process.
Whoops, you're right, I meant "parent process", not "child process".
[...]
>>The workaround suggested in "perldoc -q env" requires the Perl script
>>to generate a shell command to be evaluated, but that's not necessary.
> [example snipped]
>
> True, but all of that is some magic on the shell side and applies to any
> process called by the shell in any programming language and therefore
> doesn't have anything to do with Perl and that's why the answer in the
> Perl FAQ points you to the documentation and FAQ for whatever shell you
> are using.
The Perl FAQ points to a particular shell-specific solution, using
"eval" (that's the shell's "eval", not Perl's "eval").
If it's going to avoid shell-specific solutions, it shouldn't mention
"eval". If not, it should mention some better solution.
(And yes, having a Perl script print a shell command that can then be
eval'ed by an invoking shell can be useful sometimes, but a simple
"x=$(./perl-script)" usually works just as well, and more safely.)
--
Keith Thompson (The_Other_Keith) kst-u@mib.org <http://www.ghoti.net/~kst>
Nokia
"We must do something. This is something. Therefore, we must do this."
-- Antony Jay and Jonathan Lynn, "Yes Minister"
------------------------------
Date: Thu, 22 Oct 2009 07:34:16 -0700 (PDT)
From: smallpond <smallpond@juno.com>
Subject: Re: Getting current time in milliseconds
Message-Id: <dee8575b-f54b-4a18-a343-9a74f6ccf34f@h2g2000vbd.googlegroups.com>
On Oct 21, 9:30=A0am, laredotornado <laredotorn...@zipmail.com> wrote:
> On Oct 20, 4:31=A0pm, Jim Gibson <jimsgib...@gmail.com> wrote:
>
>
>
> > In article
> > <c117c8d9-0749-4552-8e26-5188353a1...@o9g2000prg.googlegroups.com>,
>
> > laredotornado<laredotorn...@zipmail.com> wrote:
> > > Hi,
>
> > > I'm on a Mac OS 10.5.6 with Perl 5.8.8. =A0From a shell script (/bin/
> > > sh), do you know how I could use perl to get the current time in
> > > milliseconds (or microseconds) and store the value in a shell
> > > variable?
>
> > % set t=3D`perl -MTime::HiRes=3Dgettimeofday -e 'print
> > int(1000*gettimeofday()).qq(\n);'` ; echo Time in msec is $t
> > Time in msec is 1256077820486
> > %
>
> > --
> > Jim Gibson
>
> Thanks, Jim. =A0That's a winner! - Dave
Depends on your definition of 'current time'.
time set t=3D`perl -MTime::HiRes=3Dgettimeofday -e 'print int
(1000*gettimeofday()).qq(\n);'`
real 0m0.041s
user 0m0.032s
sys 0m0.009s
As long as you aren't expecting microsecond overhead
this is fine. If you really want to do times with
millisecond resolution, starting up a perl instance
is probably not the right way to go.
------------------------------
Date: Thu, 22 Oct 2009 17:51:07 +0100
From: RedGrittyBrick <RedGrittyBrick@spamweary.invalid>
Subject: Re: Getting current time in milliseconds
Message-Id: <4ae08d7e$0$2535$da0feed9@news.zen.co.uk>
smallpond wrote:
> On Oct 21, 9:30 am, laredotornado <laredotorn...@zipmail.com> wrote:
>> On Oct 20, 4:31 pm, Jim Gibson <jimsgib...@gmail.com> wrote:
>>
>>
>>
>>> In article
>>> <c117c8d9-0749-4552-8e26-5188353a1...@o9g2000prg.googlegroups.com>,
>>> laredotornado<laredotorn...@zipmail.com> wrote:
>>>> Hi,
>>>> I'm on a Mac OS 10.5.6 with Perl 5.8.8. From a shell script (/bin/
>>>> sh), do you know how I could use perl to get the current time in
>>>> milliseconds (or microseconds) and store the value in a shell
>>>> variable?
>>> % set t=`perl -MTime::HiRes=gettimeofday -e 'print
>>> int(1000*gettimeofday()).qq(\n);'` ; echo Time in msec is $t
>>> Time in msec is 1256077820486
>>> %
>>> --
>>> Jim Gibson
>> Thanks, Jim. That's a winner! - Dave
>
>
> Depends on your definition of 'current time'.
>
> time set t=`perl -MTime::HiRes=gettimeofday -e 'print int
> (1000*gettimeofday()).qq(\n);'`
>
> real 0m0.041s
> user 0m0.032s
> sys 0m0.009s
>
>
> As long as you aren't expecting microsecond overhead
> this is fine. If you really want to do times with
> millisecond resolution, starting up a perl instance
> is probably not the right way to go.
<nit pick>
s/resolution/accuracy/
http://www.tutelman.com/golf/measure/precision.php
</nit pick>
--
RGB
------------------------------
Date: Thu, 22 Oct 2009 09:12:04 -0700 (PDT)
From: "dn.perl@gmail.com" <dn.perl@gmail.com>
Subject: Indirection in a hash
Message-Id: <4e537bfe-d7c8-480b-b636-c87b7539a508@a39g2000pre.googlegroups.com>
Here is a piece of code whose output is : 'miami21 and miami21' :
#!/usr/bin/perl
use strict ;
my %hash = () ;
push @{$hash{florida}}, 'miami', 'miami01', 'miami02' ;
push @{$hash{florida}}, 'miami', 'miami21', 'miami22' ;
my $name = ${$hash{florida}}[4] . " and " . $hash{florida}[4] ;
print "name = $name \n" ;
How are $hash{florida}[4] and ${$hash{florida}}[4] the same thing?
I would have expected that indirection (I hope that is the correct
word for it) to produce something unintelligible or something
meaningless.
TIA.
------------------------------
Date: Thu, 22 Oct 2009 10:06:03 -0700 (PDT)
From: Paul Lalli <mritty@gmail.com>
Subject: Re: Indirection in a hash
Message-Id: <bdb13eb9-2f69-434e-99f3-8370862f468a@d34g2000vbm.googlegroups.com>
On Oct 22, 12:12=A0pm, "dn.p...@gmail.com" <dn.p...@gmail.com> wrote:
> How are $hash{florida}[4] =A0and =A0${$hash{florida}}[4] =A0the same thin=
g?
> I would have expected that indirection (I hope that is the correct
> word for it) to produce something unintelligible or something
> meaningless.
%hash is a hash.
$hash{florida} is a reference to an array.
@{$hash{florida}} is the array that $hash{$forida} references
${$hash{florida}}[4] is the 5th element of the array @{$hash{florida}}
$hash{forida}->[4] is the alternative "arrow syntax" notation for the
5th element of the array @{$hash{florida}}
$hash{florida}[4] is the same syntax, taking advantage of the face
that when an arrow separates two bracket/braces, it can be dropped.
perldoc perlreftut's Use Rule #1 and Use Rule #2 would be very good
things for you to read.
Paul Lalli
------------------------------
Date: 22 Oct 2009 17:31:48 GMT
From: jt@toerring.de (Jens Thoms Toerring)
Subject: Re: Indirection in a hash
Message-Id: <7kbj84F3915ocU1@mid.uni-berlin.de>
dn.perl@gmail.com <dn.perl@gmail.com> wrote:
> Here is a piece of code whose output is : 'miami21 and miami21' :
> #!/usr/bin/perl
> use strict ;
> my %hash = () ;
> push @{$hash{florida}}, 'miami', 'miami01', 'miami02' ;
> push @{$hash{florida}}, 'miami', 'miami21', 'miami22' ;
> my $name = ${$hash{florida}}[4] . " and " . $hash{florida}[4] ;
> print "name = $name \n" ;
> How are $hash{florida}[4] and ${$hash{florida}}[4] the same thing?
> I would have expected that indirection (I hope that is the correct
> word for it) to produce something unintelligible or something
> meaningless.
There's a special rule that '$hash{florida}[4]' is understood
to mean '$hash{florida}->[4]' and that's why you get the same
value as from '${hash{florida}}[4]'. The same holds if you have
a hash reference instead of an array reference, e.g. with
$hash{x} = { age => 7, name => 'Marvin };
print $hash{x}{age};
This will give you 7 since it's treated as if you had written
'$hash{x}->[age}' which is the same as ${$hash{x}}{age}'.
Or another example where there's a shortcut
$a = [ [ 1, 2, 3 ], [ 4, 6, 7 ] ];
print $b->[1][1];
will print 5 since it's taken to mean '$b->[1]->[1] or
${$b->[1]}[1]}' or '${$$b[1]}[1]' or '${${$b}[1]}[1]';-)
All this follows the same rule: the arrow operator is
optional between brackets and braces (or between a closing
bracket or brace and a paranthesis for an indirect function
call).
Most often it's probably used for "multidimensional arrays"
(I put that in parantheses since there aren't real multi-
dimensional arrays in Perl but instead you use arrays of
array references to emulate them). So when you have e.g.
@a = ( [ 1, 2, 3 ], [ 4, 5, 6 ] );
without that rule you would have to use one of
$a[1]->[1] or ${$a[1]}[1]
to get at the second element of the second array. But know
you can it write it instead as
$a[1][1]
which will make it look more like a normal multi-dimensional
array for people used to e.g. C.
Regards, Jens
--
\ Jens Thoms Toerring ___ jt@toerring.de
\__________________________ http://toerring.de
------------------------------
Date: Thu, 22 Oct 2009 13:08:28 -0700 (PDT)
From: "C.DeRykus" <derykus@gmail.com>
Subject: Re: Indirection in a hash
Message-Id: <365eb1ba-bf2b-40ab-966d-bc278e2fd338@x25g2000prf.googlegroups.com>
On Oct 22, 9:12=A0am, "dn.p...@gmail.com" <dn.p...@gmail.com> wrote:
> Here is a piece of code whose output is : 'miami21 and miami21' :
>
> #!/usr/bin/perl
>
> use strict ;
>
> my %hash =3D () ;
>
> push @{$hash{florida}}, 'miami', 'miami01', 'miami02' ;
> push @{$hash{florida}}, 'miami', 'miami21', 'miami22' ;
>
> my $name =3D ${$hash{florida}}[4] . " and " . $hash{florida}[4] ;
> print "name =3D $name \n" ;
>
> How are $hash{florida}[4] =A0and =A0${$hash{florida}}[4] =A0the same thin=
g?
> I would have expected that indirection (I hope that is the correct
> word for it) to produce something unintelligible or something
> meaningless.
>
If this had been a named array: you could just say:
push @array, ....
push @array, 'miami', 'miami21', 'miami22'
and later reference one of the array's members:
$array[4]
But with an anonymous array, you just need to replace the
named array with an anonymous ref you create on the fly:
push @{$hash{florida}}, 'miami', 'miami21', 'miami22'
And then later refer to the anonymous array member with:
${$hash{florida}}[4]
For details: perldoc perlref, perlreftut, and/or perldsc .
Data::Dumper can help with a peek under the covers too:
use Data::Dumper; ... etc; print Dumper \%hash;
--
Charles DeRykus
------------------------------
Date: Thu, 22 Oct 2009 09:19:50 -0000
From: Justin C <justin.0908@purestblue.com>
Subject: Re: Learning OO, object creation query.
Message-Id: <3be1.4ae023b6.dea74@zem>
On 2009-10-21, Randal L. Schwartz <merlyn@stonehenge.com> wrote:
>>>>>> "Justin" == Justin C <justin.0908@purestblue.com> writes:
>
>Justin> The most read book I have ever owned is the Llama, though, in this
>Justin> instance, I think the book may be too basic.
>
> Yes, you now need the Alpaca, the Llama sequel. It covers (surprise!)
> references and objects, right where you need them.
>
> print "Just another Perl hacker,"; # the original!
Is that a sales pitch Randal? Actually, it probably is a good idea. I
found the llama easy going enough, paced right for me, and, most
importantly I understood it!
I'll add it to my Christmas list.
Justin.
--
Justin C, by the sea.
------------------------------
Date: Thu, 22 Oct 2009 10:10:45 -0000
From: Justin C <justin.0908@purestblue.com>
Subject: Re: Learning OO, object creation query.
Message-Id: <426f.4ae02fa5.dd74f@zem>
On 2009-10-21, Randal L. Schwartz <merlyn@stonehenge.com> wrote:
>>>>>> "Justin" == Justin C <justin.0908@purestblue.com> writes:
>
>Justin> The most read book I have ever owned is the Llama, though, in this
>Justin> instance, I think the book may be too basic.
>
> Yes, you now need the Alpaca, the Llama sequel. It covers (surprise!)
> references and objects, right where you need them.
I've just had a good "Look Inside" the Alpaca on Amazon, looks right up
my street. Maybe I won't wait until Christmas. Thanks for the very
targetted ad campaign! ;)
Justin.
--
Justin C, by the sea.
------------------------------
Date: Thu, 22 Oct 2009 16:13:15 +0800
From: Hongyi Zhao <hongyi.zhao@gmail.com>
Subject: Re: Want to write a script to note specific IP addresses.
Message-Id: <0v40e5tsere2r4duqadll33bb65cs8au9a@4ax.com>
On Tue, 20 Oct 2009 13:20:18 -0500, "J. Gleixner"
<glex_no-spam@qwest-spam-no.invalid> wrote:
>Quite a few modules that help with IPs, however
>you could translate the IPs to integers and simply
>check if one IP is between the start and end.
>
>Place to start:
>
>use Net::Netmask qw(quad2int);
>
>
>To open/read/process files:
>
>perldoc -f open
>perldoc perlopentut
Firstly, thank you very much for your help.
Here, I'll describe the solution used by me now and some issues when
use this method:
Currently, I use a complete binary IPdatabase named QQWry.Dat which
include 373374 IP blocks oall over the world, you can download this
IPdatabase from the following url:
http://update.cz88.net/soft/qqwry.rar
Then you can use the following perl script to read the IP addresses
and the corresponding location informations to note the specific IP
addresses:
http://www.ieasy.org/download/qqwry.pl
The above qqwry.pl has the following content:
------------
sub ipwhere {
my $ipbegin,$ipend,$ipData1,$ipData2,$DataSeek,$ipFlag;
my $ip=shift;
my @ip=split(/\./,$ip);
my $ipNum = $ip[0]*16777216+$ip[1]*65536+$ip[2]*256+$ip[3];
my $ipfile="./QQWry.Dat";
open(FILE,"$ipfile");
binmode(FILE);
sysread(FILE,$ipbegin,4);
sysread(FILE,$ipend,4);
$ipbegin=unpack("L",$ipbegin);
$ipend=unpack("L",$ipend);
my $ipAllNum = ($ipend-$ipbegin)/7+1;
my $BeginNum=0;
my $EndNum=$ipAllNum;
Bgn:
my $Middle= int(($EndNum+$BeginNum)/2);
seek(FILE,$ipbegin+7*$Middle,0);
read(FILE,$ipData1,4);
my $ip1num=unpack("L",$ipData1);
if ($ip1num > $ipNum) {
$EndNum=$Middle;
goto Bgn;
}
read(FILE,$DataSeek,3);
$DataSeek=unpack("L",$DataSeek."\0");
seek(FILE,$DataSeek,0);
read(FILE,$ipData2,4);
my $ip2num=unpack("L",$ipData2);
if ($ip2num < $ipNum) {
goto nd if ($Middle==$BeginNum);
$BeginNum=$Middle;
goto Bgn;
}
$/="\0";
read(FILE,$ipFlag,1);
if ($ipFlag eq "\1") {
my $ipSeek;
read(FILE,$ipSeek,3);
$ipSeek = unpack("L",$ipSeek."\0");
seek(FILE,$ipSeek,0);
read(FILE,$ipFlag,1);
}
if ($ipFlag eq "\2") {
my $AddrSeek;
read(FILE,$AddrSeek,3);
read(FILE,$ipFlag,1);
if($ipFlag eq "\2") {
my $AddrSeek2;
read(FILE,$AddrSeek2,3);
$AddrSeek2 = unpack("L",$AddrSeek2."\0");
seek(FILE,$AddrSeek2,0);
}
else {
seek(FILE,-1,1);
}
$ipAddr2=<FILE>;
$AddrSeek = unpack("L",$AddrSeek."\0");
seek(FILE,$AddrSeek,0);
$ipAddr1=<FILE>;
}
else {
seek(FILE,-1,1);
$ipAddr1=<FILE>;
read(FILE,$ipFlag,1);
if($ipFlag eq "\2") {
my $AddrSeek2;
read(FILE,$AddrSeek2,3);
$AddrSeek2 = unpack("L",$AddrSeek2."\0");
seek(FILE,$AddrSeek2,0);
}
else {
seek(FILE,-1,1);
}
$ipAddr2=<FILE>;
}
nd:
chomp($ipAddr1,$ipAddr2);
$/="\n";
close(FILE);
$ipAddr2="" if($ipAddr2=~/http/i);
my $ipaddr="$ipAddr1 $ipAddr2";
$ipaddr =~ s/CZ88\.NET//isg;
$ipaddr="未知地区" if ($ipaddr=~/未知|http/i || $ipaddr eq
"");
return $ipaddr;
}
sub osinfo {
local $os="",$Agent;
$Agent = $ENV{'HTTP_USER_AGENT'};
if (($Agent =~ /win/i)&&($Agent =~ /95/i)) {
$os="Windows 95";
}
elsif (($Agent =~ /win 9x/i)&&($Agent =~ /4.90/i)) {
$os="Windows ME";
}
elsif (($Agent =~ /win/i)&&($Agent =~ /98/i)) {
$os="Windows 98";
}
elsif (($Agent =~ /win/i)&&($Agent =~ /nt 5\.0/i)) {
$os="Windows 2000";
}
elsif (($Agent =~ /win/i)&&($Agent =~ /nt 5\.1/i)) {
$os="Windows XP";
}
elsif (($Agent =~ /win/i)&&($Agent =~ /nt 5\.2/i)) {
$os="Windows 2003";
}
elsif (($Agent =~ /win/i)&&($Agent =~ /nt/i)) {
$os="Windows NT";
}
elsif (($Agent =~ /win/i)&&($Agent =~ /32/i)) {
$os="Windows 32";
}
elsif ($Agent =~ /linux/i) {
$os="Linux";
}
elsif ($Agent =~ /unix/i) {
$os="Unix";
}
elsif (($Agent =~ /sun/i)&&($Agent =~ /os/i)) {
$os="SunOS";
}
elsif (($Agent =~ /ibm/isg)&&($Agent =~ /os/isg)) {
$os="IBM OS/2";
}
elsif (($Agent =~ /Mac/i)&&($Agent =~ /PC/i)) {
$os="Macintosh";
}
elsif ($Agent =~ /FreeBSD/i) {
$os="FreeBSD";
}
elsif ($Agent =~ /PowerPC/i) {
$os="PowerPC";
}
elsif ($Agent =~ /AIX/i) {
$os="AIX";
}
elsif ($Agent =~ /HPUX/i) {
$os="HPUX";
}
elsif ($Agent =~ /NetBSD/i) {
$os="NetBSD";
}
elsif ($Agent =~ /BSD/i) {
$os="BSD";
}
elsif ($Agent =~ /OSF1/i) {
$os="OSF1";
}
elsif ($Agent =~ /IRIX/i) {
$os="IRIX";
}
elsif ($Agent =~ /google/i) {
$os = "GoogleBot";
}
elsif ($Agent =~ /Yahoo/i) {
$os = "YahooBot";
}
$os = "Unknown" if ($os eq '');
$os =~ s/[\a\f\n\e\0\r\t\)\(\*\+\?]//isg;
$os = substr($os, 0, 15) if (length($os) > 15);
return $os;
}
sub browseinfo {
my $browser = "";
my $browserver = "";
my ($Agent, $Part, $browseinfo);
$Agent = $ENV{"HTTP_USER_AGENT"};
if ($Agent =~ /Lynx/i)
{
$browser = "Lynx";
}
elsif ($Agent =~ /MOSAIC/i)
{
$browser = "MOSAIC";
}
elsif ($Agent =~ /AOL/i)
{
$browser = "AOL";
}
elsif ($Agent =~ /Lynx/i)
{
$browser = "Lynx";
}
elsif ($Agent =~ /Opera/i)
{
$browser = "Opera";
}
elsif ($Agent =~ /JAVA/i)
{
$browser = "JAVA";
}
elsif ($Agent =~ /MacWeb/i)
{
$browser = "MacWeb";
}
elsif ($Agent =~ /WebExplorer/i)
{
$browser = "WebExplorer";
}
elsif ($Agent =~ /OmniWeb/i)
{
$browser = "OmniWeb";
}
elsif ($Agent =~ /Mozilla/i)
{
if ($Agent =~ "MSIE")
{
if ($Agent =~ /MyIE(\d*)/)
{
$browserver = $1;
$browser = "MyIE";
}
else
{
$Part = (split(/\(/, $Agent))[1];
$Part = (split(/\;/,$Part))[1];
$browserver = (split(/ /,$Part))[2];
$browserver =~ s/([\d\.]+)/$1/isg;
$browser = "Internet Explorer";
}
}
elsif ($Agent =~ "Opera")
{
$Part = (split(/\(/, $Agent))[1];
$browserver = (split(/\)/, $Part))[1];
$browserver = (split(/ /,$browserver))[2];
$browserver =~ s/([\d\.]+)/$1/isg;
$browser = "Opera";
}
else
{
$Part = (split(/\(/, $Agent))[0];
$browserver = (split(/\//, $Part))[1];
$browserver = (split(/ /,$browserver))[0];
$browserver =~ s/([\d\.]+)/$1/isg;
$browser = "Netscape Navigator";
}
}
elsif ($Agent =~ /google/i)
{
$browser = "GoogleBot";
}
elsif ($Agent =~ /Yahoo/i)
{
$browser = "YahooBot";
}
if ($browser ne '')
{
$browserver =~ s/[^0-9\.b]//isg;
$browserver = &lbhz($browserver, 4) if
(length($browserver) > 10);
$browseinfo = "$browser $browserver";
}
else
{
$browseinfo = "Unknown";
}
$browseinfo =~ s/[\a\f\n\e\0\r\t\)\(\*\+\?]//isg;
$browseinfo =~ s/[\a\f\n\e\0\r\t\)\(\*\+\?]//isg;
$browseinfo = substr($browseinfo, 0, 28) if (length($browseinfo) >
28);
return $browseinfo;
}
1;
------------
Then we use the following perl script named PrintIPWhere.pl to
invoke the qqwry.pl and
QQWry.Dat to do the trick.
-----------------
#!/usr/bin/perl
use strict;
require "qqwry.pl";
print ipwhere("${ARGV[0]}");
print "\n";
-----------------
Below is a example for your information:
Suppose we have some IP addresses stored in IPfile like this:
168.105.234.109
65.24.0.0
0.0.0.0
141.0.0.0
140.255.0.0
Then put IPfile, qqwry.pl, PrintIPWhere.pl, and QQWry.Dat into the
same directory, and run the following commands will be OK:
$ for i in `cat IPfile`; do echo $i#`./PrintIPWhere.pl $i`;done
168.105.234.109#美国 University of Hawaii-Hawaii Medical Network
65.24.0.0#美国 Ohio State University
0.0.0.0#IANA
141.0.0.0#
140.255.0.0#未知地区
My issue is that: if the IPfile is a huge one, say including several
thousands entries in it, the above process will time consuming. So
how can I revise the above perl script with perl's multithread module
to improve the efficiency?
Thanks in advance.
--
.: Hongyi Zhao [ hongyi.zhao AT gmail.com ] Free as in Freedom :.
------------------------------
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:
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
Back issues are available via anonymous ftp from
ftp://cil-www.oce.orst.edu/pub/perl/old-digests.
#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 V11 Issue 2646
***************************************
