[24473] in Perl-Users-Digest
Perl-Users Digest, Issue: 6656 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Jun 5 21:05:49 2004
Date: Sat, 5 Jun 2004 18:05:06 -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, 5 Jun 2004 Volume: 10 Number: 6656
Today's topics:
Re: $NF for perl <bmb@ginger.libs.uga.edu>
Re: $NF for perl (dirtWater)
Re: Beginner needs help with script :) nobull@mail.com
Re: Cute bit of Perl to Assign $1,$2 to named variables (Anno Siegel)
Re: Escaping single quotes with sql nobull@mail.com
Re: installing modules on shared server continued <Joe.Smith@inwap.com>
Re: Memory problem with XML::DOM::Parser??? <markus.mohr@mazimoi.de>
Re: My Example - Regex for "not any words(lines) precee <Joe.Smith@inwap.com>
Re: Parsing a text file..... <Joe.Smith@inwap.com>
Re: perl style and returning from function? <troc@pobox.com>
Prototype mismatch: sub main::head vs ($) at ... <aaron@deloachcorp.com>
Re: Prototype mismatch: sub main::head vs ($) at ... (Anno Siegel)
Re: Prototype mismatch: sub main::head vs ($) at ... <usenet@morrow.me.uk>
Putting 3 scalars at a time into an array <null@example.net>
Re: regexp problem in perl 5.6.1 and 5.8.4 (Anno Siegel)
Re: Using LWP to get last modified date of web page <Joe.Smith@inwap.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 5 Jun 2004 18:56:35 -0400
From: Brad Baxter <bmb@ginger.libs.uga.edu>
Subject: Re: $NF for perl
Message-Id: <Pine.A41.4.58.0406051847200.7498@ginger.libs.uga.edu>
On Sat, 5 Jun 2004, Walter Roberson wrote:
>
> If what you want to get out is *just* the number of fields, then
> just ensure that you are in a list conext at the point the split
> is evaluated, and then scalar() that context.
>
> A couple of months ago, I saw someone here use an idiom about that.
> It was something *like*
>
> my $number_of_fields = scalar( () = split ... )
>
> The assignment to () provided the list context.
And the assignment to $n... provides the scalar context, so scalar() isn't
needed. There are good reasons not to use scalar() when it isn't needed.
my $number_of_fields = () = split ...
Regards,
Brad
------------------------------
Date: 5 Jun 2004 17:39:04 -0700
From: cmanning1@mindspring.com (dirtWater)
Subject: Re: $NF for perl
Message-Id: <a748712c.0406051639.7bdc6732@posting.google.com>
Tabe Kooistra <usenet@molen.thuis.net> wrote in message news:<pan.2004.06.05.13.19.32.286128@molen.thuis.net>...
> perldoc split reads:
>
> "In scalar context, returns the number of fields found and
> splits into the @_ array. Use of split in scalar context
> is deprecated, however, because it clobbers your subroutine
> arguments."
>
> perl v5.8.2
>
> somebody has a pointer or a hint to achieve this?
>
> regards,
> Tabe
Is this the type of thing you are after?
!/usr/bin/perl
&mySub('x','x');
&mySub('x','x','x','x');
sub mySub{
$x=$#_;
$y=@_;
print "$x is my last Index and I have $y elements\n";
my(@args)=@_;
print join "\n",@args;
print "\n----\n";
}
[root@localhost root]# perl numSplit
1 is my last Index and I have 2 elements
x
x
----
3 is my last Index and I have 4 elements
x
x
x
x
----
------------------------------
Date: 5 Jun 2004 11:35:23 -0700
From: nobull@mail.com
Subject: Re: Beginner needs help with script :)
Message-Id: <4dafc536.0406051035.3779515b@posting.google.com>
Tad McClellan <tadmc@augustmail.com> wrote in message news:<slrncbn0lg.h80.tadmc@magna.augustmail.com>...
> Player <notachance@inhell.com> wrote:
>
>
> > What I classed as being rude, was and is what any normal person would
> > class,as, 'being rude' in an everyday situation.
>
>
> This is not an everyday situation!
>
> This is Usenet.
Sorry Tad I can't let that go unchallnged.
On entering any new social situation (club, workplace, country) one is
expected to research (or at least try to observe) what is accepted
behaviour. Not doing so would be classed as bein rude by any normal
person.
Usenet is no different at all. We should not give 'Player' the get
out clause of preteding that what he did would not be seen as rude in
the 'real world'.
------------------------------
Date: 5 Jun 2004 19:40:00 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Cute bit of Perl to Assign $1,$2 to named variables
Message-Id: <c9t7ig$b04$1@mamenchi.zrz.TU-Berlin.DE>
J Krugman <jkrugman345@yahbitoo.com> wrote in comp.lang.perl.misc:
> In <jm01c0195sg795e2e3dedtiv9eu2nuqcup@4ax.com> zzapper
> <david@tvis.co.uk> writes:
[...]
> What I'm saying is just that the number of unnecessarily aggressive
> posts seem to me well above average for this type of newsgroup, at
> least in my experience.
>
> In fewer words, people: chill a little.
>
> (Of course, it goes without saying, I'll get roasted for saying
> this.)
No, you won't, but you won't change much either.
The tone in a newsgroup is a function of many variables, being a
group about a programming language is but one. Perl is unusually
popular among a crowd of non-programmers without an interest in
programming. That guarantees a number of posts that deservedly get
short shrift, but it doesn't help the overall tone.
More general parameters are the history of the newsgroup, resident
and visiting trolls, the mix of regulars at any specific time, the
(numeric) relation of questions and question-answerers, and lots more,
impossible to list exhaustively.
The upshoot is, the level of aggressiveness is part of a dynamic balance
of many powers, and rational appeals are doing little to shift that
balance. Greetings from King Canute...
On Usenet, a certain level of aggressiveness seems to go with a healthy,
interesting group. I can't say that I like it myself, but I have
never found it otherwise.
Anno
------------------------------
Date: 5 Jun 2004 11:10:28 -0700
From: nobull@mail.com
Subject: Re: Escaping single quotes with sql
Message-Id: <4dafc536.0406051010.14e7075b@posting.google.com>
Tad McClellan <tadmc@augustmail.com> wrote in message news:<slrncbv8hd.b9e.tadmc@magna.augustmail.com>...
> David K. Wall <dwall@fastmail.fm> wrote:
> > Wilco van der Veer <ghostie2000@hotmail.com> wrote:
>
> >> use DBI();
> >
> > DBI doesn't export anything, so the parentheses are unnecessary.
>
>
> But if the parenthesis are not there, then you have to go find
> out if DBI exports anything or not.
>
> With parens you know right away that nothing is being imported
> without having to go do any research.
>
>
> I'd call using those parens the "good kind" of Lazy. :-)
I have to disagree. Using empty parens on use is like using & on a
function call. It is a way to tell Perl that you want to suppress
part of the normal functionality. It should oly be used on special
occasions. For this reason whenever I see it I am inclined to go off
and do research to figure out what it is that is being avioded.
I'd always stick to:
use DBI;
or
require DBI;
------------------------------
Date: Sat, 05 Jun 2004 19:55:40 GMT
From: Joe Smith <Joe.Smith@inwap.com>
Subject: Re: installing modules on shared server continued
Message-Id: <0zpwc.12599$%F2.3889@attbi_s04>
Derf wrote:
> Ben Morrow <usenet@morrow.me.uk> wrote in
> news:c8bvq8$gfg$1@wisteria.csv.warwick.ac.uk:
>
>>These should be typed into the CPAN shell, which you can get with
>>
>>perl -MCPAN -eshell
>
> Thank you for that! But that command (perl -MCPAN -eshell) says it wants me
> to be root (mkdir /root/.cpan: Permission denied....)
Sounds like whoever installed the CPAN module on the system created
a global MyConfig.pm, which should not be done.
If $HOME/.cpan/CPAN/MyConfig.pm exists, edit it. Otherwise:
unix% mkdir -p .cpan/CPAN
unix% cp /dev/null .cpan/CPAN/MyConfig.pm
unix% perl -MCPAN -e shell
-Joe
------------------------------
Date: Sun, 06 Jun 2004 02:13:02 +0200
From: Markus Mohr <markus.mohr@mazimoi.de>
Subject: Re: Memory problem with XML::DOM::Parser???
Message-Id: <f1o4c012mpukq5in2je9ln3s8o5shp4c81@4ax.com>
On Sat, 5 Jun 2004 14:48:51 +0000 (UTC), Ben Morrow
<usenet@morrow.me.uk> wrote:
>
>Quoth markus.mohr@mazimoi.de:
>> He, everybody,
>>
>> I'm having a big problem when it comes to parsing a large file with
>> the ActiveState XML-DOM 1.43 XML-Parser: It consumes a hell of a lot
>> of memory, raises the CPU of the commputer to 100 % and takes a very
>> long time to handle files of "merely" 500 kB size.
>>
>> Is there any way to speed things up?
>
>I would have a look to see if XML::LibXML2 or XML::Xerces could be used
>instead. Unfortunately their APIs are both different from XML::DOM's,
>but they should be substantially faster. XML::DOM does its DOM
>processing in Perl, based on the callbacks provided by the Expat XML
>parser; the other two libraries parse, build the DOM and manipulate it
>directly in C(++).
>
>Now, what Perl could really do with is a standard DOM API like
>XML::SAX... :)
>
>Ben
Thought so myself, but have no apparent idea on how to use the syntax
correctly. Even reading the book XML & Perl (O'Reilly) did not really
enlightne my brain.
Now, here is the code, and that's prety all I have to master.
Do you think there is anything to do about rwriting this piece of code
for XML::LibXML2?
Sincerely
Markus Mohr
------- Code sample -------
#!/usr/bin/perl -w
#------------------------------------------------------------------------------#
# CFilter.pm
#
#
#
# Modul für die Filter-Funktionen des Client im Zusammenspiel mit
CGUI.pm und #
# CXML.pm
#
#------------------------------------------------------------------------------#
package CFilter;
#------------------------------------------------------------------------------#
# Interne Versionierung
#
#------------------------------------------------------------------------------#
use vars qw/$VERSION $TIMESTAMP/;
# $VERSION = 1.0;
# $TIMESTAMP = 20030321;
# $VERSION = 1.1;
# $TIMESTAMP = 20030627;
# $VERSION = "1.5.4";
# $TIMESTAMP = 20040505;
$VERSION = "1.5.5.build.2";
$TIMESTAMP = 20040604;
#------------------------------------------------------------------------------#
# Laden der internen Module (1)
#
#------------------------------------------------------------------------------#
# XML::DOM ist ein CPAN Modul und existiert in dieser Form nicht auf
# ActiveState fuer die Version 5.8.0, sondern lediglich fuer die
Version 5.6.1.
# Fuer alle Versionen gueltig ist aber die Version auf cpan.perl.org.
# XML::DOM muss auf dem Client-Rechner installiert sein!
# Seit Mai 2004 gibt es auch eine ActiveState-Version 1.43.
use XML::DOM;
#------------------------------------------------------------------------------#
# Laden der externen Module (1)
#
#------------------------------------------------------------------------------#
use CXML;
# Pragmata
use diagnostics;
use strict;
use open ':utf8';
return 1;
#------------------------------------------------------------------------------#
# Subroutine, um eine Anfrage in eine Patientenakte umzuwandeln
#
#------------------------------------------------------------------------------#
sub import_anfrage ($$) {
my ( $self, $anfrage, $konfiguration ) = @_;
print "\nDie ANFRAGE wird imporiert:\n";
print "---------------------------\n";
open( TEMP, ">./anf_temp.anf" );
print TEMP $anfrage;
close TEMP;
# Wir legen ein neues XML-Objekt an, das alte wird verworfen
my $xml = CXML->new();
$xml->construct_xml($konfiguration);
$xml = $konfiguration->get_value('xml');
my $xml_root = $xml->{'root'};
# Die Anfrage wird in ein XML-Dokument geparst
print "Debug: -> Die ANFRAGE wird gePARSt.\n";
my $anfrage_parser = new XML::DOM::Parser( KeepCDATA => 1 );
my $anfrage_doc = $anfrage_parser->parsefile("./anf_temp.anf");
unlink("./anf_temp.anf");
print "Debug: -> Die ANFRAGE ist FERTIG gePARSt.\n";
# Die Anfrage ist Teil der neuen EPA
my $anfrage_root = $anfrage_doc->getElementsByTagName('ANFRAGE');
$anfrage_root = $anfrage_root->item(0);
$anfrage_root->setOwnerDocument( $xml->{'doc'} );
my $nodes = $xml_root->getElementsByTagName('anfragen');
my $node = $nodes->item(0);
$node->appendChild($anfrage_root);
# Anschliessend die Daten der Anfrage in die EPA übertragen
foreach my $type (qw( PATIENT ARZT INSTITUTION UNTERSUCHUNG DIAGNOSE
ANAMNESE MASSNAHME soziomedizinischedaten )) {
my $anfrage = $xml_root->getElementsByTagName('ANFRAGE');
$anfrage = $anfrage->item(0);
for my $element ( $anfrage->getElementsByTagName($type) ) {
my $destination_parent;
SWITCH: for ($type) {
/PATIENT/ && do { $destination_parent = 'patient';
last; };
/ARZT/ && do { $destination_parent = 'arztliste';
last; };
/INSTITUTION/ && do { $destination_parent =
'paramedizinischeliste'; last; };
/UNTERSUCHUNG/ && do { $destination_parent = 'untersuchungen';
last; };
/DIAGNOSE/ && do { $destination_parent = 'diagnosen';
last; };
/ANAMNESE/ && do { $destination_parent = 'anamnesen';
last; };
/MASSNAHME/ && do { $destination_parent = 'massnahmen';
last; };
#/soziomedi/ && do { $destination_parent = $xml_root;
last; };
}
$destination_parent =
$xml_root->getElementsByTagName($destination_parent);
$destination_parent = $destination_parent->item(0);
my $source = $element->cloneNode(1);
$destination_parent = $xml_root if ( $type =~ /soziomed/ );
# print "Vorher:\n",
$destination_parent->toString, "\n";
#print $destination_parent->toString;
#print "\n";
# print "TYPE: $type DP $destination_parent CT ",
$source->toString, "\n";
#print $source->toString;
#print "\n";
$destination_parent->appendChild($source);
$destination_parent->removeChild(
$destination_parent->getElementsByTagName('soziomedizinischedaten')->item(0)
) if ( $type =~ /soziomed/ );
# print "\nJetzt:\n", $destination_parent->toString, "\n";
#print $destination_parent->toString;
#print "\n";
# Bei den Daten des Patienten die alten (= leeren) Daten
entfernen
if ( $type eq 'PATIENT' ) {
my $old_data = $destination_parent->getFirstChild;
$destination_parent->removeChild($old_data);
}
# Altes Element aus der Anfrage entfernen
my $source_parent = $element->getParentNode();
$source_parent->removeChild($element);
}
}
$anfrage_doc->dispose;
return;
}
#------------------------------------------------------------------------------#
# Subroutine, um eine vom Server geholte Antwort einzulesen:
#
# Der ANFRAGEnde holt die Antwort vom ANTWORTenden
#
#------------------------------------------------------------------------------#
sub import_antwort ($$) {
my ( $self, $antwort, $konfiguration ) = @_;
print "\nDie ANTWORT wird importiert:\n";
print "----------------------------\n";
open( TEMP, ">./antwort_temp.ant" );
print TEMP $antwort;
close TEMP;
# Die Antwort wird in ein XML-Dokument geparst
print "Debug: -> Die ANTWORT wird gePARSt.\n";
my $antwort_parser = new XML::DOM::Parser( KeepCDATA => 1 );
my $antwort_doc =
$antwort_parser->parsefile("./antwort_temp.ant");
unlink("./antwort_temp.ant");
print "Debug: -> Die ANTWORT ist FERTIG gePARSt.\n";
# Unser aktuelles lokales Dokument holen
my $xml = $konfiguration->get_value('xml');
my $xml_root = $xml->{'root'};
print "Debug: -> Das aktuelle lokale Dokument wird geholt.\n";
# Daten der Antwort durchsehen
# Patientendaten sind ja bereits enthalten und müssen deshalb nicht
# gesondert nochmal uebernommen werden
foreach my $type (qw(ANAMNESE UNTERSUCHUNG DIAGNOSE MASSNAHME
ANFRAGE)) {
print "Debug: -> ITEM: $type\n";
# Die einzelnen Antwort (Remote) Items durchgehen
REMOTEITEM:
for my $remote_element ( $antwort_doc->getElementsByTagName($type)
) {
my $data = $remote_element->toString;
# ID herausfinden
$data =~ /<id>(\d+)<\/id>/;
my $remote_id = $1;
my $is_new_item = 1;
my $local_parent;
print "Debug: -> Das REMOTE-ELEMENT ID $remote_id ist
vorhanden.\n";
# Gibt es überhaupt schon entsprechende Items? Wenn nicht, ist
das Item auf
# jeden Fall neu und wird angehängt
my @local_element_node_list =
$xml_root->getElementsByTagName($type);
if ( scalar(@local_element_node_list) eq 0 ) {
#
# Es gibt keine lokalen Items
#
print "Debug: -> Es gibt keine lokalen ITEMs (= NO LOCAL).\n";
my $parent_tag = lc($type) . "en";
$local_parent =
$xml_root->getElementsByTagName($parent_tag)->item(0);
&attach_item( $xml, $type, $remote_element, $local_parent ) if
$local_parent;
next REMOTEITEM;
}
else {
#
# Es gibt lokale Items
#
print "Debug: -> Es gibt lokale ITEMs (= LOCAL).\n";
# Die lokalen Items einzeln durchgehen und checken
for my $local_element (@local_element_node_list) {
my $local_data = $local_element->toString;
# Lokale ID herausfinden
$local_data =~ /<id>(\d+)<\/id>/;
my $local_id = $1;
# Und das Parent-Element bestimmen
$local_parent = $local_element->getParentNode;
# Stimmt die lokale ID mit der remote ID überein?
if ( $local_id eq $remote_id ) {
#
# Die IDs stimmen ueberein
#
print "Debug: -> Die IDs stimmen \x84berein (= ID
MATCH).\n";
# Prüfen ob der Inhalt abweicht
if ( $local_data ne $data ) {
#
# Der Inhalt weicht ab
#
print "Debug: -> Der Inhalt stimmt nicht \x84berein (=
CONTENT MISMATCH).\n";
# Ueberpruefen, wer der Ersteller ist (arztid)
$data =~ /<arztid>(\d+)<\/arztid>/;
my $remote_arztid = $1;
$local_data =~ /<arztid>(\d+)<\/arztid>/;
my $local_arztid = $1;
if ( $remote_arztid eq $local_arztid ) {
#
# Der Ersteller ist der gleiche - Item wurde
veraendert
#
# Deklaration des Anfragezeitpunktes
foreach my $type ('anfragezeitpunkt') {
print "Debug: -> ITEM: $type\n";
# Die einzelnen Antwort (Remote) Items durchgehen
REMOTEITEM:
for my $remote_element (
$antwort_doc->getElementsByTagName($type) ) {
#my $data = $remote_element->toString;
my $anf_time = $remote_element->toString;
$anf_time =~ s/.*<anfragezeitpunkt>//g;
$anf_time =~ s/<\/anfragezeitpunkt>.*//g;
$anf_time =~ s/<//g;
$anf_time =~ s/>//g;
$anf_time =~ s/\///g;
$anf_time =~ s/]]//g;
$anf_time =~ s/ /\n/g; #
<Return-Taste>
$anf_time =~ s/	/ /g; #
<Tab-Taste>
# Deklaration des Antwortzeitpunktes
foreach my $type ('antwortzeitpunkt') {
# Die einzelnen Antwort (Remote) Items
durchgehen
REMOTEITEM:
for my $remote_element (
$antwort_doc->getElementsByTagName($type) ) {
my $antw_time = $remote_element->toString;
$antw_time =~ s/.*<antwortzeitpunkt>//g;
$antw_time =~ s/<\/antwortzeitpunkt>.*//g;
$antw_time =~ s/<//g;
$antw_time =~ s/>//g;
$antw_time =~ s/\///g;
$antw_time =~ s/]]//g;
$antw_time =~ s/ /\n/g; #
<Return-Taste>
$antw_time =~ s/	/ /g; #
<Tab-Taste>
# Online-Display der Daten der Anfrage
$local_data =~ s/.*?<anfragetext>/Die Anfrage
wurde erstellt am $anf_time.\n\n/g;
$local_data =~ s/<\/anfragetext>.*//g;
$local_data =~ s/.*ANFRAGE//g;
$local_data =~ s/ANFRAGE.*?//g;
$local_data =~ s/<//g;
$local_data =~ s/>//g;
$local_data =~ s/\///g;
$local_data =~ s/!\[CDATA\[//g;
$local_data =~ s/]]//g;
$local_data =~ s/ /\n/g;
# <Return-Taste>
$local_data =~ s/	/ /g;
# <Tab-Taste>
# Online-Display der Daten der Antwort
$data =~ s/.*?<antworttext>/Die Antwort wurde
erstellt am $antw_time.\n\n/g;
$data =~ s/<\/antworttext>.*//g;
$data =~ s/.*ANFRAGE/Es wurde kein Antworttext
angegeben.\n\n/g;
$data =~ s/ANFRAGE.*?//g;
$data =~ s/<//g;
$data =~ s/>//g;
$data =~ s/\///g;
$data =~ s/!\[CDATA\[//g;
$data =~ s/]]//g;
$data =~ s/ /\n/g;
# <Return-Taste>
$data =~ s/	/ /g;
# <Tab-Taste>
}
}
}
}
print "Debug: -> Die Ersteller sind identisch - das
ITEM wurde ver\x84ndert (= CREATOR MATCH).\n";
# Zur Pruefung vorlegen und den Benutzer entscheiden
lassen,
# ob die Aenderungen angenommen werden
print "Debug: -> Benutzerentscheidung auf Akzeptanz
der \x8enderungen (= CREATE ACCEPT WINDOW).\n";
CGUI->create_accept( substr( $data, 0, 1000 ), substr(
$local_data, 0, 1000 ), $konfiguration, \$is_new_item );
print "Debug: -> SOLL $is_new_item.\n";
# $is_new_item ist 2 wenn der Benutzer die Änderungen
als neues Item möchte
# $is_new_item ist 1 wenn der Benutzer die Änderungen
akzeptiert
# $is_new_item ist 0 wenn der Benutzer die Änderungen
ablehnt
if ( $is_new_item eq 0 ) { next REMOTEITEM; }
elsif ( $is_new_item eq 1 ) {
$local_parent->removeChild($local_element); &attach_item( $xml, $type,
$remote_element, $local_parent ); }
elsif ( $is_new_item eq 2 ) { &attach_item( $xml,
$type, $remote_element, $local_parent ); }
}
else {
#
# Ersteller sind nicht identisch
#
print "Debug: -> Die Ersteller sind nicht identisch (=
CREATOR MISMATCH).\n";
# Item wurde parallel erstellt - in lokale Akte
übernehmen
&attach_item( $xml, $type, $remote_element,
$local_parent );
} # ENDIF Prüfung ArztID
}
else {
#
# Die Inhalte stimmen überein, Item ist unverändert -
keine Aktion nötig
#
print "Debug: -> Die Inhalte sind identisch - das ITEM
ist unver\x84ndert (= CONTENT MATCH).\n";
next REMOTEITEM;
} # ENDIF Prüfung Inhaltsgleichheit
} # ENDIF Prüfung ID-Gleichheit
print "Debug: -> Die IDs sind nicht identisch (= ID
MISMATCH).\n";
} # Ende Durchlauf lokaler Items
#
# Alle lokalen Items durchgegangen - Antwort-Item ist neu
#
&attach_item( $xml, $type, $remote_element, $local_parent );
} # ENDIF Lokale Items vorhanden
} # Ende Durchlauf der Items von der Antwort
} # Ende Durchlauf der einzelnen Items
$antwort_doc->dispose;
return 1;
}
------- Code sample -------
I'm sorry most of the comments are in German. The two modules are the
only sources where it comes to using the parsing process:
"Import_anfrage" and "import_antwort". The context is that
sent-to-the-server medical queries containing textual and image
information will have to be processed by the parser for retrieving.
The whole thing is part of a client-server-client teleconsultation
system which enables client 1 to send some query to client 2 over the
server. Client 2 retrieves the data from the server and needs to parse
them, formulates and answer, and client 1, again, has to retrieve the
answer from the server thus needing to parse it again.
------------------------------
Date: Sat, 05 Jun 2004 20:09:55 GMT
From: Joe Smith <Joe.Smith@inwap.com>
Subject: Re: My Example - Regex for "not any words(lines) preceeded by spaces"
Message-Id: <nMpwc.55083$Ly.1770@attbi_s01>
Josef Moellers wrote:
> Paul Lalli wrote:
>> perl -ne 'print if /^\S/' a.out
>
> Nitpicking (and showing that TMTOWTDI):
> Your solution does not meet the specs of the OP either:
>
> perl -ne 'print unless /^\s+/' file
There is no difference in output between
perl -ne 'print unless /^\s+/' file
and
perl -ne 'print unless /^\s/' file
Since the latter is the same as
perl -ne 'print if /^\S/' file
so why do you say it 'does not meet the specs'?
-Joe
------------------------------
Date: Sat, 05 Jun 2004 19:25:18 GMT
From: Joe Smith <Joe.Smith@inwap.com>
Subject: Re: Parsing a text file.....
Message-Id: <y6pwc.44608$pt3.38467@attbi_s03>
Ben Morrow wrote:
> It is better to use lexical filehandles than barewords.
> It is better to use real rather than backslashes, even on Win32.
> It is better to make use of the low-precedence logical operators.
> It is better to use meaningful variable names.
> It is better to specify the mode to open the file in.
> It is better to put the filename in the error message.
> It is better not to end die() messages with "\n", as this suppresses
> useful information.
All good advice, except for the last one.
Telling the user which line of the script has an open() statement
is worthless information if the user mistypes the name of a file.
It is better to end die() messages with "\n" for user-caused errors
and leave out the "\n" for programmer or can-not-happen errors.
For instance:
open my $IN, '<', $ARGV[0] or die "cannot open $ARGV[0]: $!\n";
open my $CFG, '<', $CONFIG' or die "cannot open $CONFIG: $!";
opendir my $DIR,'.' or die "opendir(.): !$"; # Can never happen
In other words, tailor the message to the expected audience.
Lots of programmer details when debugging, user-friendly messages
for errors that are expected.
-Joe
------------------------------
Date: Sat, 05 Jun 2004 19:45:26 GMT
From: Rocco Caputo <troc@pobox.com>
Subject: Re: perl style and returning from function?
Message-Id: <slrncc49bi.hdf.troc@eyrie.homenet>
On 4 Jun 2004 21:34:24 -0700, Bill wrote:
>
> To clarify, this is a database access function that should modify
> exactly one row. In an error state relative to the intended outcome,
> no rows or more than one row could have been modified.
>
> $rc could be undef, or defined but not one, which would still be an
> error. The function is specified to return a boolean, defined value
> that is 1 if $rc is 1 and false (but defined) otherwise. I guess
> either 0 or '' should work?
# Return true if $rc is 1; false otherwise. The C<$rc &&>
# avoids a warning if $rc is undefined. C<==> has a higher
# precedence than C<&&>, so it's all good.
return($rc && $rc == 1);
-- Rocco Caputo - http://poe.perl.org/
------------------------------
Date: Sat, 5 Jun 2004 15:53:29 -0500
From: "Aaron DeLoach" <aaron@deloachcorp.com>
Subject: Prototype mismatch: sub main::head vs ($) at ...
Message-Id: <stednXsZsdtUr1_dRVn-ig@eatel.net>
The line that produces the error: "Prototype mismatch: sub main::head vs ($)
at line ..." contains a call to the LWP module as follows: "use
LWP::Simple;"
Why am I getting this error in the error log?
------------------------------
Date: 5 Jun 2004 21:16:58 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: Prototype mismatch: sub main::head vs ($) at ...
Message-Id: <c9td8a$dhc$1@mamenchi.zrz.TU-Berlin.DE>
Aaron DeLoach <aaron@deloachcorp.com> wrote in comp.lang.perl.misc:
> The line that produces the error: "Prototype mismatch: sub main::head vs ($)
> at line ..." contains a call to the LWP module as follows: "use
> LWP::Simple;"
>
> Why am I getting this error in the error log?
You have probably defined a function named "head" elsewhere in your
program. When LWP::Simple tries to export its function "head", Perl
reports a clash. Whether the function is defined in your program,
or imported from somewhere else is anyone's guess, since you show
no code.
Anno
------------------------------
Date: Sat, 5 Jun 2004 21:47:23 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: Prototype mismatch: sub main::head vs ($) at ...
Message-Id: <c9tf1b$76b$1@wisteria.csv.warwick.ac.uk>
Quoth anno4000@lublin.zrz.tu-berlin.de (Anno Siegel):
> Aaron DeLoach <aaron@deloachcorp.com> wrote in comp.lang.perl.misc:
> > The line that produces the error: "Prototype mismatch: sub main::head vs ($)
> > at line ..." contains a call to the LWP module as follows: "use
> > LWP::Simple;"
> >
> > Why am I getting this error in the error log?
>
> You have probably defined a function named "head" elsewhere in your
> program. When LWP::Simple tries to export its function "head", Perl
> reports a clash. Whether the function is defined in your program,
> or imported from somewhere else is anyone's guess, since you show
> no code.
Applying PSI::ESP: see the section 'CAVEAT' of perldoc LWP::Simple.
Ben
--
Like all men in Babylon I have been a proconsul; like all, a slave ... During
one lunar year, I have been declared invisible; I shrieked and was not heard,
I stole my bread and was not decapitated.
~ ben@morrow.me.uk ~ Jorge Luis Borges, 'The Babylon Lottery'
------------------------------
Date: Sat, 05 Jun 2004 23:12:11 GMT
From: "Rich Grise" <null@example.net>
Subject: Putting 3 scalars at a time into an array
Message-Id: <frswc.3987$po3.3915@nwrddc03.gnilink.net>
Admittedly, I don't know the terminology well - suffice it to say,
I'm going through a file of the format:
Item1:<discard>Value1<discardthis>
<discard>
<discardItem2<discard>Value2<discard>
<discard>
<discard>Value3<discard>Item3<discard>
Item1:<discard>Value4<discardthis>
<discard>
<discardItem2<discard>Value5<discard>
<discard>
<discard>Value6<discard>Item3<discard>
which are kind of name-value pairs where "ItemX" is a name
and item "ValueX" is a value.
So, I've got it going through the file, picking lines
and building a little array: ($item1value,$item2value,$item3value),
which it printfs.
Now, I can rearrange the printf to put them in any order in
the output, so I could run stdout thru sort and sort by
any field, but then I'd have to rearrange that output
again.
So, obviously, I need to store these 3 items in an array,
like @ITEMS[$count] = ($a,$b,$c); and then increment $count,
is that right? Or would it make more sense to make a hash,
like %ITEMS{"$a"} = ($b,$c); , since in a way, $a is a name
that values $b and $c are associated with. Also, in my
reading, ISTR something about adding items to an array by
just adding them, and let perl take care of indexing, or
was that just hashes? Anyway, I'm reluctant to make a hash,
because can you then sort it on one of the item values? i.e.
sort "%ITEMS{"$a"} = ($b,$c)" on $b?
I guess the simple straightforward, non-arcane, way is:
$count = 0;
while (<>) {
# [get the 3 variables]
@items[$count++] = ($a, $b, $c);
}
But ISTVR something about #items, but don't know where to
look for it, if anyone has any suggestions? Y'know, to make
it more perl-y?
Thanks!
Rich
------------------------------
Date: 5 Jun 2004 22:07:27 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: regexp problem in perl 5.6.1 and 5.8.4
Message-Id: <c9tg6v$fjo$1@mamenchi.zrz.TU-Berlin.DE>
Thomas Stauffer <tstauffer@cas.org> wrote in comp.lang.perl.misc:
> I have done some Perl programming in the past but I am by no means and
> expert. I am currently working on changing some code written some time
> ago by an employee no longer with the company. The code is currently
> running under 5.005.02. I am making changes and adding some ucs2 ->
> utf8 conversion. I want to run the code under Perl 5.8.4 to take
> advantage of Perl's internal Unicode support. At any rate, there is a
> regular expression in the code the works fine under 5.005.02 but loops
> under 5.6.1 and above. Following code illustrates the problem:
>
> $orig_string = 'JKXXAF';
>
> $regex = qr {\G
> # Match as many characters as possible
> # that can be passed thru as-is
> ([^\x00-\xFF]+)
>
> # Then try to match $A1 and next two bytes
> | (@..)
>
> # Otherwise just get the next byte
> | (.)
> }sx;
>
> print "regex = $regex\n";
>
> while ($orig_string =~ /$regex/g) {
> print "\$1=$1\n";
> print "\$2=$2\n";
> print "\$3=$3\n";
> }
>
> The problem seems to be with the use of the \G attribute. If I take it
> out, the regular expression works the same in all versions of Perl.
> However, since I did not write the code and the programmer who did was
> considerably more experienced using Perl than I am, I am hesitant just
> to remove it. Anyhow, I have been looking at this for several days
> without success. My Perl expert suggested I post it to this forum. Any
> help would be greatly appreciated.
The \G is really not needed for the function of the loop. //g in scalar
context makes sure \G is implicitly matched before each match is attempted.
Note that adding \G only anchors the first alternative explicitly,
the second and third are free to match anywhere. One could argue
that scalar //g should still anchor the whole match, so the current
would be a bug. In any case, the behavior in presence of both
/G and //g appears to have changed.
Adding non-capturing parentheses around the alternative fixes the
behavior:
my $regex = qr { \G
(?:
# Match as many characters as possible
# that can be passed thru as-is
([^\x00-\xFF]+)
# Then try to match $A1 and next two bytes
| (@..)
# Otherwise just get the next byte
| (.)
)
}sx;
I'd say you can safely leave it \G off. If you want to keep it, add
the grouping, otherwise it doesn't make much sense.
Anno
------------------------------
Date: Sat, 05 Jun 2004 18:26:29 GMT
From: Joe Smith <Joe.Smith@inwap.com>
Subject: Re: Using LWP to get last modified date of web page
Message-Id: <pfowc.12453$%F2.4033@attbi_s04>
Arvin Portlock wrote:
> I write the following program which works great:
>
> use LWP::UserAgent;
> my $agent = new LWP::UserAgent;
> my $response = $agent->head('http://www.perl.org/about.html');
> print $response->last_modified;
>
> But most other URLs I try don't return a modified date.
That's up to the web page author; it is out of your control.
> Is this because most servers aren't accepting HEAD requests anymore?
A lot of dynamically generated pages (such as ones with banner ads
or table-of-contents links) have no modified date.
> There has to be a way to get the last modifed date
> for a web page. We have crawlers and spiders that do it all
> the time. ... not downloading entire pages but just
> getting the sizes and I'm not sure how to do this with LWP.
Spiders and crawlers download the entire page.
In some cases, the date is the last time it went looking
instead of the file's date.
-Joe
------------------------------
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 6656
***************************************
