[26340] in Perl-Users-Digest
Perl-Users Digest, Issue: 8515 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Oct 12 06:06:23 2005
Date: Wed, 12 Oct 2005 03:05:04 -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 Wed, 12 Oct 2005 Volume: 10 Number: 8515
Today's topics:
Re: getElementsByTagName, tag does not exist robic0@yahoo.com
LWP::UserAgent post to post other than 80 <http://joecosby.com/code/mail.pl>
Re: LWP::UserAgent post to post other than 80 <nobody@bigpond.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Tue, 11 Oct 2005 23:11:25 -0700
From: robic0@yahoo.com
Subject: Re: getElementsByTagName, tag does not exist
Message-Id: <rq6pk15h63vq8m6q19u2hmtkrng73fmm5a@4ax.com>
On Tue, 11 Oct 2005 10:28:01 -0500, hymie_@_lactose.homelinux.net
(hymie!) wrote:
>Greetings. I'm just starting to dabble in XML, and I've run across a
>problem.
>
>I'm going through my XML document using this construct:
>
>use XML::DOM;
>my $parser = new XML::DOM::Parser
> or bail ("Unable to create XML parser");
>my $story = $parser->parse($data);
>$out{"SOURCE"} = $story->getElementsByTagName("Source")->
> item(0)-> getFirstChild->getData;
>$out{"DATE"} = $story->getElementsByTagName("Publication_Date")->
> item(0)-> getFirstChild->getData;
>$out{"TEXT"} = $story->getElementsByTagName("Body_Text")->
> item(0)-> getFirstChild->getData or die "$!";
>
>Everything works fine, until I get to a $story where Body_Text doesn't
>exist. I've looked through all of the XML::DOM docs that I can find,
>but I can't find either a way to test if Body_Text exists, or what happens
>when Body_Text doesn't exist. The script stops with no obvious
>diagnostic output -- it appears that the "die" never happens.
>
>Can somebody show me the light?
>
>hymie! http://www.smart.net/~hymowitz hymie_@_lactose.homelinux.net
>===============================================================================
>I've got an answer. I'm going to fly away. What have I got to lose?
> --Crosby, Stills, and Nash
>===============================================================================
The alternative to DOM is SAX, widely used in modern code.
Its basically a simple event driven model, calling handlers
when the basic structured xml components are encountered. This
allows you to control going from xml to internal data structures
and/or back out to xml. Expat provides hooking handlers to most
of the current W3c constructs. These are just the basic ones.
Its up to you to extract the data into internal structures.
For that XML:Simple is a good tool. With Expat you can accumulate
nested data in a single string. Then Simple will create nested
Perl structures using tag names. Then you can Dumper it.
But, nobody uses Xml that doesen't know ahead of time what those
structures are both out and in. This is a way to control/validate/
populate them. SAX gives you a much simpler model and allows
much better control of the data. If you need more information
let me know. Getting Xerces working is a chore (you could do
without it for now, its only being used for schema checking here).
This code chunk sample is from 7,000 line code I wrote that was
converted
to a binary with Perl2Exe (including Xerces). I've chopped it up,
you can't see or know what it does so it will look nasty but
all the clues are there for you to investigate SAX and thats enough.
-gluck
---
This code is chopped out of a large practical xml code base and is NOT
cut & paste workable. Its just for instructional purposes
for the poster to give a flavor of SAX: Simple Api Xml.
use XML::Xerces;
use XML::Parser::Expat;
use XML::Simple;
## main
{
## Initialize program / build list of xml files (ie: glob)
for (@XmlFiles)
{
/.+$dlimsep(.+)$/; (defined elsewhere for win/unix os)
$XML_File = $1;
Log ($XML_File);
## Validate Schema with Xerces
## note: Xerces is being used for schema validation
and
## as backup xml integrity (done elsewhere)
next if (!ValidateSchema ($_));
if (!open(SAMP, $_)) {
Log (...);
next;
}
## Parse xml and integrity check (Expat-SAX)
my $parser = new XML::Parser::Expat;
$parser->setHandlers('Start' => \&stag_h,
'End' => \&etag_h,
'Char' => \&cdata_h);
$parser->setHandlers('Comment' => \&comment_h) if
($hVars{'CommentLogging'});
eval {$parser->parse(*SAMP)};
if ($@) {
## xml integrity failed -log this error
$@ =~ s/^[\x20\n\t]+//; $@ =~
s/[\x20\n\t]+$//;
# attempt strip off program line,col info at
end
$@ =~ s/(at line [0-9]+,.+)?at .+ line
[0-9]+$/$1/;
Log (...error...);
}
close(SAMP);
$parser->release;
}
}
########################################################
# EXPAT Event Handlers - start/end/content (defaults)
########################################################
##
sub stag_h # -- Start Tag --
{
my ($p, $element, %atts) = @_;
$element = uc($element);
$last_content = '';
$last_syntax_content = '';
## -- construct & Print start tag --
my $tag = "\<$element\>";
if ($XML_PRINT) {
printf ("%3d", $p->current_line);
print get_indent();
print "$tag";
print " Attr" if (keys %atts);
foreach my $key (keys %atts) {
print ", $key=".$atts{$key};
}
print "\n";
}
$tab_lev++;
## -- set Detached special content handler --
if (exists ($Content_hash{$element}) &&
$Content_hash{$element}->[1]) {
$p->setHandlers('Char' =>
$Content_hash{$element}->[0]);
}
## do something with attributes
## start keying (populating) your data structures
## set flags, etc ...
}
##
##
sub etag_h # -- End Tag --
{
my ($p, $element) = @_;
$element = uc($element);
## -- Construct & Print end tag --
my $tag = "\</$element\>";
$tab_lev--;
if ($XML_PRINT) {
printf ("%3d", $p->current_line);
print get_indent();
print "$tag\n";
}
## -- store last Content in hash (do more stuff)
## then:
$last_content = '';
## -- Restore default content handler --
if (exists ($Content_hash{$element}) &&
$Content_hash{$element}->[1]) {
$p->setHandlers('Char' => \&cdata_h);
my $last = (@Action) - 1;
my $aref = $Action[$last];
$Content_hash{$element}->[2]($last_syntax_content,
$aref, $element);
}
}
##
##
sub cdata_h # -- Default Content Data --
{
my ($p, $str) = @_;
# use original for entities, incase reparse
$str = $p->original_string;
# remove leading/trailing space, newline, tab
$str =~ s/^[\x20\n\t]+//; $str =~ s/[\x20\n\t]+$//;
if (length ($str) > 0)
{
if ($XML_PRINT) {
printf ("%3d", $p->current_line);
print get_indent();
print "$str (".length($str).")\n";
}
$last_content .= $str;
}
}
##
##
sub comment_h # -- Default Comment Data --
{
my ($p, $str) = @_;
# use original for entities, incase reparse
$str = $p->original_string;
# remove leading/trailing space, newline, tab
$str =~ s/^[\x20\n\t]+//; $str =~ s/[\x20\n\t]+$//;
if (length ($str) > 0)
{
printf (" %d,%d\n",
$p->current_line,$p->current_column);
}
}
##
##
sub cdata_x_h # -- Special Content Data --
{
my ($p, $str) = @_;
cdata_h ($p, $str);
# remove leading/trailing space, newline, tab
$str =~ s/^[\x20\n\t]+//; $str =~ s/[\x20\n\t]+$//;
$last_syntax_content .= $str if (length ($str) > 0);
}
########################################################
# Xerces - too much to explain
########################################################
#
sub ValidateSchema {
my ($xfile) = @_;
#my $valerr = 0;
# Docs:
http://xml.apache.org/xerces-c/apiDocs/classAbstractDOMParser.html#z869_9
my $Xparser = XML::Xerces::XercesDOMParser->new();
$Xparser->setValidationScheme(1);
$Xparser->setDoNamespaces(1);
$Xparser->setDoSchema(1);
#$Xparser->setValidationSchemaFullChecking(1); # full
constraint (if enabled, may be time-consuming)
$Xparser->setExternalNoNamespaceSchemaLocation($hVdef{'Schema'});
my $ERROR_HANDLER = XLoggingErrorHandler->new(\&LogX_warn,
\&LogX_error, \&LogX_ferror, );
#my $ERROR_HANDLER = XML::Xerces::PerlErrorHandler->new();
$Xparser->setErrorHandler($ERROR_HANDLER);
# no need for eval on parse with handlers.. just insurance on
die
eval {$Xparser->parse
(XML::Xerces::LocalFileInputSource->new($xfile));};
if ($@) {
}
return 1;
}
## handlers (alot more not shown)
------------------------------
Date: Tue, 11 Oct 2005 23:33:10 -0700
From: Zapanaz <http://joecosby.com/code/mail.pl>
Subject: LWP::UserAgent post to post other than 80
Message-Id: <f9bpk190qocpf21j1bt6c7tr7j6opf43nk@4ax.com>
What I am trying to do is post to a cgi script.
The way I am doing it is this:
my $ua = LWP::UserAgent->new();
my $response =
$ua->post("http://1.2.3.4:7775/cgi-local/fm_account.cgi");
where the IP address is a real one and not 1.2.3.4
I know the URL is valid, I can hit it in a web browser, when the code
runs though it hangs.
There are a lot of things that could be going wrong, but one thing I
am not sure of is if I can specify server:port like that with
UserAgent. Should that work? That is, if I am using http, is it
going to assume port 80, and fail to work correctly if it isn't?
Thanks for any help.
--
Zapanaz
International Satanic Conspiracy
Customer Support Specialist
http://joecosby.com/
The victim was pregnant by seeing her picture on a website
featuring her dogs for sale.
------------------------------
Date: Wed, 12 Oct 2005 06:51:11 GMT
From: Gregory Toomey <nobody@bigpond.com>
Subject: Re: LWP::UserAgent post to post other than 80
Message-Id: <434cb25d@news.comindico.com.au>
Zapanaz <http://joecosby.com/code/mail.pl> wrote:
>
> What I am trying to do is post to a cgi script.
>
> The way I am doing it is this:
>
> my $ua = LWP::UserAgent->new();
> my $response =
> $ua->post("http://1.2.3.4:7775/cgi-local/fm_account.cgi");
>
> where the IP address is a real one and not 1.2.3.4
>
> I know the URL is valid, I can hit it in a web browser, when the code
> runs though it hangs.
>
> There are a lot of things that could be going wrong, but one thing I
> am not sure of is if I can specify server:port like that with
> UserAgent. Should that work? That is, if I am using http, is it
> going to assume port 80, and fail to work correctly if it isn't?
>
> Thanks for any help.
That should work. The problem could be with cookies, basic authentication,
or http_referrer.
For testing try wget with the URL.
gtoomey
------------------------------
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 8515
***************************************
