[26722] in Perl-Users-Digest
Perl-Users Digest, Issue: 8816 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sun Jan 1 21:05:24 2006
Date: Sun, 1 Jan 2006 18:05:03 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sun, 1 Jan 2006 Volume: 10 Number: 8816
Today's topics:
Re: any ideas as to why this isn't working? <matthew.garrish@sympatico.ca>
Re: any ideas as to why this isn't working? <noreply@gunnar.cc>
Re: any ideas as to why this isn't working? <matthew.garrish@sympatico.ca>
Re: My Regexp XML Parser -> Structured Perl Data, Cut robic0
Re: Net::FTP can't locate object method "new" <hjs@cadence.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sun, 1 Jan 2006 14:09:06 -0500
From: "Matt Garrish" <matthew.garrish@sympatico.ca>
Subject: Re: any ideas as to why this isn't working?
Message-Id: <iNVtf.133$H37.23096@news20.bellglobal.com>
"Gunnar Hjalmarsson" <noreply@gunnar.cc> wrote in message
news:41qlsiF1g76paU1@individual.net...
> Matt Garrish wrote:
>
> Thanks for the tip, but in that case I'm afraid I failed in finding the
> right place. At http://theoryx5.uwinnipeg.ca/ppms/ I only see a small
> subset of the packages available at ActiveState. Maybe I'm missing
> something...
>
>> (I had no problem downloading and installing all the requirements.)
>
> One package I remember I couldn't find is HTML-Tree.
>
Sure? It should be part of the AS core ditribution:
http://ppm.activestate.com/BuildStatus/5.8.html.
You said that your install failed, and when I ran ppm I had no problems, so
my assumption was that whatever you were missing I was finding in that
repository (being the only other one I have set). I'm not making any claims
that it is more complete, only that whenever I can't find something in an AS
repository I've inevitably been able to find it in the uwinnipeg repository.
Matt
------------------------------
Date: Sun, 01 Jan 2006 20:54:19 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: any ideas as to why this isn't working?
Message-Id: <41qq9kF1fq77hU1@individual.net>
Matt Garrish wrote:
> Gunnar Hjalmarsson wrote:
>>One package I remember I couldn't find is HTML-Tree.
>
> Sure? It should be part of the AS core ditribution:
> http://ppm.activestate.com/BuildStatus/5.8.html.
Uhmm.. I have to admit that my starting point is the IndigoPerl build,
not AS. Maybe this means that I have spotted a difference between them. ;-)
> You said that your install failed, and when I ran ppm I had no problems, so
> my assumption was that whatever you were missing I was finding in that
> repository (being the only other one I have set).
I see. I'm not using the ppm program, but the GUI package manager that
comes with IndigoPerl. Usually that's a very convenient interface...
Sorry for the confusion.
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Sun, 1 Jan 2006 16:59:55 -0500
From: "Matt Garrish" <matthew.garrish@sympatico.ca>
Subject: Re: any ideas as to why this isn't working?
Message-Id: <qhYtf.248$H37.33972@news20.bellglobal.com>
"Gunnar Hjalmarsson" <noreply@gunnar.cc> wrote in message
news:41qq9kF1fq77hU1@individual.net...
> Matt Garrish wrote:
>> Gunnar Hjalmarsson wrote:
>>>One package I remember I couldn't find is HTML-Tree.
>>
>> Sure? It should be part of the AS core ditribution:
>> http://ppm.activestate.com/BuildStatus/5.8.html.
>
> Uhmm.. I have to admit that my starting point is the IndigoPerl build, not
> AS. Maybe this means that I have spotted a difference between them. ;-)
>
>> You said that your install failed, and when I ran ppm I had no problems,
>> so my assumption was that whatever you were missing I was finding in that
>> repository (being the only other one I have set).
>
> I see. I'm not using the ppm program, but the GUI package manager that
> comes with IndigoPerl. Usually that's a very convenient interface...
>
> Sorry for the confusion.
>
Ahh, I saw the AS 5.8 comment and assumed you were both using it. My
mistake... : )
Matt
------------------------------
Date: Sun, 01 Jan 2006 16:01:26 -0800
From: robic0
Subject: Re: My Regexp XML Parser -> Structured Perl Data, Cut & Paste Version, No Module's (Vol I)
Message-Id: <96qgr1p7h24qb3nlg2ng9698pjhcnld01h@4ax.com>
On Tue, 20 Dec 2005 23:59:06 -0800, robic0 wrote:
Final edition .904
This is the last, it will not be continued. Further processing could
have been done for all tag entities and alot of specialized handling.
However due to the recent awareness of the latencies involved in regexp
(re)searches, the "inner" substitution method is not viable in this context.
Thats all I will say on this. Content is not examined for xml reserved
characters (ie: &, etc..), although its easily added. Kind of too bad,
this method has alot of potential.
Anyway, for now its just an exercise in xml/html form and structure.
This status could change in the future as I do a more detailed post-mortum.
Should it change significantly, you won't hear about it in the forums.
I don't anticipate that being the case, but who knows.
-robic0-
Changes:
- Added to regexp, white space to account for <tag />
print <<EOM;
# -----------------------
# XML Regex Parser
# Version .904 - 12/31/05
# Copyright 2005,
# by robic0-At-yahoo.com
# -----------------------
EOM
use strict;
use warnings;
use Data::Dumper;
open DATA, "your.html" or die "can't open your.html...";
my $gabage1 = join ('', <DATA>);
close DATA;
print "here\n";
my @xml_strings = ($gabage1);
my $alt_debug = 0;
my $VERSION = .904;
my $debug = 0;
my $rmv_white_space = 0;
my $ForceArray = 0;
my $KeepRoot = 0;
my $KeepComments = 0;
my $KeepContentOrder = 0;
## -- XML, start & end regexp substitution delimiter chars --
## match side , substitution side
## -------------------------/-------------------------------
my (@S_dlim, @E_dlim);
if ($debug) {
@S_dlim = ('\[' , '['); # use these for debug
@E_dlim = ('\]' , ']');
} else {
@S_dlim = (chr(140) , chr(140)); # use these for production
@E_dlim = (chr(141) , chr(141));
}
## -- Process xml data --
##
for (@xml_strings)
{
#print "\n",'*'x30,"\nXML string:\n",'-'x15,"\n$_\n\nOutput:\n",'-'x15,"\n\n" if ($debug);
if ($alt_debug) {
ProcessAltDebugInfo ($_) ;
print "\n";
}
my $ROOT = {}; # container
my %cdata_elements = ();
my ($last_cnt, $cnt, $i, $attr_error) = (-1, 1, 0, 0);
## Comment/CDATA block ==================================
#### To be done first -
# -- Questionable Comments --
while (s/(<!--(.*?)-->)/$S_dlim[1]$cnt$E_dlim[1]/) {
#print "$cnt = Questionable comment: $1\n" if ($debug);
$ROOT->{$cnt} = $1;
$cnt++;
}
#### To be done second -
# -- Real CDATA --
while (s/<!\[CDATA\[(.*?)\]\]>/$S_dlim[1]$cnt$E_dlim[1]/s)
{
# reconstitute cdata contents
my $cdata_contents = $1;
my $str = '';
while ($cdata_contents =~ s/([^$S_dlim[0]$E_dlim[0]]+)|$S_dlim[0]([\d]+)$E_dlim[0]//) {
if (defined $1) {
$str .= $1;
} elsif (defined $2 && exists $ROOT->{$2}) {
$str .= $ROOT->{$2};
delete $ROOT->{$2};
} else {} # shouldn't get here
}
print "$cnt CDATA = $str\n" if ($debug);
$ROOT->{$cnt} = $str;
$cdata_elements{$cnt} = '';
$cnt++;
}
#### To be done third -
# -- Real Comments are left --
foreach my $key (sort {$a <=> $b} keys %{$ROOT}) {
if (!exists $cdata_elements{$key}) {
$ROOT->{$key} =~ s/^<!--(.*?)-->$/$1/s;
print "$key Comment = $1\n" if ($debug);
if ($KeepComments) {
$ROOT->{$key} = { comment => $1 };
} else {delete $ROOT->{$key};}
}
}
## End Comment/CDATA block ==============================
#### Non-tag markups go here -
####
# -- Versioning -- <?XML-Version ?> - Placeholder, voided
while (s/<\?([^<>]*)\?>//) {
#while (s/<\?([^<>]*)\?>/$S_dlim[1]$cnt$E_dlim[1]/) {
print "$cnt <? ?> = $1\n" if ($debug);
$ROOT->{$cnt} = { 'XMLV' => $1 };
$cnt++;
}
# -- DOCTYPE -- <!DOCTYPE info> - Placeholder, voided
while (s/<!DOCTYPE([^<>]*)>//) {
#while (s/<!DOCTYPE([^<>]*)>/$S_dlim[1]$cnt$E_dlim[1]/) {
print "$cnt DOCTYPE = $1\n" if ($debug);
$ROOT->{$cnt} = { 'DOCTYPE' => $1 };
$cnt++;
}
# -- META -- <META info> - Placeholder, voided
while (s/<META([^<>]*)>//) {
#while (s/<META([^<>]*)>/$S_dlim[1]$cnt$E_dlim[1]/) {
print "$cnt META = $1\n" if ($debug);
$ROOT->{$cnt} = { 'META' => $1 };
$cnt++;
}
#### White space removal before tags ? .. TBD -
if ($rmv_white_space) {
s/>[\s]+</></g;
s/[\s]+</</g;
s/>[\s]+/>/g;
}
#### Tags here - should only need 2 iterations max
my $finished = 0;
while ($cnt != $last_cnt && $i < 20)
{
$last_cnt = $cnt;
## <Tag/> , no content
while (s/<([0-9a-zA-Z]+)[\s]*\/>/$S_dlim[1]$cnt$E_dlim[1]/) {
print "$cnt <$1> = \n" if ($debug);
$ROOT->{$cnt} = { $1 => '' };
$cnt++;
}
## <Tag Attributes/> , no content
while (s/<([0-9a-zA-Z]+)([\s]+[0-9a-zA-Z]+[\s]*=[\s]*["'][^<]*['"])+[\s]*\/>/$S_dlim[1]$cnt$E_dlim[1]/) {
print "$cnt <$1> = attr: $2\n" if ($debug);
my $hattrib = getAttrHash($2);
if (ref($hattrib) ne "HASH") {
print "Invalid token in attribute asignment:\n$hattrib\n"; $attr_error = 1; last;
}
$ROOT->{$cnt} = { $1 => $hattrib };
$cnt++;
}
## <Tag> Content </Tag>
while (s/<([0-9a-zA-Z]+)>([^<]*)<[\s]*\/\1>/$S_dlim[1]$cnt$E_dlim[1]/) {
print "$cnt <$1> = $2\n" if ($debug);
my $unknown = '';
if (length($2) > 0) {
my $hcontent = getContentHash($2, $ROOT, \%cdata_elements);
$unknown = $hcontent;
if (keys (%{$hcontent}) > 1) {
if (!$ForceArray) { adjustForSingleItemArrays ($hcontent); }
} else {
if (exists $hcontent->{'content'}) {
my ($key);
if (!$ForceArray ) {
if (ref($hcontent->{'content'}) eq "ARRAY" && scalar(@{$hcontent->{'content'}}) == 1) {
$unknown = ${$hcontent->{'content'}}[0];
}
else {$unknown = $hcontent->{'content'}; }
}
}
if (!$ForceArray) { adjustForSingleItemArrays ($hcontent); }
}
}
$ROOT->{$cnt} = { $1 => $unknown };
$cnt++;
}
last if ($attr_error);
## <Tag Attributes> Content </Tag>
while (s/<([0-9a-zA-Z]+)([\s]+[0-9a-zA-Z]+[\s]*=[\s]*["'][^<]*['"][\s]*)+[\s]*>([^<]*)<[\s]*\/\1>/$S_dlim[1]$cnt$E_dlim[1]/) {
print "$cnt <$1> = attr: $2, content: $3\n" if ($debug);
my $hattrib = getAttrHash($2);
if (ref($hattrib) ne "HASH") {
print "Invalid token in attribute asignment:\n$hattrib\n"; $attr_error = 1; last;
}
if (length($3) > 0) {
my $hcontent = getContentHash($3, $ROOT, \%cdata_elements);
if (!$ForceArray) { adjustForSingleItemArrays ($hcontent); }
while (my ($key,$val) = each (%{$hcontent})) {
$hattrib->{$key} = $val;
}
}
$ROOT->{$cnt} = { $1 => $hattrib };
$cnt++;
}
last if ($attr_error);
if ($last_cnt != $cnt) {
$i++; print "** End pass $i\n" if ($debug);
} else {
last if ($finished);
## Encapsulate the xml with a "root"
$_ = "<root>$_</root>";
$last_cnt--;
$finished = 1;
}
}
next if ($attr_error);
if (/<|>/) {
print "($i) XML problem: malformed, syntax or tag closure:\n$_";
} else {
print "** Itterations = $i\n".
"** Debug = $debug\n".
"** Rmv white space = $rmv_white_space\n".
"** ForceArray = $ForceArray\n".
"** KeepRoot = $KeepRoot\n".
"** KeepComments = $KeepComments\n".
"** KeepContentOrder = $KeepContentOrder\n";
#print Dumper($ROOT);
print "The remaining string is:\n$_\n\n" if ($debug);
## Strip off the outer element (our root) to
## examine the contents for errors.
## ---------------------------------------
my $outer_element = $cnt-1;
if (exists $ROOT->{$outer_element})
{
my $hroot = $ROOT->{$outer_element};
my ($key,$val) = each (%{$hroot});
my $htodump = $val;
# check for errors in root
if (ref($htodump) ne "HASH" || (!$KeepContentOrder && exists $htodump->{'content'})) {
my $msg = 'Error';
$msg = 'Warning' if ($KeepContentOrder);
print "$msg, bare content at root level ..\n";
} else {
my $dmp_keys = keys (%{$htodump});
if ($dmp_keys > 1) {
print "Warning, multiple elements at root level ..\n";
} else {
($key,$val) = each (%{$htodump});
my $val_type = ref($val);
if ($dmp_keys == 0 || (exists $htodump->{'comment'})) {
print "Warning, no elements at root level ..\n";
}
if ($dmp_keys == 1) {
if ($val_type eq "HASH") {
$htodump = $val if (!$KeepRoot);
}
elsif ($val_type eq "ARRAY") {
$htodump = $val if (!$KeepRoot && $KeepContentOrder);
if (!$ForceArray || scalar(@{$val}) > 1) {
print "Warning, multiple elements at root level ..\n";
}
}
}
}
}
print "\n";
my $tmp = undef;
if (ref($htodump) eq "HASH") {
$tmp = {};
%{$tmp} = %{$htodump};
} elsif (ref($htodump) eq "ARRAY") {
$tmp = [];
@{$tmp} = @{$htodump};
} else {
print "Not a hash or array!\n";
}
print Dumper($tmp) if (defined $tmp);
} else {
print "nothing to output!\n";
}
}
}
##
sub adjustForSingleItemArrays
{
my $href = shift;
## if $val is an array ref and has one element
## set $href->{$key} equal to the element
while (my ($key,$val) = each (%{$href})) {
if (ref($val) eq "ARRAY") {
if (scalar(@{$val}) == 1) {
$href->{$key} = $val->[0];
}
}
}
}
##
sub getAttrHash
{
my $attrstr = shift;
my $ahref = {};
return $ahref unless (defined $attrstr);
while ($attrstr =~ s/[\s]*([0-9a-zA-Z]+)[\s]*=[\s]*("|')([^=]*)\2[\s]*//) {
$ahref->{$1} = $3;
}
if ($attrstr=~/=/) {
$attrstr =~ s/^\s+//s;
$attrstr =~ s/\s+$//s;
return $attrstr
}
return $ahref;
}
##
sub getContentHash
{
my ($contstr,$hStore,$hcdata_elements) = @_;
my $ahref = {};
return $ahref unless (defined $contstr && defined $hStore && defined $hcdata_elements);
my @ary = ();
my $append_flag = 0;
while ($contstr =~ s/^([^<$S_dlim[0]$E_dlim[0]]+)|$S_dlim[0]([\d]+)$E_dlim[0]//s)
{
## -- $1 is text contents --
if (defined $1) {
my $tmp1 = $1;
# if flagged, append it to $ary[last]
if ($append_flag && scalar(@ary) > 0) {
my $size = scalar(@ary);
$ary[$size-1] .= $tmp1;
} else {
push (@ary, $1);
}
$append_flag = 0;
}
## -- $2 is substitution index --
elsif (defined $2) {
## Exist check (Comments stripped?),
# turn on append flag.
# -----------------------------------
if (!exists $hStore->{$2}) {
$append_flag = 1;
next;
}
## CDATA check, append it to $ary[last]
# and turn on append flag.
# ---------------------------------------
if (exists $hcdata_elements->{$2}) {
my $size = scalar(@ary);
if ($size > 0) {
$ary[$size-1] .= $hStore->{$2};
} else {push (@ary, $hStore->{$2});}
$append_flag = 1;
next;
}
$append_flag = 0;
## Substitution of in-line content,
# push it to @ary
# ----------------------------------
if ($KeepContentOrder) {
push (@ary, $hStore->{$2});
next;
}
## Substitution of same level here (normal),
# just store it to $ahref
# -----------------------------------------
my ($key,$val) = each (%{$hStore->{$2}});
if (exists $ahref->{$key}) {
push (@{$ahref->{$key}}, $val);
} else {
$ahref->{$key} = [$val];
}
}
else {} # shouldn't get here
}
# Store contents, strip out
# pure whitespace text elements
my $hary = [];
for (@ary) {
next if (/^\s+$/s);
push (@{$hary}, $_);
}
if (scalar(@{$hary}) > 0) {
$ahref->{'content'} = $hary;
}
## if $val is an array ref and has one element and it
## is a hash ref, set {$key} equal to hash ref
if (!$ForceArray) {
while (my ($key,$val) = each (%{$ahref})) {
if (ref($val) eq "ARRAY") {
if (scalar(@{$val}) == 1 && ref($val->[0]) eq "HASH") {
$ahref->{$key} = $val->[0];
}
}
}
}
return $ahref;
}
sub ProcessAltDebugInfo
{
}
------------------------------
Date: Sun, 01 Jan 2006 11:11:09 -0800
From: Henry Salvia <hjs@cadence.com>
Subject: Re: Net::FTP can't locate object method "new"
Message-Id: <43B8294D.5AF8499E@cadence.com>
Anno Siegel wrote:
>
> Henry Salvia <hjs@cadence.com> wrote in comp.lang.perl.misc:
> > I'm trying to install the libnet module to use Net::FTP and have run
> > into a
> > problem. I've checked out the bug report page for libnet and the only
> > answer the
> > author gave was that the install must not be complete. I did do 2
> > installs, the
> > 1st used a "non-standard" location by running perl Makefile.PL
> > PREFIX=/mypath
> > the 2nd was standard. Both installs passed "make test", and both fail
> > the
> > same way, code and error message below (only the host/login/passwd names
> > were
> > changed to protect the guilty...). And ideas on how to troubleshoot
> > this?
> > Thanks
> >
> > Henry Salvia
> > hjs@cadence.com
> >
> > #!/usr/local/bin/perl
> > use Net::FTP ;
> > use strict ;
> >
> > my $host = "hhh" ;
> > my $login = "lll" ;
> > my $passwd = 'ppp' ;
> > my $dir = "/" ;
> >
> > my $ftp = Net::FTP->new($host) or die "Can't: $@" ;
> >
> > $ftp->login($login, $passwd) or die "Can't login: ", $ftp->message ;
> >
> > $ftp->cwd($dir) ;
> >
> > my $ls = $ftp->ls() ;
> >
> > foreach my $f ( @$ls ) {
> > print "\t($f)\n" ;
> > }
> >
> > $ftp->quit ;
> > marvin.Cadence.COM(hjs)-/mnt4/hjs/CPAN/libnet-1.19 76 > ./spoo
> > Can't locate object method "new" via package "Net::FTP::A" at
> > /usr/local/perl5.0
> > 04/lib/sun4-solaris/5.00401/IO/Socket.pm line 247.
> > marvin.Cadence.COM(hjs)-/mnt4/hjs/CPAN/libnet-1.19 77 >
>
> The path name along which your perl found IO::Socket contains a line
> feed. That is probably not intentional. Also, perl 5.00401 is ancient.
> Something is messed up with your installation.
The line feed is simply cut-and-paste lazyness. The ancient perl is
ancient,
but it works (until now, anyway) with a wide range of modules from CPAN.
And in fact line 11 of Net/FTP.pm says "require 5.001", and I know that
may
have been true in the past but not now...
> It isn't clear what business IO::Socket has calling Net::FTP::A->new,
> but in 5.00401 line 247 in IO/Socket.pm is
>
> my $new = $pkg->new(Timeout => $timeout);
>
> so apparently it does.
> Anno
Yep: that's about where I stopped, I could see that backtracking how it
got
there would take a while, since I didn't see where Net::FTP::A gets
pulled in
in the first place. Thanks for taking a look. I was hoping I wouldn't
have to
know what I'm doing, but... wish me luck.
Henry Salvia.
------------------------------
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 8816
***************************************
