[25655] in Perl-Users-Digest
Perl-Users Digest, Issue: 7897 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Mar 19 03:05:49 2005
Date: Sat, 19 Mar 2005 00:05:14 -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 Sat, 19 Mar 2005 Volume: 10 Number: 7897
Today's topics:
Re: How to use Perl Graph module to solve travel salesp <postmaster@castleamber.com>
Re: HTTP::Cookie won't store sent cookie <noreply@gunnar.cc>
Re: IP address, how? <tintin@invalid.invalid>
Loopback with Device::SerialPort? <emschwar@pobox.com>
No bullshit! no credit card verification! FREE registra rsfew11@yahoo.com
Perl program help to sort of 'pad name xy' file <fordgwf@gmail.com>
Re: Perl program help to sort of 'pad name xy' file <tadmc@augustmail.com>
Re: Perl program help to sort of 'pad name xy' file <jgraber@famous02.dal.design.ti.com>
Re: Perl program help to sort of 'pad name xy' file <fordgwf@gmail.com>
Re: reg expr, extract digit from string. <someone@example.com>
rename and case insensitive filing systems <news@jonripley.com>
Re: rename and case insensitive filing systems <postmaster@castleamber.com>
Re: rename and case insensitive filing systems <andy@andyh.co.uk>
ssh to cisco router with expect CPAN <ewitkop90@hotmail.com>
Re: ssh to cisco router with expect CPAN <nobull@mail.com>
Re: Stumped by eval and scoping problem <see.sig@rochester.rr.com>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: 18 Mar 2005 22:05:03 GMT
From: John Bokma <postmaster@castleamber.com>
Subject: Re: How to use Perl Graph module to solve travel salesperson problem (TSP)?
Message-Id: <Xns961DA39CB64AEcastleamber@130.133.1.4>
Ted Zlatanov wrote:
> On 17 Mar 2005, m.fangtao@genesis.co.nz wrote:
>
>> But how to do it by Perl Graph module?
>
> Read the documentation. This is verbatim from the Graph module's
> documentation. I hope you understand the algorithms involved (read
> about them in an algorithms book or online) instead of just blindly
> using them. Graph programming is 90% algorithms and data structures
> and 10% actual programming :) If you try to just do the programming
> without understanding the theory, it will be hard for you to produce
> good code, even if you use a library such as the Graph module.
>
> "Minimum Spanning Trees (MST)
Which is not TSP. So you are right: one must understand the difference
between TSP and MST before one replies :-D.
The only way to get an exact solution to TSP is measuring each path that
visits each node (each city), and keep the shortest path.
E.g. for n cities, n! steps.
--
John Small Perl scripts: http://johnbokma.com/perl/
Perl programmer available: http://castleamber.com/
Happy Customers: http://castleamber.com/testimonials.html
------------------------------
Date: Sat, 19 Mar 2005 03:11:46 +0100
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: HTTP::Cookie won't store sent cookie
Message-Id: <3a1gteF66427tU1@individual.net>
Richard Lawrence wrote:
> Gunnar Hjalmarsson wrote:
>> Richard Lawrence wrote:
>>> My script requests http://foo.bar.com/ with code that looks a little
>>> like this:
>>
>> <code snipped>
>>
>>> This works great, however the site sends back this:
>>>
>>> Set-Cookie: name=fred; domain=.bar.com; path=/
>>>
>>> which for some reason doesn't get saved in the cookie jar.
>>
>> Have you possibly finished the printing of CGI headers prematurely? If
>> you don't understand what I mean by that, please post a *short* but
>> *complete* script that illustrates the issue.
>
> You're right in the fact that I don't understand :)
Well, I obviously didn't read your question carefully enough, sorry.
Please disregard that remark.
A cookie without a valid expires parameter is not saved to file by
default. That makes perfect sense, since such a cookie is just a session
cookie which automatically expires at end of session. It gets not saved
to disk by browsers either.
Use the "ignore_discard" parameter to still have it saved to file:
my $cookie_jar =
HTTP::Cookies->new(file => $cookie_path, ignore_discard => 1);
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Sat, 19 Mar 2005 15:46:34 +1300
From: "Tintin" <tintin@invalid.invalid>
Subject: Re: IP address, how?
Message-Id: <3a1i4aF65r6r9U1@individual.net>
"warpman" <warpman999@netscape.net> wrote in message
news:1111170260.053444.22820@f14g2000cwb.googlegroups.com...
> I'm new to perl and need some help. I currently have a guestbook that
> when a user posts a message I get the following information.
>
> You have a new entry in your guestbook:
> message text area...
> city, st country - date and time
>
> My question is how do I get the IP address from the person posting the
> message sent to me? Why the IP? Well, because lately I've been getting
> a lot of spam on the guestbook. Any help or information would be
> appreciated.
[OT Answer]
The IP address of the poster should be in your web server logs.
------------------------------
Date: Fri, 18 Mar 2005 12:24:18 -0700
From: Eric Schwartz <emschwar@pobox.com>
Subject: Loopback with Device::SerialPort?
Message-Id: <etobr9g3ggt.fsf@wilson.emschwar>
This is cross-posted to .misc and modules, as I'm not certain where it
belongs. Feel free to redirect the conversation to whichever group
you feel is more appropriate.
I'm trying to verify that I understand how to use Device::SerialPort
on a Linux machine correctly by connecting two serial ports on the
same machine with a crossover serial cable and sending data across the
connection.
The problem is that when the child process in the example below tries
to issue its first read() call, I this this error message:
Error #0 in Device::SerialPort::read at ./testserial line 42
I have no idea what this means, and I can't find any information on
what could cause this sort of error message anywhere in the
Device::SerialPort docs. I'm appending my test program below-- it's
not as small as I'd like, but most of that is the serial port setup
code, which has to be in there (AFAIK).
I've tried changing the code to use lookfor() in the child, with
$port2->are_match($STOP_STRING), but that results in a read of 0 bytes
and no error message.
My code:
#!/usr/bin/perl
use warnings;
use strict;
use Device::SerialPort;
use Digest::MD5 qw(md5_hex);
my $port1 = Device::SerialPort->new("/dev/ttyS1");
my $port2 = Device::SerialPort->new("/dev/ttyS2");
for my $port ($port1, $port2) {
$port->user_msg('ON');
$port->baudrate(115200);
$port->parity("none");
$port->databits(8);
$port->stopbits(1);
$port->handshake('none');
$port->write_settings || undef $port;
}
my $STOP_STRING = "Seriously dude, stop this, like now, even\n";
chomp(my $uname = `uname -r`);
open my $fh, "<", "/boot/vmlinuz-$uname" or die "Can't open kernel file: $!";
if (my $pid = fork) {
$port2->close();
binmode($fh);
my $accum;
while(read($fh, my $buf, 255)) {
$accum .= $buf;
$port1->write($buf);
}
$port1->write($STOP_STRING);
print "In parent, md5sum is: ", md5_hex($accum), "\n";
$port1->close();
waitpid($pid,0);
} else {
die "cannot fork: $!" unless defined $pid;
close($fh);
$port1->close();
my $buf;
while (1) {
my ($count, $line) = $port2->read(255);
next unless $count;
last if $line eq $STOP_STRING;
$buf .= $line;
print "Child read $count bytes, total: ", length $buf , "\n";
}
$port2->close();
print "In child, md5sum is: ", md5_hex($buf), "\n";
exit;
}
__END__
-=Eric
--
Come to think of it, there are already a million monkeys on a million
typewriters, and Usenet is NOTHING like Shakespeare.
-- Blair Houghton.
------------------------------
Date: 18 Mar 2005 22:32:54 -0800
From: rsfew11@yahoo.com
Subject: No bullshit! no credit card verification! FREE registration and earn money NOW!
Message-Id: <1111213974.355615.5160@f14g2000cwb.googlegroups.com>
Join and register this for f*cking $0 COST!
http://quantumgold.com/default.php?id=14715
------------------------------
Date: 18 Mar 2005 11:23:50 -0800
From: "vlsidesign" <fordgwf@gmail.com>
Subject: Perl program help to sort of 'pad name xy' file
Message-Id: <1111173830.604739.81820@l41g2000cwc.googlegroups.com>
-- Looking for ideas to get me going --
I want to 'sort lines of file based on a numeric field of each line'.
I was looking for some ideas on how to approach this.
Basically, each line in the file is in this format:
pad_cell xcoord ycoord label_name
For example,
pad_cell 30 30 vdd
pad_cell 30 1000 vss
pad_cell 30 500 data1
pad_cell 60 30 vdd
pad_cell 500 30 vss
pad_cell 350 30 data2
etc....
Program usage: I am trying to sort a computer chip pad order list in a
file. My sort is basically done by assign top left corner as PAD1 and
going around counter clockwise. Anyway, the file I have is out of order
and I want to sort it.
------------------------------------------------------------------------------
P.S.
I am familiar with basics like split, join, regex (using parenthesis to
retain parts in memory). Anything more exotic needed I am willing to
lookup and study in an Oreilly book or elsewhere. However, I am just on
limited time schedule, and wanted to get good direction first. I
haven't used PERL yet for numeric sorting (I usually use the plan unix
'sort' utility, but I think Perl will better handle this case
------------------------------
Date: Fri, 18 Mar 2005 13:49:00 -0600
From: Tad McClellan <tadmc@augustmail.com>
Subject: Re: Perl program help to sort of 'pad name xy' file
Message-Id: <slrnd3mc5c.28t.tadmc@magna.augustmail.com>
vlsidesign <fordgwf@gmail.com> wrote:
> I want to 'sort lines of file based on a numeric field of each line'.
> I was looking for some ideas on how to approach this.
perldoc -f sort
and
perldoc -q sort
How do I sort an array by (anything)?
How do I sort a hash (optionally by value instead of key)?
How can I always keep my hash sorted?
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 18 Mar 2005 14:16:27 -0600
From: Joel Graber <jgraber@famous02.dal.design.ti.com>
Subject: Re: Perl program help to sort of 'pad name xy' file
Message-Id: <yvnsm2sn204.fsf@famous02.dal.design.ti.com>
"vlsidesign" <fordgwf@gmail.com> writes:
> I want to 'sort lines of file based on a numeric field of each line'.
> I was looking for some ideas on how to approach this.
>
> Basically, each line in the file is in this format:
> pad_cell xcoord ycoord label_name
>
> For example,
> pad_cell 30 30 vdd
> pad_cell 30 1000 vss
> pad_cell 30 500 data1
> pad_cell 60 30 vdd
> pad_cell 500 30 vss
> pad_cell 350 30 data2
> etc....
>
> Program usage: I am trying to sort a computer chip pad order list in a
> file. My sort is basically done by assign top left corner as PAD1 and
> going around counter clockwise. Anyway, the file I have is out of order
> and I want to sort it.
You have a set of randomly ordered x,y coordinates that form the shape of
a square hollow frame, and you want to order them counter clockwise
from upper left corner?
I assume you mean start from the top of the left edge.
One approach I have used in the past for this exact
problem set, is to convert the x,y coordinates into
polar coordinates, and sort by angle from the center.
If you have more than one row of pads per side,
this may not work well in the corners.
The other more generic approach is to partition them into sides,
then sort each side in the correct order,
then concatenate the sides in the correct order.
For numeric sorting see also page 218 "sort numerically"
in the blue camel book.
--
Joel
------------------------------
Date: 18 Mar 2005 19:48:47 -0800
From: "vlsidesign" <fordgwf@gmail.com>
Subject: Re: Perl program help to sort of 'pad name xy' file
Message-Id: <1111204127.135789.203800@l41g2000cwc.googlegroups.com>
Thanks Joel for your response.
Your assumption was correct, I would start from top-left corner. The
pads are not staggered so it sounds like it would work beautifully.
Your suggestion sounds very cool, and clever.
I did a google search and some reading so here goes, sorry if it is
crude and not quite accurate... So if O is the origin (0,0) of my x y
coordinate plane. I can take Pythagorems theorem for the radius r. So
r = to the square root of (x^2 + y^2). Also if v = theta (angle) then
y = r sin v, x = r cos v, y/x=tan v, so v = tan-1(y/x).
Is that correct? I then could sort v (which is the angle) in PERL from
there??
------------------------------
Date: Fri, 18 Mar 2005 21:11:30 GMT
From: "John W. Krahn" <someone@example.com>
Subject: Re: reg expr, extract digit from string.
Message-Id: <6uH_d.70323$fc4.6833@edtnps89>
joel wrote:
>
> I need help with extracting digit from a string.
>
> example:
>
> here is the string i want to split into words and digits.
>
> my $string = "abcd-efgh-ijkl-123.456.789"
>
> i want
>
> $word = "abcd-efgh-ijkl";
>
> and
>
> $digit = "123.456.789";
$ perl -le'
my $string = "abcd-efgh-ijkl-123.456.789";
my ( $word, $digit ) = split /(?<=\D)-(?=\d)/, $string, 2;
print for $word, $digit;
'
abcd-efgh-ijkl
123.456.789
John
--
use Perl;
program
fulfillment
------------------------------
Date: Sat, 12 Mar 2005 07:20:38 GMT
From: "Jon Ripley" <news@jonripley.com>
Subject: rename and case insensitive filing systems
Message-Id: <aLwYd.34605$ug2.4862@fe2.news.blueyonder.co.uk>
I while back I wrote a perl script which recursed through a directory
structure and tidied up any non-preferred file names. It used the standard
rename (oldfile, newfile); approach and I discovered, to my horror, some
very unexpected behaviour when it was run on an operating system with a case
insensitive filing system.
Where filename 'aaa_bbb.ccc.ccc' would be correctly renamed to 'Aaa Bcc.ccc'
on all systems. For cases where only the case of a filename changed - as in
'Aaa bbb.ccc' becoming 'Aaa Bbb.ccc', perl sucessfully deleted all the
files.
It seems that perl was doing:
copy oldfile newfile
delete oldfile
which on a case-insensitive filesystem has the effect of simply deleting
oldfile.
Is this, as it seems to be, standard perl behaviour or is it possible that
it is a piece of very sloppy programming in the particular port I am using?
If copy/delete is standard then there is a *major* data loss causing bug in
perl which needs to be resolved.
(Currently I am manually doing rename old TMP; rename TMP new which is just
a hacky workaround.)
Jon Ripley
--
http://jonripley.com/
Why use CGI::PM, if you can't write secure code then don't bother?
------------------------------
Date: 12 Mar 2005 08:22:10 GMT
From: John Bokma <postmaster@castleamber.com>
Subject: Re: rename and case insensitive filing systems
Message-Id: <Xns9617181A33C10castleamber@130.133.1.4>
Jon Ripley wrote:
[ rename ]
> It seems that perl was doing:
>
> copy oldfile newfile
> delete oldfile
>
> which on a case-insensitive filesystem has the effect of simply
> deleting oldfile.
ls -al index.html
-rw-rw-rw- 1 user group 0 Feb 1 2004 index.html
perl -e "rename('index.html', 'InNdeX.html')"
ls -al InNdeX.html
-rw-rw-rw- 1 user group 0 Feb 1 2004 InNdeX.html
Windows XP, perl, v5.8.3
Which OS, version of Perl, etc.
--
John Small Perl scripts: http://johnbokma.com/perl/
Perl programmer available: http://castleamber.com/
Happy Customers: http://castleamber.com/testimonials.html
------------------------------
Date: Sat, 12 Mar 2005 10:00:10 +0000
From: Andy Hassall <andy@andyh.co.uk>
Subject: Re: rename and case insensitive filing systems
Message-Id: <ove531p37fo1c4369hdadprsr2pff0277c@4ax.com>
On 12 Mar 2005 08:22:10 GMT, John Bokma <postmaster@castleamber.com> wrote:
>Jon Ripley wrote:
>
>[ rename ]
>> It seems that perl was doing:
>>
>> copy oldfile newfile
>> delete oldfile
>>
>> which on a case-insensitive filesystem has the effect of simply
>> deleting oldfile.
>
>ls -al index.html
>-rw-rw-rw- 1 user group 0 Feb 1 2004 index.html
>
>perl -e "rename('index.html', 'InNdeX.html')"
But you've changed the filename now - there's more N's in the second one.
>Windows XP, perl, v5.8.3
G:\temp>dir /b index.html
index.html
G:\temp>perl -e "rename('index.html', 'InDeX.html')"
G:\temp>dir /b index.html
InDeX.html
G:\temp>perl -v
This is perl, v5.8.6 built for MSWin32-x86-multi-thread
(On Windows 2000)
--
Andy Hassall / <andy@andyh.co.uk> / <http://www.andyh.co.uk>
<http://www.andyhsoftware.co.uk/space> Space: disk usage analysis tool
------------------------------
Date: 18 Mar 2005 19:53:27 -0800
From: "erik" <ewitkop90@hotmail.com>
Subject: ssh to cisco router with expect CPAN
Message-Id: <1111204407.912214.256440@f14g2000cwb.googlegroups.com>
I am ultimately trying to make CGI where we can Quality Assure Cisco
routers. My script does log into the router, but I don't think it is
storing in my array. I try to print the array and I get nothing. It
hangs within the check_logging_settings subscript.
(I have the ARGV scalars because I am testing it via command line
rather than the browser. )
But like I said the problem is definitely in teh check_logging_settings
sub script. Any advice would be appreciated.
#!/usr/bin/perl -w
#################################################################
# Global Variables #
#################################################################
use Expect;
use CGI(":standard");
use Term::ANSIColor;
#$device = param("device");
#$username = param("username");
#$password = param("password");
#$enable = "enable";
#$enable_password = param(enable_password");
$device = $ARGV[0];
$username = $ARGV[1] ;
$password = $ARGV[2];
$enable = $ARGV[3];
$enable_password = $ARGV[4];
$LoggingMsg = "Do you have logging back to the NTP server";
#Error Report Array
my @failed_tests;
#################################################################
# Create Session with router #
#################################################################
sub spawn_session
{
#open session with router
$command = Expect->spawn("telnet $device");
#Wait for password prompt or send error.
$command->expect($timeout, -re => "Username:") or do
{
print "\nFailed to get username prompt\n";
exit 2;
};
#Send Tacacs Username to router, exit if Username is incorrect
print $command "$username\r";
$command->expect($timeout, -re => "Password:") or do
{
print "\nFailed to get password prompt\n";
exit 4;
};
#Send password to router, exit if password is incorrect
print $command "$password\r";
$command->expect($timeout, -re => ">") or do
{
print "\nDid not get a \> in prompt\n";
exit 5;
};
#Send enable pass to router, exit if password is incorrect
print $command "$enable\r";
$command->expect($timeout, -re => "assword") or do
{
print "\nDid not get a \> in prompt\n";
exit 5;
};
#Send enable pass to router, exit if password is incorrect
print $command "$enable_password\r";
} #end sub
#################################################################
# Ensures that only one interface has manage ssh set #
#################################################################
sub check_logging_settings
{
my $no_logging = "You are missing logging 199.11.x.xx";
$command->clear_accum();
print $command "show config \| inc logging 199.11.x.xx\r";
unless ($command->expect($timeout, -re, '->')) {
return "Never got ssh prompt".$command->exp_error()."\n";
}
my $read = $command->exp_before();
my @read = split ('\n', $read);
my $x = 0;
my $count = 0;
for ($x=0; $x<$#read; $x++)
{
if ($read[$x] =~ /^logging 199.11.1.22$/)
{ $count += 1; }
}
if ($count < 1)
{
push (@failed_tests, $no_logging);
$action = "FAIL";
}
else
{
$action = "OK";
}#end if
print "$action We got here";
}
#################################################################
# Exits the Telnet Session #
#################################################################
sub exit_session
{
print $command "exit\r";
}#end sub
#################################################################
# Prints the failed test error descriptions #
#################################################################
sub print_error_report
{
print <<html1
Conent-Type: text/html\n\n
<html><head><title>QA REPORT</title></head>
<body bgcolor="#ffffff">
<p>
<h2>QA Results</h2>
<ul>
<body>
<b>$LoggingMsg</b><br>
</body>
print <<EndFooter;
</ul>
<p>
</body>
</html>
html1
}
#################################################################
# Main Program Module #
#################################################################
spawn_session();
check_logging_settings();
exit_session();
print_error_report();
------------------------------
Date: Sat, 19 Mar 2005 07:15:23 +0000
From: Brian McCauley <nobull@mail.com>
Subject: Re: ssh to cisco router with expect CPAN
Message-Id: <d1gj7i$pcu$1@sun3.bham.ac.uk>
erik wrote:
> I am ultimately trying to make CGI where we can Quality Assure Cisco
> routers. My script does log into the router, but I don't think it is
> storing in my array. I try to print the array and I get nothing. It
> hangs within the check_logging_settings subscript.
> (I have the ARGV scalars because I am testing it via command line
> rather than the browser. )
Since you are using the CGI module this is not really necessary - it has
a special debugging mode for command line testing.
> But like I said the problem is definitely in teh check_logging_settings
> sub script.
Well I know nothing about Cisco but is the prompt really '->' ?
> Any advice would be appreciated.
If any advice is appreciated then why haven't you followed the standard
advice given to everyone who comes here?
Always declare all variables as lexically scoped in the smallest
applicable scope unless there is a reason to do otherwise. Then "use
strict" and "use warnings".
We say this for both your beniefit and ours - if you do it then you will
find programming easier and we won't be asked to do the work of a machine.
> #!/usr/bin/perl -w
-w has largely been superceeded by "use warnings". (That's a slight
simplification for details RTFM).
> #################################################################
> # Global Variables #
> #################################################################
################################################################
# ...should be used as sparingly as possbile #
################################################################
> use Expect;
> use CGI(":standard");
> use Term::ANSIColor;
> #$device = param("device");
> #$username = param("username");
>
> #$password = param("password");
>
> #$enable = "enable";
>
> #$enable_password = param(enable_password");
>
>
> $device = $ARGV[0];
> $username = $ARGV[1] ;
>
> $password = $ARGV[2];
>
> $enable = $ARGV[3];
>
> $enable_password = $ARGV[4];
Perl has list assignment you know.
my ($device,$username,$password,$enable,$enable_password) = @ARGV;
> $LoggingMsg = "Do you have logging back to the NTP server";
>
> #Error Report Array
> my @failed_tests;
>
> #################################################################
> # Create Session with router #
> #################################################################
>
> sub spawn_session
> {
> #open session with router
> $command = Expect->spawn("telnet $device");
> #Wait for password prompt or send error.
> $command->expect($timeout, -re => "Username:") or do
You have never defined $timeout. If you adopted the habit of (wherever
possible) declaring variables at the same time as initializing them and
used strict then Perl would have picked up this mistake for you.
I suspect this is the problem that prompted you to post to Usenet. So
you see it really would help.
> {
> print "\nFailed to get username prompt\n";
> exit 2;
> };
>
> #Send Tacacs Username to router, exit if Username is incorrect
> print $command "$username\r";
>
> $command->expect($timeout, -re => "Password:") or do
> {
> print "\nFailed to get password prompt\n";
> exit 4;
> };
>
> #Send password to router, exit if password is incorrect
> print $command "$password\r";
>
> $command->expect($timeout, -re => ">") or do
> {
> print "\nDid not get a \> in prompt\n";
> exit 5;
> };
>
> #Send enable pass to router, exit if password is incorrect
> print $command "$enable\r";
>
>
> $command->expect($timeout, -re => "assword") or do
> {
> print "\nDid not get a \> in prompt\n";
Err....
> exit 5;
> };
>
> #Send enable pass to router, exit if password is incorrect
> print $command "$enable_password\r";
> } #end sub
>
>
> #################################################################
> # Ensures that only one interface has manage ssh set #
> #################################################################
> sub check_logging_settings
>
> {
> my $no_logging = "You are missing logging 199.11.x.xx";
>
> $command->clear_accum();
> print $command "show config \| inc logging 199.11.x.xx\r";
> unless ($command->expect($timeout, -re, '->')) {
> return "Never got ssh prompt".$command->exp_error()."\n";
What does ssh have to do with it?
> }
> my $read = $command->exp_before();
> my @read = split ('\n', $read);
The first argument to split is a regex. You can make it look like a
string but this makes your code less readable.
> my $x = 0;
You are suffing from premature declaration. There is no reason to
declare $x until you get to the for()
> my $count = 0;
>
> for ($x=0; $x<$#read; $x++)
Don't use C-style for() in Perl unless there is a reson.
Did you really itend to omit the last element of @read? (I shall assume
not).
for my $x ( 0 .. $#read )
But in Perl you should only iterate over the subscripts of an array if
there is a reason to do so. If you really want to interate over the
contents of array then you should do just that.
for ( @read )
> {
> if ($read[$x] =~ /^logging 199.11.1.22$/)
You probaly wanted \. not . in there.
> { $count += 1; }
Perl has ++ operator, you know.
> }
Anyhow, all in all, you are working _much_ too hard.
my $count = grep /^logging 199\.11\.1\.22$/, split /\n/, $read;
> if ($count < 1)
Oh, if you only want to ditinguish there/not there then there was no
need to count at all.
if ( $read !~ /^logging 199\.11\.1\.22$/m )
> {
> push (@failed_tests, $no_logging);
> $action = "FAIL";
> }
> else
> {
> $action = "OK";
> }#end if
> print "$action We got here";
> }
>
> #################################################################
> # Exits the Telnet Session #
> #################################################################
> sub exit_session
> {
> print $command "exit\r";
> }#end sub
>
> #################################################################
> # Prints the failed test error descriptions #
> #################################################################
> sub print_error_report
> {
> print <<html1
> Conent-Type: text/html\n\n
> <html><head><title>QA REPORT</title></head>
> <body bgcolor="#ffffff">
> <p>
> <h2>QA Results</h2>
> <ul>
> <body>
> <b>$LoggingMsg</b><br>
> </body>
> print <<EndFooter;
> </ul>
> <p>
> </body>
> </html>
> html1
> }
> #################################################################
> # Main Program Module #
> #################################################################
> spawn_session();
> check_logging_settings();
> exit_session();
> print_error_report();
>
------------------------------
Date: Sat, 19 Mar 2005 02:58:10 GMT
From: Bob Walton <see.sig@rochester.rr.com>
Subject: Re: Stumped by eval and scoping problem
Message-Id: <6zM_d.83939$vK5.80212@twister.nyroc.rr.com>
shanx wrote:
> I am not a perl newbie, but I am really stumped by this eval problem.
> I cannot change a lot of the existing code since it is legacy stuff, so
----^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Huh? Why not? It's Perl code and you've got the source. And
besides, that stuff can't be legacy code -- there's no way it
could ever have worked. See below.
> any solution to redo this in a totally different manner won't work for
> me.
>
> The Problem:
>
> A perl program called bug_find includes a test-suite library called
> foo.pl using 'do'. bug_find has 'use strict' declaration and it passes
> a perl -c, (we're using perl 5.6), but foo.pl doesn't have a 'use
> strict' declaration. The relevant parts of the code from both files are
> shown below:
>
> ####bug_find####
> ..
Some comments below...
> sub run_test {
> my ($ref) = @_;
>
> my $command = $ref->{cmd};
> local $results = {};
>
> open(FH, "$command 2>&1 |") or die $!;
>
> my @output = <FH>;
> $results->{output} = @output;
In the above statement, the left-hand-side is a scalar lvalue;
hence, the thing that will get store will be the number of
elements in array @output. Is that what you want? I doubt it
since you are trying to match against a string that is
non-numeric later on (starting with 'success').
>
> if (exists($ref->{post}) and defined($ref->{post}) {
> eval $ref->{post};
You should test the results of eval to see if the eval compiled
and ran. The results of that test should be quite revealing, as
would printing what you are about to eval just before you eval
it. Or running it in the debugger. Did you try that??
> }
>
> return $results;
> }
>
> ..
>
> # What follows is main part of bug_find.
> {
> do $suite; # let us say $suite is foo.pl
>
> foreach $i (@tests) {
> $result = run_test($i);
> }
> }
>
> ####end of bug_find####
>
>
> ####start of foo.pl (or whatever $suite is)####
>
>
> @specific_tests = (
> {
> 'cmd' => "cleartool $blah $blah", # This is some shell
> command
> 'post' => "$gotit = $1 if ($results->{output} =~ m/success
> (\w+)/); print \"Value of gotit is $gotit\n\"",
When the above statement is executed by Perl, the values of
$gotit, $1 and $results->{output} are all interpolated into the
double-quoted string, which is then stored in
$specifictests[0]->{post}. The code you give doesn't clue us in
to what is in those variables, but note that if $gotit contained
'foo', $1 contained 'bar', and $results->{output} contained
'baz', then @specifictests[0]->{post} will contain:
foo = bar if(baz =~m/success
(\w+)/); print "Value of gotit is foo
"
Since that isn't legal Perl, the eval back in your other code
will fail. But you didn't test for that. And this makes me
amazed at your statement below that the print statement revealed
a correct value for $gotit, since the print never even compiled.
Or perhaps $gotit etc actually contained value which, when
interpolated into the string, made up something the Perl could
compile and execute? It seems very unlikely that $1 would
contain such a value at that point.
> },
> {
> 'cmd' => 'cd /var/tmp/$gotit; ./do_something.sh',
You mention in a followup note that the ' above are actually ",
so $gotit is substituted at the time @specifictests[1] is
defined. That probably isn't what you wanted -- you probably
*do* want the apostrophe string so the $gotit is preserved until
eval time. Use the debugger to see what you actually have in
your data structures at various times during execution.
And, BTW, if you're retyping your code (otherwise how would you
have made that "mistake"?), *don't* *do* *that*. Copy/paste
tested code into your posts so we don't have fight typos. Read
the posting guidelines.
> }
> );
>
> @tests = (@specific_tests);
>
> ###end of foo.pl####
>
> Note that the variable @tests in foo.pl is being used by bug_find after
> 'do'.
>
> My problem is that when I run bug_find, I see the correct value of
------------------------------------------^^^^^^^^^^^^^^^^^^^^^^^
I doubt it. The print statement would never have even compiled.
Can you post concice but complete code that anyone can
copy/paste/execute which demonstrates this (per the posting
guidelines, BTW), please?
> $gotit in the print statement but when I try to read the value of
> $gotit (just before do_something.sh), the variable seems to be unset
> and it is empty.
>
> What is going on?
Run your code in the debugger (perl -d filename.pl) and see for
yourself.
>
> -Shanker
>
--
Bob Walton
Email: http://bwalton.com/cgi-bin/emailbob.pl
------------------------------
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 7897
***************************************
