[24253] in Perl-Users-Digest
Perl-Users Digest, Issue: 6444 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Apr 22 11:05:58 2004
Date: Thu, 22 Apr 2004 08:05:18 -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 Apr 2004 Volume: 10 Number: 6444
Today's topics:
Re: capturing stderr from windows <for-spammers-only@web.de>
connecting to mysql (user99)
Re: connecting to mysql <noreply@gunnar.cc>
Re: Finding all open filehandles and closing them befor (Anno Siegel)
Re: grepping lines above and below a pattern found <clydenospamorham@nospamorhamgetofftheline.freeservenospamorham.co.uk>
Re: grepping lines above and below a pattern found (Anno Siegel)
Re: grepping lines above and below a pattern found <tadmc@augustmail.com>
Re: grepping lines above and below a pattern found <bmb@ginger.libs.uga.edu>
Re: grepping lines above and below a pattern found <clydenospamorham@nospamorhamgetofftheline.freeservenospamorham.co.uk>
mod_perl, apache <mpapec@yahoo.com>
Re: mod_perl, apache <noreply@gunnar.cc>
Re: Operator overloading (Anno Siegel)
Re: perl -d interfering with program execution? <vetro@online.no>
Re: perl -d interfering with program execution? <Joe.Smith@inwap.com>
Re: perl -d interfering with program execution? <Joe.Smith@inwap.com>
Re: perl -d interfering with program execution? <news**NO_SPAM**@psychogenic.com>
Re: slurp not working? ideas please! <geoffacox@dontspamblueyonder.co.uk>
Re: slurp not working? ideas please! <tassilo.parseval@rwth-aachen.de>
Re: sorting (Anno Siegel)
Re: sorting <uri@stemsystems.com>
Re: Writing dupliactes to database file (Testor)
Re: XML::Xerces questions <shirsch@adelphia.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 22 Apr 2004 09:11:54 +0200
From: Toni Erdmann <for-spammers-only@web.de>
Subject: Re: capturing stderr from windows
Message-Id: <c67r7r$jp8$1@news.mch.sbs.de>
Brian wrote:
> I am using Windows2000. Ah, I did not know precisely what was
> happening with the use of 2>&1, nor did I know you could place it at
> the end. I have been using it with unix and I guess the behavior is
> different.
>
> Thanks for the help! Much appreciated!
Yepp, it depends on the shell. And cmd.exe might behave different.
That's why I use 'cygwin' on Windows. That gives me 'bash' and all
the nice GNU tools.
Toni
------------------------------
Date: 22 Apr 2004 06:12:31 -0700
From: user99@austin.rr.com (user99)
Subject: connecting to mysql
Message-Id: <a16bd472.0404220512.7f650787@posting.google.com>
can't get this script to work. running mysql server on
windows 2000 and i granted all to ''@'localhost'.
any ideas?
#!\perl\bin\perl
use CGI qw(param);
use DBI;
my $action = param("Action");
my $select = param("select");
if ($action eq "Results") {
my $dbh = DBI->connect('DBI:mysql:database01:localhost','','');
if ( not $dbh ) {
$h = "<H1>Bad connect";
} else {
$h = "<H1>Success";
my $sth = $dbh->prepare("select * from votes where name = 'test'");
$sth->execute();
$dbh->disconnect;
}
&printHtml;
------------------------------
Date: Thu, 22 Apr 2004 15:55:58 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: connecting to mysql
Message-Id: <c68j8m$9a3jj$1@ID-184292.news.uni-berlin.de>
user99 wrote:
> can't get this script to work. running mysql server on windows
> 2000 and i granted all to ''@'localhost'.
> any ideas?
Yes, make some debugging efforts, such as capturing the error
message(s). Study the DBI docs for guidance.
"can't get this script to work" is a terribly unappropriate problem
description. You should study the posting guidelines for this group:
http://mail.augustmail.com/~tadmc/clpmisc/clpmisc_guidelines.html
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: 22 Apr 2004 13:22:48 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Finding all open filehandles and closing them before exiting
Message-Id: <c68gv8$975$1@mamenchi.zrz.TU-Berlin.DE>
Vilmos Soti <vilmos@vilmos.org> wrote in comp.lang.perl.misc:
> Hello,
>
> I am trying to find all open filehandles in my program and close
> them before exiting.
>
> Among many things, my program mounts a disk (runs under Linux),
> finds all files with File::Find, then copies the files with
> File::Copy. I use filenames as parameters to copy in order to
> keep my program simple, and also because the manpage for File::Copy
> recommends using filenames wherever possible.
>
> I have a signal handler which tries to unmount the disk in
> the case of a sigint, but it will fail if copy from File::Copy
> has an open filehandle on the mounted disk.
I can see a few possible solutions. Searching stashes for filehandles
is probably the last thing I'd try :)
For one, the signal handler could just set a flag instead of unmounting.
The main loop would check that flag after each copy and umount/exit
if it is set. That way no filehandles from File::Copy are open when
the unmount occurs.
Another possibility (under Unix) is to run "exec umount" instead
of "system umount". Since normal files are closed on exec, that
should do it too.
Finally, you could bite the bullet and use filehandles with File::Copy
and keep track of them. I don't think there are any disadvantages
under Unix.
Anno
------------------------------
Date: Thu, 22 Apr 2004 11:12:52 +0100
From: "Clyde Ingram" <clydenospamorham@nospamorhamgetofftheline.freeservenospamorham.co.uk>
Subject: Re: grepping lines above and below a pattern found
Message-Id: <6TMhc.42$Q57.13@newsfe1-gui.server.ntli.net>
"Tad McClellan" <tadmc@augustmail.com> wrote in message
news:slrnc8dq1m.1t8.tadmc@magna.augustmail.com...
> mike <s99999999s2003@yahoo.com> wrote:
>
> > what is the most commonly used way to print ,say , 2 lines above and 2
> > lines below a certain pattern found such that my output is
> tie my @array, 'Tie::File', $filename, autochomp => 0 or
Nice .. didn't know about this.
The OP might have some use for my inelegant meanderings below, on this
theme.
(Kindly forgive the overlong posting. I expect others have far more elegant
solutions too.)
Trying a "grep" on own source for pattern "[Tt]i." (running on Windoze XPee)
with:
trial_cgrep.pl [Tt]i. 2 trial_cgrep.pl
shows (with "+" marking matched records):
(2) :use warnings;
(3) :use strict;
(4)+:use Tie::File;
(5) :use English;
(6) :
(24) :chomp @file_list;
(25) :
(26)+:die "$nr_lines: nr_lines should be zero or positive integer"
(27) : unless ($nr_lines =~ /^\d+$/);
(28) :
(36) :for my $filename (@file_list) {
(37) :
(38)+: tie my @array, 'Tie::File', $filename, autochomp => 0 or
(39)+: die "could not tie file $!";
(40) :
(41) : # Build a look-up table of record numbers already printed, so that
we
(72) : }
(73) :
(74)+: untie @array;
(75) :}
(76) :
FWIW, the source is below.
Regards,
Clyde
#!/usr/bin/perl
use warnings;
use strict;
use Tie::File;
use English;
my $usage = "$PROGRAM_NAME pattern nr_lines file1 file2 file3 ...";
my $help = "
pattern: Search pattern.
nr_lines: Number of records to show, before and after matching
records.
file1 ...: List of files to search.
";
my $MIN_NR_ARGS_EXPECTED = 3;
my $nr_args_supplied = 0 + @ARGV;
die "Expected at least $MIN_NR_ARGS_EXPECTED arguments. " .
"Got only $nr_args_supplied.\n" .
"Usage: $usage\n$help" unless ($nr_args_supplied >=
$MIN_NR_ARGS_EXPECTED);
my $pattern = shift;
my $nr_lines = shift;
my @file_list = @ARGV;
chomp @file_list;
die "$nr_lines: nr_lines should be zero or positive integer"
unless ($nr_lines =~ /^\d+$/);
foreach (@file_list) {
die "$_: No such readable file"
unless (-r $_);
}
for my $filename (@file_list) {
tie my @array, 'Tie::File', $filename, autochomp => 0 or
die "could not tie file $!";
# Build a look-up table of record numbers already printed, so that we
# do not print the same record twice
my %printed_nr = ();
foreach my $i ( 0 .. $#array ) {
if ($array[$i] =~ /$pattern/) {
for my $j ($i-$nr_lines .. $i+$nr_lines) {
next if $j < 0; # Avoid falling off start of array
next if $j > $#array; # .. and end of array
next if $printed_nr{$j}; # Skip record if already printed
# Prepare print prefix for record being printed
my @prefix_parts = ();
# Omit the filename if only one supplied.
push (@prefix_parts, "$filename ") if (@file_list > 1);
# Record number. e.g. (42)
push (@prefix_parts, "(" . ($j+1) . ")");
# "+" indicator, if this record matches the pattern, else
SPACE
push (@prefix_parts, (($array[$j] =~ $pattern) ? "+" : "
" ));
my $prefix = join("", @prefix_parts) . ":";
print $prefix . $array[$j];
$printed_nr{$j} = 1;
}
}
}
untie @array;
}
ENDS
------------------------------
Date: 22 Apr 2004 11:00:51 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: grepping lines above and below a pattern found
Message-Id: <c688l3$3he$1@mamenchi.zrz.TU-Berlin.DE>
Tad McClellan <tadmc@augustmail.com> wrote in comp.lang.perl.misc:
> mike <s99999999s2003@yahoo.com> wrote:
>
> > say i have this in a text file
> >
> > "Use this form to
> > post your messages.
> > Remember that
> > it can be viewed by
> > millions of people worldwide.
> > For questions about posting,
> > check our FAQ"
> >
> > what is the most commonly used way to print ,say , 2 lines above and 2
> > lines below a certain pattern found such that my output is
> >
> > "post your messages.
> > Remember that
> > it can be viewed by
> > millions of people worldwide.
> > For questions about posting, "
> >
> > for the matched pattern "viewed" .
>
>
> ------------------------------
> #!/usr/bin/perl
> use warnings;
> use strict;
> use Tie::File;
>
> my $filename = 'text.file';
>
> tie my @array, 'Tie::File', $filename, autochomp => 0 or
> die "could not tie file $!";
>
> foreach my $i ( 0 .. $#array ) {
> print @array[ $i-2 .. $i+2 ] if $array[$i] =~ /viewed/;
> }
>
> untie @array;
That's a good way to put Tie::File to use. It doesn't address two
problems that come into view when the basic functionality is there:
- Dealing with matches that are too close to the beginning or end of
the file to fill a whole window
- What to do with overlapping windows
The OP hasn't addressed these issues, and I don't want to suggest
solutions (some have been suggested in this thread). I just want
to point out that this solution, pretty as it is, isn't the whole
story.
Anno
------------------------------
Date: Thu, 22 Apr 2004 07:56:22 -0500
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: grepping lines above and below a pattern found
Message-Id: <slrnc8fg7m.3hj.tadmc@magna.augustmail.com>
Clyde Ingram <clydenospamorham@nospamorhamgetofftheline.freeservenospamorham.co.uk> wrote:
>
> "Tad McClellan" <tadmc@augustmail.com> wrote in message
> news:slrnc8dq1m.1t8.tadmc@magna.augustmail.com...
>> mike <s99999999s2003@yahoo.com> wrote:
>>
>> > what is the most commonly used way to print ,say , 2 lines above and 2
>> > lines below a certain pattern found such that my output is
>
>> tie my @array, 'Tie::File', $filename, autochomp => 0 or
>
> Nice .. didn't know about this.
I knew about it because I re-read the Perl FAQs from time to time. :-)
How do I change one line in a file/
delete a line in a file/
insert a line in the middle of a file/
append to the beginning of a file?
> my $nr_args_supplied = 0 + @ARGV;
^^^
^^^
The LHS already ensures scalar context for @ARGV, so you don't need that.
> my $pattern = shift;
> my $nr_lines = shift;
> my @file_list = @ARGV;
my( $pattern, $nr_lines, @file_list ) = @ARGV;
> chomp @file_list;
You are expecting command line arguments with newlines in them?
> die "$_: No such readable file"
> unless (-r $_);
That should probably be:
die "$_: No such readable file"
unless (-f $_ and -r _);
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Thu, 22 Apr 2004 09:47:32 -0400
From: Brad Baxter <bmb@ginger.libs.uga.edu>
Subject: Re: grepping lines above and below a pattern found
Message-Id: <Pine.A41.4.58.0404220944390.13098@ginger.libs.uga.edu>
On Wed, 21 Apr 2004, Brad Baxter wrote:
>
> perl
> -ne'/viewed/&&($x=$.);push@a,$_;$.>5&&shift@a;$x&&$.-$x>1&&last}{$x&&print@a'
> file
>
> Yes, it diverges from spec 2 lines from the end, but I didn't think
> anybody would care. :-)
It also has a problem with overlapping windows.
perl
-ne'/viewed/&&\!$x&&($x=$.);push@a,$_;$.>5&&shift@a;$x&&$.-$x>1&&last}{$x&&print@a'
file
(\! to hide !$ from the shell ... YMMV)
Brad
------------------------------
Date: Thu, 22 Apr 2004 15:16:14 +0100
From: "Clyde Ingram" <clydenospamorham@nospamorhamgetofftheline.freeservenospamorham.co.uk>
Subject: Re: grepping lines above and below a pattern found
Message-Id: <CrQhc.98$SV6.28@newsfe1-win>
Tad,
> I knew about it because I re-read the Perl FAQs from time to time. :-)
>
> > my $nr_args_supplied = 0 + @ARGV;
> ^^^
> The LHS already ensures scalar context for @ARGV, so you don't need that.
Ah, quite right.
> > my $pattern = shift;
> > my $nr_lines = shift;
> > my @file_list = @ARGV;
>
> my( $pattern, $nr_lines, @file_list ) = @ARGV;
Oh yes . . .
> > chomp @file_list;
>
> You are expecting command line arguments with newlines in them?
Er. . ., no
> > die "$_: No such readable file"
> > unless (-r $_);
>
> That should probably be:
>
> die "$_: No such readable file"
> unless (-f $_ and -r _);
Um, certainly. . .
Thanks for the improvements, Tad.
That was just a quick knock up script. (I did say it was inelegant.)
Always nice to be shot down so constructively.
Regards,
Clyde
------------------------------
Date: Thu, 22 Apr 2004 12:32:20 +0200
From: Matija Papec <mpapec@yahoo.com>
Subject: mod_perl, apache
Message-Id: <oa7f80p1u5u3v97dhh6avcuba7qrgf3lcq@4ax.com>
I would like to change UserID for Apache (1.3.xx) process when it
serves php scripts. I know that Apache 2 has built in support, but I
would like to make quick fix for older version. Is that possible?
Where should I look,
http://search.cpan.org/~gozer/mod_perl-1.29/ ?
------------------------------
Date: Thu, 22 Apr 2004 13:58:39 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: mod_perl, apache
Message-Id: <c68ccj$8vsln$1@ID-184292.news.uni-berlin.de>
Matija Papec wrote:
> I would like to change UserID for Apache (1.3.xx) process when it
> serves php scripts. I know that Apache 2 has built in support, but
> I would like to make quick fix for older version. Is that possible?
>
> Where should I look,
Not in a Usenet group for the Perl programming language.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: 22 Apr 2004 10:25:17 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Operator overloading
Message-Id: <c686id$1ua$1@mamenchi.zrz.TU-Berlin.DE>
Sisyphus <kalinaubears@iinet.net.au> wrote in comp.lang.perl.misc:
> Hi,
>
> I've overloaded the '*' operator and that works as expected - simply
> have the overload subroutine return a new object that holds the value of
> the multiplication.
>
> But I thought that a '*=' overload subroutine would modify in place the
> first argument that the subroutine receives, rather than create a new
> object to be returned. Seems that is not the case - I find the overload
> subroutine must again create a new object that holds the result of the
> multiplication and return that object.
What brought you to that conclusion? It's wrong. The overload routine
must *return* an object, it doesn't have to create it. It is perfectly
free to return its first argument with or without prior modification.
> When I do '$obj *= 11;' all that really needs to be done is have $obj
> modified in place. Instead I find that 'DESTROY($obj)' is being called
> and that the overload function is expected to create and return a
> replacement - which strikes me as being inefficient, especially in a
> tight loop.
Show your code! Your conclusion is wrong, but since you don't say how
you arrived at it, we can't correct it.
Anno
------------------------------
Date: Thu, 22 Apr 2004 10:01:03 +0200
From: Vetle Roeim <vetro@online.no>
Subject: Re: perl -d interfering with program execution?
Message-Id: <m3fzawl9vk.fsf@quimby.dirtyhack.org>
* Pat Deegan
> Greetings,
>
> I originally posted this to 'comp.lang.perl' which, apparently, doesn't
> exist... brilliant...
It shouldn't exist, but for some reason it exists on
groups.google.com. For instance, here's your post on comp.lang.perl:
<URL:http://tinyurl.com/29sms>
I'm confused.
[...]
--
#!/usr/bin/vr
------------------------------
Date: Thu, 22 Apr 2004 08:17:41 GMT
From: Joe Smith <Joe.Smith@inwap.com>
Subject: Re: perl -d interfering with program execution?
Message-Id: <FcLhc.1561$YP5.237389@attbi_s02>
Vetle Roeim wrote:
> * Pat Deegan
>
>>Greetings,
>>
>>I originally posted this to 'comp.lang.perl' which, apparently, doesn't
>>exist... brilliant...
>
> It shouldn't exist, but for some reason it exists on
> groups.google.com.
Google archives everything, including newsgroups that were officially
disbanded many years ago. Too bad Google's USENET web interface
does not warn uninformed users about the folly of using comp.lang.perl.
------------------------------
Date: Thu, 22 Apr 2004 08:21:18 GMT
From: Joe Smith <Joe.Smith@inwap.com>
Subject: Re: perl -d interfering with program execution?
Message-Id: <2gLhc.1147$cF6.96956@attbi_s04>
Pat Deegan wrote:
> I originally posted this to 'comp.lang.perl' which, apparently, doesn't
> exist... brilliant...
Appologies to anyone seeing uncancelled replies to the misunderstanding.
> # extract dbi:driver prefix from $dsn into $1
> $dsn =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i
> or '' =~ /()/; # ensure $1 etc are empty if match fails
> print STDERR "DSN: $dsn\nDriver: '$1'\n"; # <=== output modified DSN
A better way to deal with failed matches is:
$raw_dsn="dbi:foo(bar):xyz";
if (($driver,$dsn) = $raw_dsn =~ /^dbi:(\w*?)(?:\((.*?)\))?:(.*)/i) {
print STDERR "DSN: $dsn\nDriver: '$driver'\n";
} else {
warn "Unable to parse '$raw_dsn'";
$dsn = $raw_dsn; # Hope this is OK
}
-Joe
------------------------------
Date: Thu, 22 Apr 2004 10:16:37 -0400
From: "Pat Deegan" <news**NO_SPAM**@psychogenic.com>
Subject: Re: perl -d interfering with program execution?
Message-Id: <pan.2004.04.22.14.16.36.828402@psychogenic.com>
Greets
On Thu, 22 Apr 2004 08:21:18 +0000, Joe Smith wrote:
> A better way to deal with failed matches is:
[snip]
Cool. The code snippet is from the DBI module though, so I can't do many
permanent mods on that end.
I've isolated the problem a bit better now...
As stated, this regex (from DBI.pm):
/^dbi:(\w*?)(?:\((.*?)\))?:(.*)/i
works fine under normal execution but fails under 'perl -d'. However,
everything works ok under both 'perl' and 'perl -d' if I edit the DBI.pm
file and remove the 'i' modifier, setting the regex to:
/^dbi:(\w*?)(?:\((.*?)\))?:(.*)/
Although this workaround will let me debug my code now without hanging or
aborting (so long as I stick to lower case DSNs for the DBI), I am worried
this behavior will affect other parts of my programs during debugging.
Any clues as to what's going on?
--
Pat Deegan,
http://www.psychogenic.com/
Registered Linux User #128131
------------------------------
Date: Thu, 22 Apr 2004 08:10:49 GMT
From: Geoff Cox <geoffacox@dontspamblueyonder.co.uk>
Subject: Re: slurp not working? ideas please!
Message-Id: <07ve8011151jl8tn7jg3ckojqfq3ffoeuu@4ax.com>
On 22 Apr 2004 06:20:30 GMT, "Tassilo v. Parseval"
<tassilo.parseval@rwth-aachen.de> wrote:
>and run it on
>
> <h2> jkaskdjkla </h2>
> <p> hsajdj ka </p>
> <option values="bla">
>
>the output is the same as the input. Likewise, when I swap <h2> and <p>.
>I don't see where this parser would change anything about the order of
>the tags. It should preserve it.
Tassilo,
The change of order appears if you have a second set of data.
<h2> first - jkaskdjkla </h2>
<p> first - hsajdj ka </p>
<option values="first">
<h2> second - jkaskdjkla </h2>
<p> second - hsajdj ka </p>
<option values="second">
If above results similar to mine, the the 2 <h2> are in the correct
order but are then followed by the 2 <p> sections, then the 2 <option
sections, rather than the order above...?
Cheers
Geoff
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/oldshort2";
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);
}
>
>I remember that main::choice() was this huge 'if/elsif/else' orgy. Can
>you take out all but one branch and also post a few lines of HTML input
>that exhibits this behaviour? I can't say much more right now because I
>cannot reproduce this problem.
>
>Tassilo
------------------------------
Date: 22 Apr 2004 11:42:17 GMT
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: slurp not working? ideas please!
Message-Id: <c68b2p$940du$1@ID-231055.news.uni-berlin.de>
Also sprach Geoff Cox:
> On 22 Apr 2004 06:20:30 GMT, "Tassilo v. Parseval"
><tassilo.parseval@rwth-aachen.de> wrote:
>
>
>>and run it on
>>
>> <h2> jkaskdjkla </h2>
>> <p> hsajdj ka </p>
>> <option values="bla">
>>
>>the output is the same as the input. Likewise, when I swap <h2> and <p>.
>>I don't see where this parser would change anything about the order of
>>the tags. It should preserve it.
>
> Tassilo,
>
> The change of order appears if you have a second set of data.
>
>
> <h2> first - jkaskdjkla </h2>
> <p> first - hsajdj ka </p>
> <option values="first">
>
> <h2> second - jkaskdjkla </h2>
> <p> second - hsajdj ka </p>
> <option values="second">
>
> If above results similar to mine, the the 2 <h2> are in the correct
> order but are then followed by the 2 <p> sections, then the 2 <option
> sections, rather than the order above...?
Which order above? The order above is <h2>, <p> and finally <option>.
Even if I add a second or third set of data, the order remains intact
for me.
I still cannot reproduce this. :-)
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: 22 Apr 2004 09:54:29 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: sorting
Message-Id: <c684ol$mj$1@mamenchi.zrz.TU-Berlin.DE>
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
------------------------------
Date: Thu, 22 Apr 2004 13:19:57 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: sorting
Message-Id: <x7d660kv43.fsf@mail.sysarch.com>
>>>>> "AS" == Anno Siegel <anno4000@lublin.zrz.tu-berlin.de> writes:
>> my @sorted = sort {
>> my ($a1, $a2) = split /\./, $a;
>> my ($b1, $b2) = split /\./, $b;
>> $a1 <=> $b1 || $a2 <=> $b2;
>> } @unsorted;
>> print "sorted:\n", join(", ", @sorted), "\n";
AS> This splits two pairs of numbers each time a comparison is done.
AS> It practically begs for a Schwartz transform:
AS> my @sorted1 = map join( '.', @$_),
AS> sort { $a->[ 0] <=> $b->[ 0] or $a->[ 1] <=> $b->[ 1] }
AS> map [ split /\./, $_], @unsorted;
AS> It even makes the code shorter, which is unusual for a Schwartzian.
and using Sort::Maker (under development) would be like this:
use Sort::Maker ;
my $sorter = make_sorter(
'ST',
number => '/(\d+)/',
number => '/\.(\d+)/',
) ;
my @sorted = $sorter->( @unsorted ) ;
shorter and much clearer. and if the list were very large, it could be
switched to use the GRT like this:
my $sorter = make_sorter(
qw( GRT unsigned ),
number => '/(\d+)/',
number => '/\.(\d+)/',
) ;
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: 22 Apr 2004 07:02:30 -0700
From: extended@operamail.com (Testor)
Subject: Re: Writing dupliactes to database file
Message-Id: <19789ad6.0404220602.1d4f403e@posting.google.com>
Tore Aursand <tore@aursand.no> wrote in message news:<pan.2004.04.21.19.15.19.673731@aursand.no>...
> On Wed, 21 Apr 2004 10:02:44 -0700, Testor wrote:
> > open(DATABASE, ">>bnkrecpts.db") or die "Can't write open file.
> > Reason: $!";
> > seek(DATABASE,0,2);
> > print DATABASE "$myreceipt\n";
> > close(DATABASE);
> >
> > This works OK though not sure if it's the best way because I'm writing
> > duplicate receipt numbers. I tried to use an if statement to make sure
> > is the number exists in the file before writing it but I'm afraid I
> > wasn't successful I did something like:
> >
> > open (THERECEIPT, "bnkrecpts.db") or die "Can't open file. Because:
> > $!";
> > flock(THERECEIPT,2);
> > $receiptnum = <THERECEIPT>;
> > close (THERECEIPT);
> >
> > if ($receiptnum eq $myreceipt) {
> > stop and redirect or print something to the page etc..
> >
> > }
>
> This is partly answered in the Perl FAQ;
>
> perldoc -q duplicate
>
> Anyway. You could take a look at the following code which might help you
> get a clue;
>
> my $filename = 'bnkrecpts.db';
> my $receipt = $query->param('receipt') || '';
>
> if ( $receipt ) {
> my $receipt_exists = 0;
>
> open( THERECEIPT, '<', $filename ) or die "$!\n";
> while ( <THERECEIPT> ) {
> chomp;
> if ( $_ eq $receipt ) {
> $receipt_exists++;
> last;
> }
> }
> close( THERECEIPT );
>
> unless ( $receipt_exists ) {
> open( THERECEIPT, '>>', $filename ) or die "$!\n";
> print THERECEIPT "$receipt\n";
> close( THERECEIPT );
> }
> }
>
> Fill in with file locking etc. as it suits you. The code above is a
> simple example and has not been tested or anything.
>
> Hope it helps, though.
Tore,
Thanks much for the reply, yes "partly" answered, what you gave is
much better than the stu...FAQ which I keep refering to always before
posting, but honestly the info is scarce.
I shall try your code, certainly it looks like I can learn from it and
make it work if it doesn't.
Malcolm,
I got your tip, thanks.
------------------------------
Date: Thu, 22 Apr 2004 07:37:16 -0400
From: "Steven N. Hirsch" <shirsch@adelphia.net>
Subject: Re: XML::Xerces questions
Message-Id: <_IKdnewVsNv7MxrdRVn-hQ@adelphia.com>
pkent wrote:
> One underused (IME) feature of perl >5.005 are exception objects. This
> is where you call die() with an object, not a string. The object then
> ends up in $@ and you can call methods on it to examine the error. While
> this doesn't have Java's stricter model exceptions, it can still help
> out in cases like yours where currently you're just getting an error
> _string_ and you want to parse that string in some way or get other
> information.
XML::Xerces uses exception objects.
------------------------------
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 6444
***************************************
