[24264] in Perl-Users-Digest
Perl-Users Digest, Issue: 6455 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Fri Apr 23 18:11:24 2004
Date: Fri, 23 Apr 2004 15:10:09 -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 Fri, 23 Apr 2004 Volume: 10 Number: 6455
Today's topics:
Re: slurp not working? ideas please! <geoffacox@dontspamblueyonder.co.uk>
Re: slurp not working? ideas please! <tassilo.parseval@rwth-aachen.de>
Re: sorting <jtc@shell.dimensional.com>
Re: sorting <andy@andyh.co.uk>
Re: XML::Xerces on Debian *ANYONE* ? On Linux ??? <emschwar@pobox.com>
Re: XML::Xerces on Debian *ANYONE* ? On Linux ??? <gnari@simnet.is>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 23 Apr 2004 20:27:34 GMT
From: Geoff Cox <geoffacox@dontspamblueyonder.co.uk>
Subject: Re: slurp not working? ideas please!
Message-Id: <7eri809119u9nkj1a6qc0gub1237nuk3qb@4ax.com>
On 22 Apr 2004 11:42:17 GMT, "Tassilo v. Parseval"
<tassilo.parseval@rwth-aachen.de> wrote:
>Even if I add a second or third set of data, the order remains intact
>for me.
>
>I still cannot reproduce this. :-)
Tassilo
If I use the code below on the html file called test.htm (contents
below) which is in the d:\a-keep9\short-nondb\oldshort3 folder amd
db.txt (contents below) which is the d:\a-keep9\short-nondb\db
I get
<h2>test first</h2>
<p> ashjk hjk etc first </p>
<h2>test second</h2>
<p> ahsj hk jk etcsecond </p>
followed by the 2 option sections
instead of
<h2>test first</h2>
<p> hdjsadh jkashd jk etc first</p>
<option etc
<h2>test fsecond</h2>
<p> jak jahd jaksd j ksecond </p>
<option etc
Any use?
Cheers
Geoff
------------- test.htm ------------
<html>
<head><title>test</title>
</head>
<body>
<h2> test first </h2>
<p> ahsjdhj akdh hasdj jakhd k ada
dkasdjl akld kajd kl as
aksjd lajksd aldsj first</p>
<option
value="docs/gcse/student-activities/business-location">Business
Location</option>
<h2> test second</h2>
<p> ahdjk ahsdjh ahd
akjdk akld asjd la
adj ajsdk lk second </p>
<option
value="docs/gcse/student-activities/business-location">Business
Location</option>
</body>
</html>
------------------------------ db.txt ----------------------
INSERT INTO total VALUES
('docs/gcse/student-activities/finance','<h3>GCSE Student Activities -
Finance</h3>1. methods of raising finance<br>2. don\'t call them
money<br>3. coloured breakeven point<br>4. The mug activity<br>5.
Cashflow and inflow<br>6. external influences on breakeven<br>7.
balance sheet<br>8. which account will you get me from');
INSERT INTO total VALUES
('docs/gcse/student-activities/marketing','<h3>GCSE Student Activities
- Marketing</h3>1. adverts-activity<br>. demand-and-supply<br>3.
market-research<br>4. market-segments<br>5. product-life-cycle<br>6.
promotions-and-business-objectives<br>7. supply-and-demand-2<br>8.
the-marketing-mix-and-types-of-economy<br>9. the-marketing-mix<br>10.
types-of-market-and-demand-and-supply<br>11.
types-of-ownership-and-the-marketing-mix');
-------------------------------------- the code -------------
package MyParser;
use base qw(HTML::Parser);
use strict;
use diagnostics;
my ($in_heading,$in_p, $fh);
sub register_fh {
# $_[0] contains the parser object
$fh = $_[1];
}
sub reset { ($in_heading,$in_p)=(0,0)}
sub start {
my ( $self, $tagname, $attr, undef, $origtext ) = @_;
if ( $tagname eq 'h2' ) {
$in_heading = 1;
return;
}
if ( $tagname eq 'p' ) {
$in_p = 1;
return;
}
if ( $tagname eq 'option' ) {
print ("\$origtext has value $origtext \n");
main::choice( $attr->{ value } );
}
}
sub end {
my ( $self, $tagname, $origtext ) = @_;
if ( $tagname eq 'h2' ) {
$in_heading = 0;
return;
}
if ( $tagname eq 'p' ) {
$in_p = 0;
return;
}
}
sub text {
my ( $self, $origtext ) = @_;
print $fh "<h2>$origtext</h2> \n" if $in_heading;
print $fh "<p>$origtext</p> \n" if $in_p;
}
package main;
use File::Find;
my $dir = "d:/a-keep9/short-nondb/oldshort3";
my $parser = MyParser->new;
find sub {
return if /^\.\.?/; # catches "." and ".."
my $name = $_;
open( OUT, ">>d:/a-keep9/short-nondb/short/members2/$name" )
|| die "can't open d:/a-keep9/short-nondb/short/members2/$name:
$!";
print OUT ("<html><head><title>test</title>
<link rel=\"STYLESHEET\" type=\"text/css\"
href=\"assets/style/hala-1.css\">
</head><body> \n");
print OUT ("<table width='100%' border='1'> \n");
# undef $/;
$parser->register_fh(\*OUT);
$parser->parse_file($_);
$parser->reset;
print OUT ("</body></html> \n");
}, $dir;
sub choice {
my ($path) = @_;
if ( $path =~ /docs\/btec-first/ ) {
intro($path);
btecfirst($path);
}
elsif ( $path =~ /docs\/aslevel\/classroom-notes/ ) {
intro($path);
aslevelclassroomnotes($path);
}
elsif ( $path =~ /docs\/avce\/assignments/ ) {
intro($path);
avceassignments($path);
}
elsif ( $path =~
/docs\/aslevel\/simulations\/second-severn-bridge/ ) {
intro($path);
aslevelsimulationssevern($path);
}
elsif ( $path =~ /docs\/aslevel\/debates\/wind-farm-debate/ ) {
intro($path);
asleveldebateswindfarm($path);
}
elsif ( $path =~ /docs\/economics\/section1/ ) {
intro($path);
economicssection1($path);
}
elsif ( $path =~ /docs\/economics\/section2/ ) {
intro($path);
economicssection2($path);
}
elsif ( $path =~ /docs\/economics\/section3/ ) {
intro($path);
economicssection3($path);
}
elsif ( $path =~ /docs\/gcse\/classroom-notes/ ) {
intro($path);
gcseclassroomnotes($path);
}
elsif ( $path =~
/docs\/gcse\/student-activities\/games\/ice-lolly/ ) {
intro($path);
gcsegamesicelolly($path);
}
elsif ( ( $path =~ /docs\/gnvq-int\/assignments/ )
&& ( $path !~
/gnvq-int\/assignments\/gnvq-int-write-assignment/ ) )
{
intro($path);
gnvqintassignments($path);
}
elsif ( $path =~ /docs\/vgcse\/course-units/ ) {
intro($path);
vgcsecourseunits($path);
}
elsif ( $path =~
/docs\/gcse\/student-activities\/business-location/ ) {
intro($path);
gcsestudentactivitiesbusinesslocation($path);
}
elsif ( $path =~
/docs\/gcse\/student-activities\/business-structure-decisions/ )
{
intro($path);
gcsestudentactivitiesbusinessstructuredecisions($path);
}
elsif ( $path =~ /docs\/gcse\/student-activities\/finance/ ) {
intro($path);
gcsestudentactivitiesfinance($path);
}
elsif ( $path =~ /docs\/gcse\/student-activities\/marketing/ ) {
intro($path);
gcsestudentactivitiesmarketing($path);
}
elsif ( $path =~ /docs\/gcse\/student-activities\/people-at-work/
) {
intro($path);
gcsestudentactivitiespeopleatwork($path);
}
elsif ( $path =~ /docs\/gcse\/student-activities\/production/ ) {
intro($path);
gcsestudentactivitiesproduction($path);
}
else {
intro($path);
other($path);
}
}
sub intro {
my ($pathhere) = @_;
open( INN, "d:/a-keep9/short-nondb/db/db.txt" );
my $lineintro;
while ( defined( $lineintro = <INN> ) ) {
if ( $lineintro =~ /$pathhere','(.*?)'\)\;/ ) {
print OUT ("<tr><td>$1 <p> </td>\n");
}
}
}
sub btecfirst {
my ($pattern) = @_;
my $linee = $pattern;
my $c = 0;
$linee =~ /.*unit(\d).*?chap(\d)/;
my $u = $1;
my $chap = $2;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d);/ ) {
my $nn = $1;
print OUT ("<td valign='top'>\n");
for ( my $c = 1 ; $c < $nn ; $c++ ) {
print OUT (
'<a href="' . $pattern . "/unit" . $u . "-chap" .
$chap . "-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub aslevelclassroomnotes {
my ($pattern) = @_;
my $c;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
my $line = <INNN>;
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern . "-doc" . $c .
".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub other {
my ($pattern) = @_;
print OUT ("<td valign='top'> \n");
print OUT ( '<a href="' . $pattern . ".zip" . '">'
. "Document"
. "</a><br>"
. "\n" );
print OUT ("</td></tr>\n");
}
sub avceassignments {
my ($pattern) = @_;
print OUT ("<td valign='top'> \n");
print OUT ( '<a href="' . $pattern . ".zip" . '">'
. "Document"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern . "-grid" . ".zip" . '">' .
"Grid"
. "</a><br>"
. "\n" );
print OUT ("</td></tr>\n");
}
sub aslevelsimulationssevern {
my ($pattern) = @_;
print OUT ("<td valign='top'> \n");
print OUT ( '<a href="' . $pattern . ".zip" . '">'
. "Teacher's pack"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern . "-sp" . ".zip" . '">'
. "Student's Pack"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern . "-swb" . ".zip" . '">'
. "Student's Workbook"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern . "-dbp" . ".zip" . '">'
. "Debriefing Pack"
. "</a><br>"
. "\n" );
print OUT ("</td></tr>\n");
}
sub asleveldebateswindfarm {
my ($pattern) = @_;
print OUT ("<td valign='top'> \n");
print OUT ( '<a href="' . $pattern . ".zip" . '">'
. "Teacher's pack"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern
. "-a-company" . ".zip" . '">'
. "Adviser's Pack - Company"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern
. "-a-council" . ".zip" . '">'
. "Adviser's Pack - Council"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern
. "-s-company" . ".zip" . '">'
. "Student's Pack - Company"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern
. "-s-council" . ".zip" . '">'
. "Student's Pack - Council"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern
. "-s-workbook" . ".zip" . '">'
. "Student's Workbook"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern
. "-arbitrator" . ".zip" . '">'
. "Arbitrator's Pack"
. "</a><br>"
. "\n" );
print OUT ("</td></tr>\n");
}
sub economicssection1 {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/section1-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub economicssection2 {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/section2-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub economicssection3 {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/section3-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub gcseclassroomnotes {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern . "-doc" . $c .
".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub gcsegamesicelolly {
my ($pattern) = @_;
print OUT ("<td valign='top'> \n");
print OUT ( '<a href="' . $pattern . ".zip" . '">'
. "Teacher's Pack"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern
. "-runners" . ".zip" . '">'
. "Runner's Pack"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern
. "-adjudicators" . ".zip" . '">'
. "Adjudicator's Pack"
. "</a><br>"
. "\n" );
print OUT ("</td></tr>\n");
}
sub gnvqintassignments {
my ($pattern) = @_;
print OUT ("<td valign='top'> \n");
print OUT ( '<a href="' . $pattern . ".zip" . '">'
. "Document"
. "</a><br>"
. "\n" );
print OUT ( '<a href="' . $pattern . "-grid" . ".zip" . '">' .
"Grid"
. "</a><br>"
. "\n" );
print OUT ("</td></tr>\n");
}
sub vgcsecourseunits {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern . "-chap" . $c .
".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub para {
my ($name) = @_;
my $line;
open( INPARA, "d:/a-keep9/short-nondb/progs/para2/$name" );
undef $/;
$line = <INPARA>;
print OUT ("<tr><td colspan='2'> \n");
print OUT $line;
print OUT ("</td></tr> \n");
$/ = "\n";
}
sub getpara {
local $/ = "\0d\0a";
my ($name) = @_;
my $line;
open( GETPARA, "d:/a-keep9/short-nondb/old-short/$name" );
open( OUTPARA, ">>d:/a-keep9/short-nondb/progs/para2/$name" );
while ( defined( $line = <GETPARA> ) ) {
if ( $line =~ /<p>(.*?)<\/p>/s ) {
print OUTPARA ("$1 \n");
}
}
#close(GETPARA);
#close(OUTPARA);
}
sub gcsestudentactivitiesbusinesslocation {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/location-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub gcsestudentactivitiesbusinessstructuredecisions {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/bsd-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub gcsestudentactivitiesfinance {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/finance-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub gcsestudentactivitiesmarketing {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/marketing-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub gcsestudentactivitiespeopleatwork {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/people-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
sub gcsestudentactivitiesproduction {
my ($pattern) = @_;
my $c = 0;
open( INNN, "d:/a-keep9/short-nondb/allphp/allphp2.php" );
while (<INNN>) {
last if /$pattern/;
}
my ( $curr, $next1, $next2, $next3 ) = <INNN>;
close(INNN);
if ( $next3 =~ /\$i\<(\d+);/ ) {
my $nn = $1;
print OUT ("<td valign='top'> \n");
for ( $c = 1 ; $c < $nn ; $c++ ) {
print OUT ( '<a href="' . $pattern
. "/production-doc"
. $c . ".zip" . '">'
. "Document$c"
. "</a><br>"
. "\n" );
}
print OUT ("</td></tr>\n");
}
}
------------------------------
Date: 23 Apr 2004 21:21:42 GMT
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: slurp not working? ideas please!
Message-Id: <c6c1d6$9s8kp$1@ID-231055.news.uni-berlin.de>
Also sprach Geoff Cox:
> On 22 Apr 2004 11:42:17 GMT, "Tassilo v. Parseval"
><tassilo.parseval@rwth-aachen.de> wrote:
>
>>Even if I add a second or third set of data, the order remains intact
>>for me.
>>
>>I still cannot reproduce this. :-)
>
> Tassilo
>
> If I use the code below on the html file called test.htm (contents
> below) which is in the d:\a-keep9\short-nondb\oldshort3 folder amd
> db.txt (contents below) which is the d:\a-keep9\short-nondb\db
> I get
>
><h2>test first</h2>
><p> ashjk hjk etc first </p>
>
><h2>test second</h2>
><p> ahsj hk jk etcsecond </p>
>
> followed by the 2 option sections
>
> instead of
>
><h2>test first</h2>
><p> hdjsadh jkashd jk etc first</p>
><option etc
>
><h2>test fsecond</h2>
><p> jak jahd jaksd j ksecond </p>
><option etc
>
> Any use?
Hardly. Your script does not print anything option related. How should
it? Please show me the part of your code which is supposed to produce
<option ...>
You'll notice that nothing of that kind exists.
Other than that, you posted far too much code. I usually can't be
bothered to create several directories and files just to realize that
the posted script (which includes many functions that are never called
for the sample data) expects a different directory layout and hence wont
work without manual intervention.
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
------------------------------
Date: 23 Apr 2004 14:54:59 -0600
From: Jim Cochrane <jtc@shell.dimensional.com>
Subject: Re: sorting
Message-Id: <slrnc8j0l3.f5p.jtc@shell.dimensional.com>
In article <c684ol$mj$1@mamenchi.zrz.TU-Berlin.DE>, Anno Siegel wrote:
> Jim Cochrane <jtc@shell.dimensional.com> wrote in comp.lang.perl.misc:
>> In article
>> <c503f366fec576226849e0dabbc15d8d@localhost.talkaboutprogramming.com>,
>> kums wrote:
>> > consider the following numbers
>> > i want to sort the nos as mentioned below
>> > 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 1.10 1.11, 1.12, 1.13, 1.14.
>> >
>> > but computer o/p is like
>> > 1.1,1.11,1.12,1.13,1.14,1.2,1.3,1.4,1.5,1.6,1.7,1.8,1.9
>> > give any idea to sort
>>
>> You appear to want each item sorted according to its left, then its right
>> field (with '.' as the field separator), so the data needs to be treated
>> this way, as having two fields. I've added some extra data (2.1,
>> 2.2, ...) to do a more complete test.
>
> Ah... you seem to have solved the puzzle the OP has given us to guess.
> Pretty slick, making pairs of numbers look like decimals...
>
>> #!/usr/bin/perl
>>
>> use strict;
>> use warnings;
>>
>> my $data = <<EOM
>> 1.2 1.4 2.13 1.5 2.4 1.14 1.10 1.1 2.5 2.11 2.12 1.7 1.12
>> 2.2 2.1 2.3
>> 1.13 1.3 2.6 2.7 1.8 2.8 1.6 2.9 2.10 1.11 1.9
>> EOM
>> ;
>>
>> print "data: $data\n";
>> my @unsorted = split " ", $data;
>> print "unsorted:\n", join(", ", @unsorted), "\n";
>> my @sorted = sort {
>> my ($a1, $a2) = split /\./, $a;
>> my ($b1, $b2) = split /\./, $b;
>> $a1 <=> $b1 || $a2 <=> $b2;
>> } @unsorted;
>> print "sorted:\n", join(", ", @sorted), "\n";
>
> This splits two pairs of numbers each time a comparison is done.
> It practically begs for a Schwartz transform:
>
> my @sorted1 = map join( '.', @$_),
> sort { $a->[ 0] <=> $b->[ 0] or $a->[ 1] <=> $b->[ 1] }
> map [ split /\./, $_], @unsorted;
>
> It even makes the code shorter, which is unusual for a Schwartzian.
>
> Anno
Not bad. It's also faster, as expected, according to this benchmark:
Benchmark: timing 10000 iterations of schwartzian, split...
schwartzian: 6 wallclock secs ( 5.74 usr + 0.00 sys = 5.74 CPU) @ 1742.16/s (n=10000)
split: 11 wallclock secs (11.21 usr + 0.00 sys = 11.21 CPU) @ 892.06/s (n=10000)
--
Jim Cochrane; jtc@dimensional.com
[When responding by email, include the term non-spam in the subject line to
get through my spam filter.]
------------------------------
Date: Fri, 23 Apr 2004 22:29:27 +0100
From: Andy Hassall <andy@andyh.co.uk>
Subject: Re: sorting
Message-Id: <cd2j809dlujmucubutqdpfenhk4creeb8t@4ax.com>
On Wed, 21 Apr 2004 23:23:53 -0400, "kums" <bckumari@yahoo.com> wrote:
>consider the following numbers
>i want to sort the nos as mentioned below
>1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 1.10 1.11, 1.12, 1.13, 1.14.
>
>but computer o/p is like
>1.1,1.11,1.12,1.13,1.14,1.2,1.3,1.4,1.5,1.6,1.7,1.8,1.9
>give any idea to sort
http://search.cpan.org/~edavis/Sort-Versions-1.5/Versions.pm
http://search.cpan.org/~sburke/Sort-Naturally-1.01/Naturally.pm
--
Andy Hassall <andy@andyh.co.uk> / Space: disk usage analysis tool
http://www.andyh.co.uk / http://www.andyhsoftware.co.uk/space
------------------------------
Date: Fri, 23 Apr 2004 12:11:59 -0600
From: Eric Schwartz <emschwar@pobox.com>
Subject: Re: XML::Xerces on Debian *ANYONE* ? On Linux ???
Message-Id: <etok706d0nk.fsf@fc.hp.com>
kj <socyl@987jk.com> writes:
> Has *anyone* succeeded in getting XML::Xerces to run on a Linux
> Debian system? How about on *any* Linux distro at all?
Presumably the maintainer:
$ apt-cache search xerces | grep perl
libxml-xerces-perl - Perl API to Xerces XML parser
If it doesn't work, file a bug.
-=Eric
--
Come to think of it, there are already a million monkeys on a million
typewriters, and Usenet is NOTHING like Shakespeare.
-- Blair Houghton.
------------------------------
Date: Fri, 23 Apr 2004 21:08:46 -0000
From: "gnari" <gnari@simnet.is>
Subject: Re: XML::Xerces on Debian *ANYONE* ? On Linux ???
Message-Id: <c6c0i7$g7v$1@news.simnet.is>
"kj" <socyl@987jk.com> wrote in message
news:c69ne9$nks$1@reader2.panix.com...
>
>
>
> Has *anyone* succeeded in getting XML::Xerces to run on a Linux
> Debian system? How about on *any* Linux distro at all?
>
if you are talking about installation,
did you try apt-get install libxml-xerces-perl ?
otherwise, how about a few detail of your problems?
did you look at the examples under
/usr/share/doc/libxml-xerces-perl/examples ?
gnari
------------------------------
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 6455
***************************************
