[26678] in Perl-Users-Digest
Perl-Users Digest, Issue: 8785 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Wed Dec 21 21:05:30 2005
Date: Wed, 21 Dec 2005 18:05:04 -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 Wed, 21 Dec 2005 Volume: 10 Number: 8785
Today's topics:
Re: getting info from a bash shell script into perl var <rich@newsguy.com>
Re: getting info from a bash shell script into perl var <bob@dont.spam.me>
Re: line-oriented debugger <toddrw69@excite.com>
Re: My Regexp XML Parser -> Structured Perl Data, Cut robic0
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 21 Dec 2005 11:36:09 -0800
From: Rich <rich@newsguy.com>
Subject: Re: getting info from a bash shell script into perl variables
Message-Id: <docar90k4j@drn.newsguy.com>
In article <pan.2005.12.20.18.53.19.931919@dont.spam.me>, Bob says...
>
>Hello,
>
>This is a newbie question.
>
>I have a perl script that needs to set some variables based on the output
>of a bash shell script. I can arrange the output of the shell script to
>whatever works best for perl.
>
>Here is what I have so far:
>
>Output of shell script:
>
> $var1="aaa"; $var2="bbb ccc"; $var3="";
>
>Perl extract:
>
> my $var1; my $var2; my $var3;
> eval `./myscript.sh`;
> print "var1=$var1";
> print "var2=$var2";
> print "var3=$var3";
>
>This always prints:
>
> var1=
> var2=
> var3=
>
>So, am I using eval incorrectly?
>
>Is there a better way to get the output of the shell script onto variables
>(or into an array which I can also work with instead of individual
>variables)?
>
>Bob
>
If you are trying to capture the results of the shell script into an array,
something like this might work
my @results = `./myscript.sh`;
That way you'd have an ordered array, and can use a for loop to look through the
results to find what you needed from the shell script.
Rich
--
Newsguy -- http://newsguy.com
------------------------------
Date: Wed, 21 Dec 2005 20:29:46 GMT
From: Bob <bob@dont.spam.me>
Subject: Re: getting info from a bash shell script into perl variables
Message-Id: <pan.2005.12.21.20.29.46.571824@dont.spam.me>
On Wed, 21 Dec 2005 11:36:09 -0800, Rich wrote:
> If you are trying to capture the results of the shell script into an
> array, something like this might work
>
> my @results = `./myscript.sh`;
>
> That way you'd have an ordered array, and can use a for loop to look
> through the results to find what you needed from the shell script.
>
> Rich
I settled on the following...
chomp(my @my_info=split /\|/, qx{./my_script.sh});
------------------------------
Date: Wed, 21 Dec 2005 21:19:06 GMT
From: "Todd W" <toddrw69@excite.com>
Subject: Re: line-oriented debugger
Message-Id: <eFjqf.40685$tV6.10462@newssvr27.news.prodigy.net>
"Patrick Flaherty" <Patrick_member@newsguy.com> wrote in message
news:doa43n0i67@drn.newsguy.com...
> Hi,
>
> The 'original' debugger. I've looked all over the place and haven't yet
been
> able to answer this question.
>
> I've liked to be able to issue two commands at once (well
one-after-the-other
> from a single cmd line). As in DB<3> below:
>
> DB<2> b 101
> DB<3> c ; p $i
>
> Is this possible?
>
I think so.
Theres probably a way to do it with the 'a' command. Also, dont forget that
you can run any perl code any time you want in the debugger (say you want to
change the value of a variable, or call a method on an object).
So you could change your debugging commands to:
> DB<2> b 101
> DB<3> a 101 print "\$i is $i\n"
and when you hit "c" you will be sitting at your breakpoint with the
variable already pretty printed for you :).
$ cat dbg.pl
use warnings;
use strict;
my $var1 = 'foo';
my $var2 = 'bar';
my $var3 = 'baz';
print("Done\n");
$ perl -d dbg.pl
Loading DB routines from perl5db.pl version 1.28
Editor support available.
Enter h or `h h' for help, or `man perldebug' for more help.
main::(dbg.pl:4): my $var1 = 'foo';
DB<1> a 6 print "\$var2 is: $var2\n"
DB<2> b 6
DB<3> c
main::(dbg.pl:6): my $var3 = 'baz';
$var2 is: bar
DB<3> c
Done
Debugged program terminated. Use q to quit or R to restart,
use O inhibit_exit to avoid stopping after program termination,
h q, h R or h O to get additional info.
Enjoy,
Todd W.
------------------------------
Date: Wed, 21 Dec 2005 17:09:19 -0800
From: robic0
Subject: Re: My Regexp XML Parser -> Structured Perl Data, Cut & Paste Version, No Module's (Vol I)
Message-Id: <cnujq1dnqctqf76squaje4ecsb061gscm7@4ax.com>
On Tue, 20 Dec 2005 23:59:06 -0800, robic0 wrote:
>Posting changes tommorow on this.
>Contact info:
>email: robic0-AT-yahoo.com
>
Alot of bug fixes and modifications.
The first version had many problems.
This is clean version (.9) with options:
ForceArray
Keeproot.
Keepcomments
This works exceptionally well... Let me know
if you try it.
I'm so burned out on this there probably won't
be any updates for along time unless otherwise
if'n I change my mind.
See ya
print <<EOM;
# XML Regex Parser
# Version .9
# 12/21/05
# Copyright 2005,
# by robic0-At-yahoo.com
# -----------------------
EOM
use strict;
use warnings;
use Data::Dumper;
#open DATA, "datafile" or die "can't open datafile...";
#my $gabage1 = <DATA>;
#close DATA;
my $gabage2 = '
<XMLDATA>
<Submission SubmissionID="688904">
<Category CategoryName="Storage/Adapter or Controller">
<Driver FolderName="driver000">
<Language LanguageName="English">
<PackageCreationLocation
FolderName="G:\truyen\WHQL\Athena\raid\driver" />
</Language>
</Driver>
</Category>
</Submission>
</XMLDATA>
';
my $gabage3 = '
<big name="asdf" date="33" >
asdf
<in1>
<!-- howdy folks -->
<in2>jjjj</in2>
<small biz="wefwf" ueue = "second" />
<in3>asbefas</in3>
</in1>
asdfb
</big>
';
my @xml_strings = ($gabage2, $gabage3);
my $VERSION = .9;
my $debug = 0;
my $rmv_white_space = 1;
my $ForceArray = 0;
my $KeepRoot = 0;
my $KeepComments = 1;
## -- XML, start & end regexp substitution delimiter chars --
## match side , substitution side
## -----------------------/-------------------------
my @S_dlim = ('\[' , '['); # use these for reading (debug)
my @E_dlim = ('\]' , ']');
#my @S_dlim = (chr(140) , chr(140)); # use these for production
#my @E_dlim = (chr(141) , chr(141));
for (@xml_strings)
{
print "\n",'='x30,"\n$_\n\n";
if ($rmv_white_space) {
s/>[\s]+</></g;
s/[\s]+</</g;
s/>[\s]+/>/g;
}
my $ROOT = {}; # container
my ($last_cnt, $cnt, $i) = (-1, 1, 0);
# should only need 2 iterations max, but wth
while ($cnt != $last_cnt && $i < 20)
{
$last_cnt = $cnt;
## <?XML-Version ?> , have to check the format of '<?'
while (s/<\?([^<>]*)\?>//i) {} # to void xml
versioning
# while (s/<\?([^<>]*)\?>/$S_dlim[1]$cnt$E_dlim[1]/i) {
print "$cnt <$1> = \n" if ($debug); $cnt++}
## <!-- Comments -->
if (!$KeepComments) {
while (s/<!--([^<>]*)-->//i) {} # to void
comments
} else {
while
(s/<!--([^<>]*)-->/$S_dlim[1]$cnt$E_dlim[1]/i) {
print "$cnt <!-- --> = $1\n" if
($debug);
$ROOT->{$cnt} = { comment => $1 };
$cnt++;
}
# Comments, need to have "anything but <!--
nor --> here" (revisit)
# while
(s/<!--([^(<!--)^(-->)]*)-->/$S_dlim[1]$cnt$E_dlim[1]/i) { print "$cnt
<!-- --> = $1\n" if ($debug); $cnt++}
}
## <Tag/> , no content
while
(s/<([0-9a-zA-Z]+)\/>/$S_dlim[1]$cnt$E_dlim[1]/i) {
print "$cnt <$1> = \n" if ($debug);
$ROOT->{$cnt} = { $1 => '' };
$cnt++;
}
## <Tag Attributes/> , no content
while (s/<([0-9a-zA-Z]+)([ ]+[0-9a-zA-Z]+[ ]*=[
]*"[^<]*")+[ ]*\/>/$S_dlim[1]$cnt$E_dlim[1]/i) {
print "$cnt <$1> = attr: $2\n" if ($debug);
$ROOT->{$cnt} = { $1 => getAttrHash($2) };
$cnt++;
}
## <Tag> Content </Tag>
while
(s/<([0-9a-zA-Z]+)>([^<]*)<\/\1>/$S_dlim[1]$cnt$E_dlim[1]/i) {
print "$cnt <$1> = $2\n" if ($debug);
my $unknown = '';
if (length($2) > 0) {
my $hcontent = getContentHash($2,
$ROOT);
$unknown = $hcontent;
if (keys (%{$hcontent}) > 1) {
if (!$ForceArray) {
adjustForSingleItemArrays ($hcontent); }
} elsif (exists $hcontent->{'content'}
&& scalar(@{$hcontent->{'content'}}) == 1) {
if ($ForceArray ) {
$unknown =
$hcontent->{'content'};
} else {
$unknown =
${$hcontent->{'content'}}[0];
}
}
}
$ROOT->{$cnt} = { $1 => $unknown };
$cnt++;
}
## <Tag Attributes> Content </Tag>
while (s/<([0-9a-zA-Z]+)([ ]+[0-9a-zA-Z]+[ ]*=[
]*"[^<]*")+[ ]*>([^<]*)<\/\1>/$S_dlim[1]$cnt$E_dlim[1]/i) {
print "$cnt <$1> = attr: $2, content: $3\n" if
($debug);
my $hattrib = getAttrHash($2);
if (length($3) > 0) {
my $hcontent = getContentHash($3,
$ROOT);
if (keys (%{$hcontent}) > 1) {
if (!$ForceArray) {
adjustForSingleItemArrays ($hcontent); }
}
while (my ($key,$val) = each
(%{$hcontent})) {
$hattrib->{$key} = $val;
}
}
$ROOT->{$cnt} = { $1 => $hattrib };
$cnt++;
}
if ($last_cnt != $cnt) {
$i++ ; print "** End pass $i\n" if ($debug);
}
}
if (/<|>/) {
print "($i) XML problem: malformed, syntax or tag
closure:\n$_";
} else {
print "\n** Itterations = $i\n** ForceArray =
$ForceArray\n** KeepRoot = $KeepRoot\n** KeepComments =
$KeepComments\n\n";
#print Dumper($ROOT);
my $outer_element = $cnt-1;
if (exists $ROOT->{$outer_element}) {
my $htodump = $ROOT->{$outer_element};
if (!$KeepRoot && keys (%{$htodump}) == 1) {
my ($key,$val) = each (%{$htodump});
$htodump = $val;
}
my $tmp = {};
%{$tmp} = %{$htodump};
print Dumper($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 $attstr = shift;
my $ahref = {};
return $ahref unless (defined $attstr);
while ($attstr =~ s/[ ]*([0-9a-zA-Z]+)[ ]*=[ ]*"([^=]*)"[
]*//i) {
$ahref->{$1} = $2;
}
return $ahref;
}
##
sub getContentHash
{
my ($attstr,$hStore) = @_;
my $ahref = {};
return $ahref unless (defined $attstr && defined $hStore);
my @ary = ();
while ($attstr =~
s/([^<$S_dlim[0]$E_dlim[0]]+)|$S_dlim[0]([\d]+)$E_dlim[0]//i) {
if (defined $1) {
push (@ary, $1);
}
elsif (defined $2 && exists $hStore->{$2}) {
my ($key,$val) = each (%{$hStore->{$2}});
if (exists $ahref->{$key}) {
push (@{$ahref->{$key}}, $val);
} else {
$ahref->{$key} = [$val];
}
}
}
if (scalar(@ary) > 0) { $ahref->{'content'} = [@ary]; }
## 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;
}
__END__
# XML Regex Parser
# Version .9
# 12/21/05
# Copyright 2005,
# by robic0-At-yahoo.com
# -----------------------
==============================
<XMLDATA>
<Submission SubmissionID="688904">
<Category CategoryName="Storage/Adapter or Controller">
<Driver FolderName="driver000">
<Language LanguageName="English">
<PackageCreationLocation
FolderName="G:\truyen\WHQL\Athena\raid\driver" />
</Language>
</Driver>
</Category>
</Submission>
</XMLDATA>
** Itterations = 2
** ForceArray = 0
** KeepRoot = 0
** KeepComments = 1
$VAR1 = {
'Submission' => {
'SubmissionID' => '688904',
'Category' => {
'Driver' => {
'Language'
=> {
'LanguageName' => 'English',
'PackageCreationLocation' => {
'FolderName' => 'G:\\truyen\\WHQL\\Athena\\raid\\driver'
}
},
'FolderName'
=> 'driver000'
},
'CategoryName' =>
'Storage/Adapter or Controller'
}
}
};
==============================
<big name="asdf" date="33" >
asdf
<in1>
<!-- howdy folks -->
<in2>jjjj</in2>
<small biz="wefwf" ueue = "second" />
<in3>asbefas</in3>
</in1>
asdfb
</big>
** Itterations = 1
** ForceArray = 0
** KeepRoot = 0
** KeepComments = 1
$VAR1 = {
'date' => '33',
'name' => 'asdf',
'content' => [
'asdf',
'asdfb'
],
'in1' => {
'small' => {
'ueue' => 'second',
'biz' => 'wefwf'
},
'in2' => 'jjjj',
'comment' => ' howdy folks ',
'in3' => 'asbefas'
}
};
------------------------------
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 8785
***************************************
