[28264] in Perl-Users-Digest
Perl-Users Digest, Issue: 9628 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Aug 19 09:05:48 2006
Date: Sat, 19 Aug 2006 06:05: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 Sat, 19 Aug 2006 Volume: 10 Number: 9628
Today's topics:
Re: FAQ 4.33 How do I pad a string with blanks or pad a <1usa@llenroc.ude.invalid>
Re: FAQ 4.33 How do I pad a string with blanks or pad a <mgarrish@gmail.com>
Re: get() not working...need help <dha@panix.com>
new CPAN modules on Sat Aug 19 2006 (Randal Schwartz)
Re: Perl5 AST <uri@stemsystems.com>
Re: reverse dns <hjp-usenet2@hjp.at>
Re: Sort Keys in hash table? <uri@stemsystems.com>
Re: Sort Keys in hash table? <1usa@llenroc.ude.invalid>
Re: Sort Keys in hash table? <zhushenli@gmail.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 19 Aug 2006 04:55:21 GMT
From: "A. Sinan Unur" <1usa@llenroc.ude.invalid>
Subject: Re: FAQ 4.33 How do I pad a string with blanks or pad a number with zeroes?
Message-Id: <Xns982497C1641asu1cornelledu@127.0.0.1>
"bdz" <bdalzell@qis.net> wrote in news:1155960270.727802.254540
@b28g2000cwb.googlegroups.com:
> Thanks for the explaination and examples.
>
> To clarify: $padded = sprintf("%0*d", $pad_len, $num);
Please quote an appropriate amount of context when you reply. I filter
out the FAQ postings, and I am not going to dig out this one to figure
out what you are thanking about or clarifying.
> When I tried it out in a short sample program:
> ## begin code ###
> #!/usr/bin/perl
use strict;
use warnings;
missing.
> while (-1){
What is wrong with
while ( 1 ) {
> print "enter number of spaces: ";
> $pad_len=<STDIN>;
> chomp($pad_len);
> print "enter number: ";
> $num=<STDIN>;
> chomp($num);
> $padded = sprintf("%0*d", $pad_len, $num);
>
> print "$padded\n";
> }
Please indent your code properly to help others reading your code.
> yields a string of length $pad_length with the number of zeros added
> to make it that length rather than adding $pad_length zeros to the
> left of a number.
OK, that is what "%0*d" is supposed to do.
> Is there anything one can do to preserve the leading zeros in the
> string for later use,
I have no idea what you are asking. You saved the generated string in
$padded.
> as in a file name for example, or do they have to
> be generated whenever you need the string?
Use $padded. If you are asking something else, clarify (preferably,
after reading the posting guidelines).
Here is a cleaned up version of your script:
#!/usr/bin/perl
use strict;
use warnings;
$| = 1;
while ( 1 ) {
print "enter number of spaces: ";
chomp ( my $pad_len = <STDIN> );
print "enter number: ";
chomp ( my $num = <STDIN> );
printf "%0*d\n", $pad_len, $num;
}
__END__
--
--
A. Sinan Unur <1usa@llenroc.ude.invalid>
(remove .invalid and reverse each component for email address)
comp.lang.perl.misc guidelines on the WWW:
http://augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html
------------------------------
Date: 19 Aug 2006 04:27:13 -0700
From: "Matt Garrish" <mgarrish@gmail.com>
Subject: Re: FAQ 4.33 How do I pad a string with blanks or pad a number with zeroes?
Message-Id: <1155986833.724363.66640@b28g2000cwb.googlegroups.com>
A. Sinan Unur wrote:
> "bdz" <bdalzell@qis.net> wrote in news:1155960270.727802.254540
> @b28g2000cwb.googlegroups.com:
>
> > Thanks for the explaination and examples.
> >
> > To clarify: $padded = sprintf("%0*d", $pad_len, $num);
>
> > yields a string of length $pad_length with the number of zeros added
> > to make it that length rather than adding $pad_length zeros to the
> > left of a number.
>
> OK, that is what "%0*d" is supposed to do.
>
I think he doesn't want s/printf at all, but just
my $padded = '0'x$pad_len . $num;
But in my opinion that just seems ugly and pointless
> > Is there anything one can do to preserve the leading zeros in the
> > string for later use,
>
> I have no idea what you are asking. You saved the generated string in
> $padded.
>
Got me there too, unless he's doing something dumb like padding the
number before performing other math operations on it so that they're
subsequently lost. I suppose that could be solved in this case
(assuming I'm right above) by the following:
my $pad = '0'x$pad_len;
And then applying the pad whenever outputting.
Matt
------------------------------
Date: Sat, 19 Aug 2006 05:08:26 +0000 (UTC)
From: "David H. Adler" <dha@panix.com>
Subject: Re: get() not working...need help
Message-Id: <slrneed76a.kua.dha@panix2.panix.com>
On 2006-08-18, usenet@DavidFilmer.com <usenet@DavidFilmer.com> wrote:
> Matt Garrish wrote:
>> DF> Hmmm. I'm not familiar with the '...' command either.
>> You've seriously never encountered the range operator before? ; )
>
> Not as a standalone command (which is what the OP's 'code' showed).
> And it's not even semicolon terminated. Maybe that's a Perl6 thing...
Well, as an operator, it's definitely a Perl 5 thing. Admittedly, it's
far less well known than its two character brother...
dha
--
David H. Adler - <dha@panix.com> - http://www.panix.com/~dha/
"supported" is an MS term that means the function exists. The fact
that it always fails means, that it is an exercise for the programmer.
- Douglas Lankshear, p5p
------------------------------
Date: Sat, 19 Aug 2006 04:42:08 GMT
From: merlyn@stonehenge.com (Randal Schwartz)
Subject: new CPAN modules on Sat Aug 19 2006
Message-Id: <J48AE8.F7A@zorch.sf-bay.org>
The following modules have recently been added to or updated in the
Comprehensive Perl Archive Network (CPAN). You can install them using the
instructions in the 'perlmodinstall' page included with your Perl
distribution.
Apache-Authenlemonldap-1.0.0
http://search.cpan.org/~egerman/Apache-Authenlemonldap-1.0.0/
Perl extension for Apache with lemonldap websso
----
Apache-ClearSilver-0.01
http://search.cpan.org/~jiro/Apache-ClearSilver-0.01/
Apache/mod_perl interface to the ClearSilver template system.
----
Apache2-xForwardedFor-0.04
http://search.cpan.org/~jvanasco/Apache2-xForwardedFor-0.04/
Re-set remote_ip to incoming client's ip when running mod_perl behind a reverse proxy server. In other words, copy the first IP from X-Forwarded-For header, which was set by your reverse proxy server,
----
Astro-FITS-Header-3.0
http://search.cpan.org/~tjenness/Astro-FITS-Header-3.0/
Object Orientated interface to FITS HDUs
----
Audio-ConvTools-0.06
http://search.cpan.org/~mhooreman/Audio-ConvTools-0.06/
API to convert audio files from/to mp3 ogg and wav
----
AxKit2-1.0
http://search.cpan.org/~msergeant/AxKit2-1.0/
XML Application Server
----
Bundle-Slash-2.52
http://search.cpan.org/~cnandor/Bundle-Slash-2.52/
A bundle to install all modules used for Slash
----
Cache-Simple-TimedExpiry-0.24
http://search.cpan.org/~jesse/Cache-Simple-TimedExpiry-0.24/
----
Class-Meta-Express-0.04
http://search.cpan.org/~dwheeler/Class-Meta-Express-0.04/
Concise, expressive creation of Class::Meta classes
----
Class-Std-Slots-v0.0.1
http://search.cpan.org/~andya/Class-Std-Slots-v0.0.1/
Provide signals and slots for standard classes.
----
Class-Std-Slots-v0.0.2
http://search.cpan.org/~andya/Class-Std-Slots-v0.0.2/
Provide signals and slots for standard classes.
----
DBIx-Class-0.07001
http://search.cpan.org/~jrobinson/DBIx-Class-0.07001/
Extensible and flexible object <-> relational mapper.
----
Date-Pregnancy-0.03
http://search.cpan.org/~jonasbn/Date-Pregnancy-0.03/
calculate birthdate and week numbers for a pregnancy
----
File-Temp-0.17
http://search.cpan.org/~tjenness/File-Temp-0.17/
return name and handle of a temporary file safely
----
Getopt-Lucid-0.16
http://search.cpan.org/~dagolden/Getopt-Lucid-0.16/
Clear, readable syntax for command line processing
----
HTML-Merge-3.52
http://search.cpan.org/~razinf/HTML-Merge-3.52/
Embedded HTML/SQL/Perl system.
----
HTML-Template-Compiled-0.72
http://search.cpan.org/~tinita/HTML-Template-Compiled-0.72/
Template System Compiles HTML::Template files to Perl code
----
HTTP-Proxy-0.20
http://search.cpan.org/~book/HTTP-Proxy-0.20/
A pure Perl HTTP proxy
----
Lingua-Stem-Snowball-0.941
http://search.cpan.org/~creamyg/Lingua-Stem-Snowball-0.941/
Perl interface to Snowball stemmers.
----
Lingua-StopWords-0.06
http://search.cpan.org/~creamyg/Lingua-StopWords-0.06/
Stop words for several languages
----
MDV-Distribconf-2.03
http://search.cpan.org/~nanardon/MDV-Distribconf-2.03/
Read and write config of a Mandriva Linux distribution tree
----
MDV-Distribconf-2.04
http://search.cpan.org/~nanardon/MDV-Distribconf-2.04/
Read and write config of a Mandriva Linux distribution tree
----
Mail-Convert-Mbox-ToEml-0.03
http://search.cpan.org/~rpagitsch/Mail-Convert-Mbox-ToEml-0.03/
Perl extension to convert Mbox files (from Mozilla and Co) to Outlook Express eml files.
----
Math-Geometry-0.04
http://search.cpan.org/~gmccar/Math-Geometry-0.04/
Geometry related functions
----
POE-Component-IRC-4.98
http://search.cpan.org/~bingos/POE-Component-IRC-4.98/
a fully event-driven IRC client module.
----
POE-Component-WWW-Shorten-1.01
http://search.cpan.org/~bingos/POE-Component-WWW-Shorten-1.01/
A non-blocking wrapper around WWW::Shorten.
----
POSIX-Regex-0.89
http://search.cpan.org/~jettero/POSIX-Regex-0.89/
OO interface for the gnu regex engine
----
RPC-JSON-0.1
http://search.cpan.org/~jshirley/RPC-JSON-0.1/
----
Text-SwiftTemplate-0.0701
http://search.cpan.org/~rubykat/Text-SwiftTemplate-0.0701/
a fast, lightweight template engine.
----
Tk-JComboBox-1.11
http://search.cpan.org/~rcseege/Tk-JComboBox-1.11/
Create and manipulate JComboBox widgets
----
Tripletail-0.16
http://search.cpan.org/~mikage/Tripletail-0.16/
Tripletail, Framework for Japanese Web Application
----
Tripletail-0.17
http://search.cpan.org/~mikage/Tripletail-0.17/
Tripletail, Framework for Japanese Web Application
----
URI-ParseSearchString-0.5
http://search.cpan.org/~sden/URI-ParseSearchString-0.5/
parse Apache refferer logs and extract search engine query strings.
----
WWW-CloudCreator-1.1
http://search.cpan.org/~sock/WWW-CloudCreator-1.1/
A weighted cloud creator
----
WWW-Search-UrbanDictionary-0.2
http://search.cpan.org/~sock/WWW-Search-UrbanDictionary-0.2/
Search the Urban Dictionary via SOAP
----
WebService-Basecamp-0.1.1
http://search.cpan.org/~davidb/WebService-Basecamp-0.1.1/
Perl interface to the Basecamp API webservice
----
Workflow-0.22
http://search.cpan.org/~jonasbn/Workflow-0.22/
Simple, flexible system to implement workflows
----
ack-1.25_02
http://search.cpan.org/~petdance/ack-1.25_02/
grep-like text finder for large trees of text
If you're an author of one of these modules, please submit a detailed
announcement to comp.lang.perl.announce, and we'll pass it along.
This message was generated by a Perl program described in my Linux
Magazine column, which can be found on-line (along with more than
200 other freely available past column articles) at
http://www.stonehenge.com/merlyn/LinuxMag/col82.html
print "Just another Perl hacker," # the original
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!
------------------------------
Date: Sat, 19 Aug 2006 00:07:18 -0400
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: Perl5 AST
Message-Id: <x7wt95qsg9.fsf@mail.sysarch.com>
>>>>> "r" == romerun <romerun@gmail.com> writes:
r> I have been wondering for a long time if there exists any abstract
r> syntax tree parser for Perl5 or any attempt to create it. In the CPAN
r> there are some B:: modules that can give some kinds of Perl5 OP tree,
r> which loses some important information to do some static checking such
r> as type checking via type annotation, reference leaking, unreachable
r> code, etc. Any suggest on where should I look ?
perl 6 will be able to do that and partly already. larry wall is working
on that and also the PPI modules can do a decent text analysis of perl5
code.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: Sat, 19 Aug 2006 12:50:09 +0200
From: "Peter J. Holzer" <hjp-usenet2@hjp.at>
Subject: Re: reverse dns
Message-Id: <pan.2006.08.19.10.50.08.829970@hjp.at>
On Sat, 19 Aug 2006 00:03:55 +0100, Ben Morrow wrote:
> Quoth John Bokma <john@castleamber.com>:
>> Uri Guttman <uri@stemsystems.com> wrote:
>> >>>>>> "JB" == John Bokma <john@castleamber.com> writes:
>> > JB> axel@white-eagle.invalid.uk wrote:
>> > >> sihyung@gmail.com wrote:
>> > >>> Does anybody know how to perform a reverse dns that returns the
>> > >>> number of domains associated with a certain IP? Thanks
[...]
>> > why even use a module? the getXXbyXX functions support basic reverse
>> > dns lookups.
>>
>> Tested this, but it doesn't return virtual hosts on a given IP address. No
>> idea if Net::DNS suffers from the same problem.
DNS doesn't have the concept of "virtual hosts" or "hosting" in general.
It's just a hierarchical directory structure where every node may have
some information (e.g., IP-addresses, texts, service information,
location information, ...) associated with it.
> Well... yes. DNS Doesn't Work Like That. Given an IP address, all you
> can do is look it up in .in-addr.arpa., in which case what you get is at
> most one PTR to (if you're lucky) the canonical hostname for that
> address.
Nope. The number of PTR records is not limited. For example,
dig 2.20.130.143.in-addr.arpa. ptr
returns three of them.
But there is no guarantee that there is a corresponding PTR record for
every A record - the correspondence exists only by convention, and it is
infeasible in some situations (e.g., if thousands of FQDNs resolve to
the same IP address, you don't want to return thousands of PTR records
to every query).
> The only way to find all the hostnames that resolve to a given ip is to
> trawl the *whole* of the DNS and grep out the appropriate entries. Not
> something I'd recommend trying... :)
Doesn't work, since most most nameservers don't answer AXFR requests
from untrusted clients anymore. I used to do that kind of thing for some
of the smaller TLDs in the 1990's :-).
hp
--
_ | Peter J. Holzer | > Wieso sollte man etwas erfinden was nicht
|_|_) | Sysadmin WSR | > ist?
| | | hjp@hjp.at | Was sonst wäre der Sinn des Erfindens?
__/ | http://www.hjp.at/ | -- P. Einstein u. V. Gringmuth in desd
------------------------------
Date: Sat, 19 Aug 2006 00:13:31 -0400
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: Sort Keys in hash table?
Message-Id: <x7sljtqs5w.fsf@mail.sysarch.com>
>>>>> "D" == Davy <zhushenli@gmail.com> writes:
D> I have write a program based on my idea. And the program run well.
D> my @data_list = (
D> "5;3;7",
D> "1;5;11",
D> "11;4;8",
D> "1;3;9"
D> );
D> my @data_sort = sort compare (@data_list);
D> sub compare {
D> my @a_list = split /$separator/, $a;
D> my @b_list = split /$separator/, $b;
D> my $a_list_length = (@a_list); # prevent while from dead-loop
D> my $compare_result = 0; #equal
D> my $index = 0;
D> while ($compare_result == 0) {
D> my $compare_result = ($a_list[$index] <=> $b_list[$index]);
D> if ($compare_result != 0) {
D> return $compare_result;
D> }
D> else {
D> $index ++;
D> }
D> # prevent while from dead-loop
D> if ($index > $a_list_length) {
D> die("sort compare index overflow");
D> }
D> # Debug usage
D> # print "index = $index\n";
D> # print "compare_result = $compare_result\n";
D> }
D> }
that may work but if your input list is large it will be deadly
slow. you call that major sub for each time a pair of values is
compared. if you care about speed as your dataset grows you should use a
module like sort::maker or some other way to factor out all that
redundant work. you see you do that for each $a and $b and in a typical
sort input values will be compared more than one time so you are redoing
work over and over. but if you only have 5 values, who cares?
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: Sat, 19 Aug 2006 04:44:26 GMT
From: "A. Sinan Unur" <1usa@llenroc.ude.invalid>
Subject: Re: Sort Keys in hash table?
Message-Id: <Xns98247A26FCF4asu1cornelledu@127.0.0.1>
"Davy" <zhushenli@gmail.com> wrote in
news:1155958256.128784.253450@75g2000cwc.googlegroups.com:
>
> Davy 写道：
>
>> A. Sinan Unur wrote:
>> > "Davy" <zhushenli@gmail.com> wrote in news:1155768562.219578.123460
>> > @i3g2000cwc.googlegroups.com:
>> >
>> > > I want to sort key in hash table.
>> > > The hash table key format is some integer split with ";" like:
>> > > "5;12;17;28"
>> > > And I want to sort the key from the first integer to the last
>> > > integer(i.e. the first integer has highest priority, and the
>> > > second, third,... until the last):
>> > >
>> > > example:
>> > > 5;12;17;28
>> > > 5;13;15;2
>> > > 5;13;18;1
>> >
>> > perldoc -f sort
>> >
>> > perldoc -q sort
...
> I have write a program based on my idea. And the program run well.
>
> #---code begin---
> use strict;
> use warnings;
>
> my $separator = ";";
>
> my @data_list = (
> "5;3;7",
> "1;5;11",
> "11;4;8",
> "1;3;9"
> );
>
> my @data_sort = sort compare (@data_list);
> print_1d_list(\@data_sort);
This sub is uncessary.
{
local $, = "\n"; # see perldoc perlvar
print @data_sort, "\n";
}
will print an array in the same format.
> sub compare {
> my @a_list = split /$separator/, $a;
> my @b_list = split /$separator/, $b;
You should be able to gain some efficiency by compiling the regex only
once.
> my $a_list_length = (@a_list); # prevent while from dead-loop
>
> my $compare_result = 0; #equal
> my $index = 0;
> while ($compare_result == 0) {
> my $compare_result = ($a_list[$index] <=> $b_list[$index]);
> if ($compare_result != 0) {
> return $compare_result;
> }
> else {
> $index ++;
> }
>
> # prevent while from dead-loop
> if ($index > $a_list_length) {
> die("sort compare index overflow");
> }
A lot of this is somewhat cumbersome. IMHO, the fact that it does not
handle lists of different lengths is a shortcoming.
So, below I including an example which generates a comparison subroutine
parameterized by the separator you want to use. It handles lists of
different lengths as well. Given two lists of length m and n with m > n,
if the lists are identical in the first n elements, it declares the one
with m elements to be greater than the shorter one.
#!/usr/bin/perl
use strict;
use warnings;
my $separator = ";";
my @data_list = qw(
5;3;7
5;3;7;9
5;3;7;9;
5;3;7;9;10
1;5;11
11;4;8
1;3;9
1;3;9
1;39;11
);
my $compare = make_comparator(';');
my @data_sort = sort $compare (@data_list);
{
local $, = "\n";
print @data_sort;
}
sub make_comparator {
my ($separator) = shift;
my $rx = qr/$separator/;
return sub {
my @a = split $rx, $a;
my @b = split $rx, $b;
while ( @a or @b ) {
my $ai = shift @a;
my $bi = shift @b;
return 1 if defined $ai and not defined $bi;
return -1 if not defined $ai and defined $bi;
return $ai <=> $bi unless $ai == $bi;
}
return 0; # same number of elements, all equal
};
}
__END__
Note that the comparison can be expensive. To reduce the number of
comparisons, you can use "The Schwartzian Transform" (see
<URL: http://www.stonehenge.com/merlyn/UnixReview/col06.html>).
#!/usr/bin/perl
use strict;
use warnings;
my $separator = ";";
my @data_list = qw(
5;3;7
5;3;7;9
5;3;7;9;
5;3;7;9;10
1;5;11
11;4;8
1;3;9
1;3;9
1;39;11
);
my @data_sort = map { $_->[1] }
sort vector_compare
map { [ [ split /;/ ], $_ ] }
@data_list;
{
local $, = "\n";
print @data_sort;
}
sub vector_compare {
my @a = @{ $a->[0] };
my @b = @{ $b->[0] };
while ( @a or @b ) {
my $ai = shift @a;
my $bi = shift @b;
return 1 if defined $ai and not defined $bi;
return -1 if not defined $ai and defined $bi;
return $ai <=> $bi unless $ai == $bi;
}
return 0; # same number of elements, all equal
}
__END__
Let's take a look at that
my @data_sort = map { $_->[1] }
sort vector_compare
map { [ [ split /;/ ], $_ ] }
@data_list;
Here, for each element of @data_list
map { [ [ split /;/ ], $_ ] } @data_list;
creates a reference to an anonymous array with two elements. The first
element is a reference to another anonymous array containing the split
numbers. This is used by the comparison routine. The second element is
the original string from @data_list. This is used for reconstituting the
list after sorting is done.
sort vector_compare
sorts this list according to the vector_compare sub above
map { $_->[1] }
then reconstitutes the original array.
Sinan
--
A. Sinan Unur <1usa@llenroc.ude.invalid>
(remove .invalid and reverse each component for email address)
comp.lang.perl.misc guidelines on the WWW:
http://augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html
------------------------------
Date: 19 Aug 2006 01:32:07 -0700
From: "Davy" <zhushenli@gmail.com>
Subject: Re: Sort Keys in hash table?
Message-Id: <1155976327.263084.222160@75g2000cwc.googlegroups.com>
A=2E Sinan Unur wrote:
> "Davy" <zhushenli@gmail.com> wrote in
> news:1155958256.128784.253450@75g2000cwc.googlegroups.com:
>
> >
> > Davy =E5=86=99=E9=81=93=EF=BC=9A
> >
> >> A. Sinan Unur wrote:
> >> > "Davy" <zhushenli@gmail.com> wrote in news:1155768562.219578.123460
> >> > @i3g2000cwc.googlegroups.com:
> >> >
> >> > > I want to sort key in hash table.
> >> > > The hash table key format is some integer split with ";" like:
> >> > > "5;12;17;28"
> >> > > And I want to sort the key from the first integer to the last
> >> > > integer(i.e. the first integer has highest priority, and the
> >> > > second, third,... until the last):
> >> > >
> >> > > example:
> >> > > 5;12;17;28
> >> > > 5;13;15;2
> >> > > 5;13;18;1
> >> >
> >> > perldoc -f sort
> >> >
> >> > perldoc -q sort
>
> ...
>
> > I have write a program based on my idea. And the program run well.
> >
> > #---code begin---
> > use strict;
> > use warnings;
> >
> > my $separator =3D ";";
> >
> > my @data_list =3D (
> > "5;3;7",
> > "1;5;11",
> > "11;4;8",
> > "1;3;9"
> > );
> >
> > my @data_sort =3D sort compare (@data_list);
> > print_1d_list(\@data_sort);
>
> This sub is uncessary.
>
> {
> local $, =3D "\n"; # see perldoc perlvar
> print @data_sort, "\n";
> }
>
> will print an array in the same format.
>
> > sub compare {
> > my @a_list =3D split /$separator/, $a;
> > my @b_list =3D split /$separator/, $b;
>
> You should be able to gain some efficiency by compiling the regex only
> once.
>
> > my $a_list_length =3D (@a_list); # prevent while from dead-loop
> >
> > my $compare_result =3D 0; #equal
> > my $index =3D 0;
> > while ($compare_result =3D=3D 0) {
> > my $compare_result =3D ($a_list[$index] <=3D> $b_list[$index]);
> > if ($compare_result !=3D 0) {
> > return $compare_result;
> > }
> > else {
> > $index ++;
> > }
> >
> > # prevent while from dead-loop
> > if ($index > $a_list_length) {
> > die("sort compare index overflow");
> > }
>
> A lot of this is somewhat cumbersome. IMHO, the fact that it does not
> handle lists of different lengths is a shortcoming.
>
> So, below I including an example which generates a comparison subroutine
> parameterized by the separator you want to use. It handles lists of
> different lengths as well. Given two lists of length m and n with m > n,
> if the lists are identical in the first n elements, it declares the one
> with m elements to be greater than the shorter one.
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> my $separator =3D ";";
>
> my @data_list =3D qw(
> 5;3;7
> 5;3;7;9
> 5;3;7;9;
> 5;3;7;9;10
> 1;5;11
> 11;4;8
> 1;3;9
> 1;3;9
> 1;39;11
> );
>
> my $compare =3D make_comparator(';');
> my @data_sort =3D sort $compare (@data_list);
> {
> local $, =3D "\n";
> print @data_sort;
> }
>
> sub make_comparator {
> my ($separator) =3D shift;
>
> my $rx =3D qr/$separator/;
>
> return sub {
> my @a =3D split $rx, $a;
> my @b =3D split $rx, $b;
>
> while ( @a or @b ) {
> my $ai =3D shift @a;
> my $bi =3D shift @b;
>
> return 1 if defined $ai and not defined $bi;
> return -1 if not defined $ai and defined $bi;
>
> return $ai <=3D> $bi unless $ai =3D=3D $bi;
> }
> return 0; # same number of elements, all equal
> };
> }
Hi Sinan,
Thanks! I have used your upper code, and it run faster than my code!
For I am not familar with map usage, can you recommend some reference
to understand your code below.
Best regards,
Davy
> __END__
>
> Note that the comparison can be expensive. To reduce the number of
> comparisons, you can use "The Schwartzian Transform" (see
> <URL: http://www.stonehenge.com/merlyn/UnixReview/col06.html>).
>
> #!/usr/bin/perl
>
> use strict;
> use warnings;
>
> my $separator =3D ";";
>
> my @data_list =3D qw(
> 5;3;7
> 5;3;7;9
> 5;3;7;9;
> 5;3;7;9;10
> 1;5;11
> 11;4;8
> 1;3;9
> 1;3;9
> 1;39;11
> );
>
> my @data_sort =3D map { $_->[1] }
> sort vector_compare
> map { [ [ split /;/ ], $_ ] }
> @data_list;
> {
> local $, =3D "\n";
> print @data_sort;
> }
>
> sub vector_compare {
> my @a =3D @{ $a->[0] };
> my @b =3D @{ $b->[0] };
>
> while ( @a or @b ) {
> my $ai =3D shift @a;
> my $bi =3D shift @b;
>
> return 1 if defined $ai and not defined $bi;
> return -1 if not defined $ai and defined $bi;
>
> return $ai <=3D> $bi unless $ai =3D=3D $bi;
> }
> return 0; # same number of elements, all equal
> }
>
> __END__
>
> Let's take a look at that
>
> my @data_sort =3D map { $_->[1] }
> sort vector_compare
> map { [ [ split /;/ ], $_ ] }
> @data_list;
>
> Here, for each element of @data_list
>
> map { [ [ split /;/ ], $_ ] } @data_list;
>
> creates a reference to an anonymous array with two elements. The first
> element is a reference to another anonymous array containing the split
> numbers. This is used by the comparison routine. The second element is
> the original string from @data_list. This is used for reconstituting the
> list after sorting is done.
>
> sort vector_compare
>
> sorts this list according to the vector_compare sub above
>
> map { $_->[1] }
>
> then reconstitutes the original array.
>
>
> Sinan
>
> --
> A. Sinan Unur <1usa@llenroc.ude.invalid>
> (remove .invalid and reverse each component for email address)
>
> comp.lang.perl.misc guidelines on the WWW:
> http://augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html
------------------------------
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.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
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 9628
***************************************
