[31658] in Perl-Users-Digest
Perl-Users Digest, Issue: 2921 Volume: 11
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Apr 24 16:09:23 2010
Date: Sat, 24 Apr 2010 13:09: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, 24 Apr 2010 Volume: 11 Number: 2921
Today's topics:
How to ignore newline in Parse::RecDescent <freesoft12@gmail.com>
Re: How to ignore newline in Parse::RecDescent <hjp-usenet2@hjp.at>
Re: How to ignore newline in Parse::RecDescent <freesoft12@gmail.com>
Re: How to ignore newline in Parse::RecDescent <uri@StemSystems.com>
Re: How to ignore newline in Parse::RecDescent <derykus@gmail.com>
Re: How to ignore newline in Parse::RecDescent <hjp-usenet2@hjp.at>
Re: Problems with "show tech" using the Net::Telnet Mod <lange.gerhard@gmail.com>
why is child process a negative number? <cartercc@gmail.com>
Re: why is child process a negative number? <cwilbur@chromatico.net>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Fri, 23 Apr 2010 18:51:27 -0700 (PDT)
From: "freesoft12@gmail.com" <freesoft12@gmail.com>
Subject: How to ignore newline in Parse::RecDescent
Message-Id: <506c4ada-9aa4-424b-83b1-64043aba98e4@g30g2000yqc.googlegroups.com>
Hi,
I am new to Parse::RecDescent and I came across this problem of the
parser not being able to ignore the newline character. Is there a way
I can ask the parser to ignore all newlines?
Regards
John
### parser_test.pl ###
eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}' && eval 'exec
perl -w -S $0 $argv:q' if 0;
#
use strict;
use diagnostics;
use Parse::RecDescent;
my $grammar = q {
start: identifier(s)
identifier : /\S+/
{ print $item[0]."\n"; }
};
my $parser = Parse::RecDescent->new($grammar);
open(IN,"data.txt") or die "Cannot open data.txt";
# slurp all the lines
my @lines = <IN>;
defined $parser->start(@lines) or die "Didn't match anything";
### end of parser
# data.txt
Head node1
Tail node2
------------------------------
Date: Sat, 24 Apr 2010 16:51:56 +0200
From: "Peter J. Holzer" <hjp-usenet2@hjp.at>
Subject: Re: How to ignore newline in Parse::RecDescent
Message-Id: <slrnht61cc.k0g.hjp-usenet2@hrunkner.hjp.at>
On 2010-04-24 01:51, freesoft12@gmail.com <freesoft12@gmail.com> wrote:
> I am new to Parse::RecDescent and I came across this problem of the
> parser not being able to ignore the newline character. Is there a way
> I can ask the parser to ignore all newlines?
[...]
> open(IN,"data.txt") or die "Cannot open data.txt";
> # slurp all the lines
> my @lines = <IN>;
> defined $parser->start(@lines) or die "Didn't match anything";
You are calling $parser->start with two arguments here: "Head node1\n"
and "Tail node2\n".
AFAICS this isn't allowed. (But the error message is strange - I guess
Parse::RecDescent uses a second parameter for internal and undocumented
purposes.
So I think your question is really: How can I read in an entire file all
at once?
This is a FAQ. read
perldoc -q 'entire file'
hp
------------------------------
Date: Sat, 24 Apr 2010 08:53:45 -0700 (PDT)
From: "freesoft12@gmail.com" <freesoft12@gmail.com>
Subject: Re: How to ignore newline in Parse::RecDescent
Message-Id: <542c7971-4994-4cf6-8763-dab19ccabd5c@s9g2000yqa.googlegroups.com>
Thanks for the pointer to the perldoc section! I tried this suggestion
in that section and I did not get the newline problem:
$var = do { local $/; <INPUT> };
My updated prog is:
my $grammar = q {
start: identifier(s)
identifier : /\S+/
{ print $item[1]."\n"; }
};
my $parser = Parse::RecDescent->new($grammar);
open(IN,"data.txt") or die "Cannot open data.txt";
# slurp all the lines
my $var = do { local $/; <IN> };
#my @lines = <IN>;
defined $parser->start($var) or die "Didn't match anything";
It now prints:
Head
node1
Tail
node2
Like I wanted it to print.
Regards
John
------------------------------
Date: Sat, 24 Apr 2010 12:22:04 -0400
From: "Uri Guttman" <uri@StemSystems.com>
Subject: Re: How to ignore newline in Parse::RecDescent
Message-Id: <87aassstw3.fsf@quad.sysarch.com>
>>>>> "fc" == freesoft12@gmail com <freesoft12@gmail.com> writes:
fc> Thanks for the pointer to the perldoc section! I tried this suggestion
fc> in that section and I did not get the newline problem:
fc> $var = do { local $/; <INPUT> };
use File::Slurp. cleaner and faster. especially since you are using a
slower parser.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.sysarch.com --
----- Perl Code Review , Architecture, Development, Training, Support ------
--------- Gourmet Hot Cocoa Mix ---- http://bestfriendscocoa.com ---------
------------------------------
Date: Sat, 24 Apr 2010 11:45:16 -0700 (PDT)
From: "C.DeRykus" <derykus@gmail.com>
Subject: Re: How to ignore newline in Parse::RecDescent
Message-Id: <876ceb96-694e-455e-9fd8-1e947f05fdb6@n33g2000pri.googlegroups.com>
On Apr 24, 8:53=A0am, "freesof...@gmail.com" <freesof...@gmail.com>
wrote:
> Thanks for the pointer to the perldoc section! I tried this suggestion
> in that section and I did not get the newline problem:
>
> $var =3D do { local $/; <INPUT> };
>
> My updated prog is:
> my $grammar =3D q {
>
> start: identifier(s)
>
> identifier : /\S+/
> =A0 =A0 =A0 =A0 =A0 =A0 { print $item[1]."\n"; }};
>
> my $parser =3D Parse::RecDescent->new($grammar);
>
> open(IN,"data.txt") or die "Cannot open data.txt";
> # slurp all the lines
> my $var =3D do { local $/; <IN> };
> #my @lines =3D <IN>;
> defined $parser->start($var) or die "Didn't match anything";
>
> It now prints:
> Head
> node1
> Tail
> node2
>
And you don't really need to slurp:
while (<IN>)
{
defined $parser->start($_)
or die "Didn't match anything";
}
--
Charles DeRykus
------------------------------
Date: Sat, 24 Apr 2010 21:04:39 +0200
From: "Peter J. Holzer" <hjp-usenet2@hjp.at>
Subject: Re: How to ignore newline in Parse::RecDescent
Message-Id: <slrnht6g67.na6.hjp-usenet2@hrunkner.hjp.at>
On 2010-04-24 18:45, C.DeRykus <derykus@gmail.com> wrote:
> On Apr 24, 8:53 am, "freesof...@gmail.com" <freesof...@gmail.com>
> wrote:
>> Thanks for the pointer to the perldoc section! I tried this suggestion
>> in that section and I did not get the newline problem:
[...]
>> my $parser = Parse::RecDescent->new($grammar);
>>
>> open(IN,"data.txt") or die "Cannot open data.txt";
>> my $var = do { local $/; <IN> };
>> defined $parser->start($var) or die "Didn't match anything";
[...]
> And you don't really need to slurp:
>
> while (<IN>)
> {
> defined $parser->start($_)
> or die "Didn't match anything";
> }
That parses every line separately which is in general not the same as
parsing a whole file.
hp
------------------------------
Date: Sat, 24 Apr 2010 11:28:55 -0700 (PDT)
From: Asterix <lange.gerhard@gmail.com>
Subject: Re: Problems with "show tech" using the Net::Telnet Module
Message-Id: <0aaa3f13-a573-4c0a-ac0b-52113f85f467@j17g2000yqa.googlegroups.com>
On 20 Apr, 00:44, s...@netherlands.com wrote:
> On Mon, 19 Apr 2010 10:49:37 -0700 (PDT),Asterix<lange.gerh...@gmail.com>=
wrote:
> >I've made a little script to capture the output of networking
> >devices.
> >Everything works fine, until I use the "show tech" command in an Cisco
> >device.
> >The script does not save anything form the "show tech",
> >but I can see that theTELNETSession gets back some output.
> >But I can't figure out how to save this output from "show tech" into a
> >file.
> >There is no problem with commands which produce smaller output.
> >I don't want to use the "Net::Telnet:Cisco" Module:
>
> >#!/usr/bin/perl
> ># Autor: =A0 =A0 =A0 =A0 =A0 =A0Ing. Gerhard Hermann Lange
> ># Date: =A0 =A0 =A0 =A0 =A0 =A0 12/04/2010
> ># Description: =A0 =A0 =A0Script for doing aTELNETto a CISCO devices and
> >executing some comands.
> ># =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 Long outputs from =
theTELNETSession (->show tech) is not
> >possible
> ># =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 due to theTELNETse=
ssion timeout of 5 seconds
> >use Net::Telnet;
> >#
> >my $prg_name =3D $0; $prg_name =3D~ s|^.*[\\/]||;
> ># Usage:
> >my $usage=3D"Syntax: $prg_name <hostname> <ip> <username> <password>
> ><enable-pwd>\n";
> >if (! defined ($ARGV[0])) { print "$usage"; exit; }
> >#
> >$SIG{'INT'} =3D sub {
> > =A0 =A0# Subprocedure for finishing all the work
> > =A0 =A0# printf OUTPUT_FILE "@output\n\n";
> > =A0 =A0close(OUTPUT_FILE);
> > =A0 =A0print STDERR "Termination of program ... !\n";
> > =A0 =A0exit;
> >};
> >#
> >$hostname =3D $ARGV[0];
> >$ip =3D $ARGV[1];
> >$username =3D $ARGV[2];
> >$password =3D $ARGV[3];
> >$enpwd =3D $ARGV[4];
> >$cmd_file =3D "cmds.txt";
> >#
> >my ($sec, $min, $hr, $mday, $mon, $year, @etc) =3D localtime(time);
> >$mon++; $year=3D$year+1900;
> >my $now=3Dsprintf("%.4d%.2d%.2d%.2d%.2d", $year, $mon, $mday, $min,
> >$sec);
> >my $today=3Dsprintf("%.2d/%.2d/%.4d", $mday, $mon, $year );
> >#
> ># $out_file=3D$ip;
> >$out_file=3D$ip."_$now".".cfg";
> >#
> ># For debugging theTELNETSession: uncomment this line !
> ># $filename=3D"telnet_dump.txt";
> >#
> >$errmode=3D'return'; # Default: 'die'
> >#
> ># Set cmd_remove_mode to the number of lines to remove (0 in this
> >case).
> >#http://www.perlmonks.org/?node_id=3D736670
> >$errmode=3D"return";
> >$telnet=3D new Net::Telnet( Timeout=3D>5, Errmode=3D>$errmode ,
> >cmd_remove_mode =3D> '0', Dump_Log =3D>
> >$filename);
>
> ># $telnet=3D new Net::Telnet( Timeout=3D>3, Errmode=3D>$errmode ,
> >Output_record_separator =3D> "\r",cmd_remove_mode =3D> '2', Dump_Log =3D=
>
> >$filename);
> ># -output_record_separator =3D> "\r");
> >$telnet->open($ip);
> >#
> >$telnet->waitfor('/Username: $/i');
> >$telnet->print($username);
> >$telnet->waitfor('/Password: $/i');
> >$telnet->print($password);
> >#
> ># Wait for the prompt, send "enable" and enable-pwd
> >@output =3D $telnet->waitfor('/>/');
> >$telnet->print('enable');
> >$telnet->waitfor('/Password:/i');
> >$telnet->print($enpwd);
> >#
> >@output =3D $telnet->waitfor('/#/i');
> >#
> >open(OUTPUT_FILE, ">>$out_file");
> >printf OUTPUT_FILE "IP Address: $ip\n";
> >printf OUTPUT_FILE "Hostname: =A0 $hostname\n";
> >printf OUTPUT_FILE "Data: =A0 =A0 =A0 $today\n";
> >printf OUTPUT_FILE "\n";
> >#
> ># Creat an universal Prompt for this hostname
> >my $prompt =3D $hostname."#";
> >$telnet->prompt("/$prompt\$/");
> >@output =3D $telnet->cmd(String =3D> "terminal length 0");
> >printf OUTPUT_FILE "@output\n\n";
> >#
> >open(CMDFILE, "<$cmd_file");
> >while (my $record =3D <CMDFILE>) {
> > =A0 =A0if ($record !~ /^(#|!|\s)/) {
> > =A0 =A0 =A0 =A0 =A0 =A0chomp($record);
> > =A0 =A0 =A0 =A0 =A0 =A0my @record_array =3D (split(/;/,$record));
> > =A0 =A0 =A0 =A0 =A0 =A0my $command =3D $record_array[0]; chomp($cmd);
> > =A0 =A0 =A0 =A0 =A0 =A0#
> > =A0 =A0 =A0 =A0 =A0 =A0$telnet->prompt("/$prompt\$/");
> > =A0 =A0 =A0 =A0 =A0 =A0@output =3D $telnet->cmd(String =3D> "$command",=
Timeout=3D>30);
> > =A0 =A0 =A0 =A0 =A0 =A0#
> > =A0 =A0 =A0 =A0 =A0 =A0printf OUTPUT_FILE "@output\n\n";
> > =A0 =A0}
> >}
> ># Close the command File for this device
> >close(CMDFILE);
> >#
> >$telnet->print('exit');
> >close(OUTPUT_FILE);
>
> Its hard to tell what the problem is.
>
> What does the LOG tell you? Where does that stop at?
> Does it complete all the commands?
>
> If something doesen't go right you should ISOLATE it, and just send that
> command to find out why!
>
> Chop up your code into a test bed for that item. Do enough to log in
> and send the command then log off (which btw, you don't end the session
> in the code).
>
> Some things you can try:
>
> =A0 - Use dump_log() to debug (but I think you do this).
>
> =A0 - max_buffer_length($len); =A0the default is 1 MB, take it up to 10
>
> =A0 - Consider using a combination of print() and waitfor() as an alterna=
tive
> =A0 =A0 to cmd() if the command you send prompts for input.
> =A0 =A0 ** The last time I usedTelnet(2004), I only used this combination=
.
> =A0 =A0 =A0 =A0You can still capture the output if you use waitfor() in l=
ist context.
>
> =A0 - When mode is "return" then the method generating the error places a=
n
> =A0 =A0 error message in the object and returns an undefined value in a s=
calar
> =A0 =A0 context and an empty list in list context.
> =A0 =A0 The error message may be obtained using errmsg().
> =A0 =A0 ** You have set this, but you don't check for !@output to see if
> =A0 =A0 =A0 =A0there was an error. Try using the default 'die' error mode=
.
>
> =A0 - Make sure the server shell is not in console mode that buffers outp=
ut.
> =A0 =A0 You want it in line or stream mode.
>
> Finally, using the print()-waitfor() pair, try to modify the below
> method so its a function. You can use the $prematch to capture the output=
.
> But more importantly, it gives you a finer granularity and more flexibili=
ty
> deciphering the output stream. (There is a whole module this goes with,
> but I didn't include it because it was written with a broader scope than
> what your looking for).
>
> -sln
>
> #####################################################
> # Send command and wait for reply
> # - May wait for one of many reply regxs' passed in
> # =A0 via the 'Reply' array. Each MUST be single
> # =A0 quoted regex expressions. ie: '/any/i'
> # IN:
> # =A0cmd =A0 =A0 =A0 - the shell command or program
> # =A0waitsecs =A0- total secs willing to wait (up to)
> # =A0show_wait - 'yes' shows the seconds while waiting
> # =A0Reply =A0 =A0 - list of matches will wait for
> # OUT:
> # =A0Returns index+1 into the 'Reply' list passed in,
> # =A0of the first match found in reply stream.
> # =A0Otherwise returns 0, meaning timeout or other
> # =A0error (check $self->{'Error'})
> #####################################################
> sub SendCommand
> {
> =A0 =A0 =A0 =A0 my ($self, $cmd, $waitsecs, $show_wait, @Reply) =3D @_;
> =A0 =A0 =A0 =A0 my ($pre, $match);
>
> =A0 =A0 =A0 =A0 if (!defined $tln) {
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 $self->{'Error'} =3D "Session not open";
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 return 0;
> =A0 =A0 =A0 =A0 }
> =A0 =A0 =A0 =A0 $waitsecs =3D $self->{'Waitsecs'} unless (defined $waitse=
cs);
> =A0 =A0 =A0 =A0 $show_wait =3D $self->{'Show_Wait'} unless (defined $show=
_wait);
>
> =A0 =A0 =A0 =A0 my @args =3D ('Timeout', 0);
> =A0 =A0 =A0 =A0 if (@Reply =3D=3D 0) { push (@Reply, $self->{'Prompt'}) }
> =A0 =A0 =A0 =A0 for (@Reply) {
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 push (@args, 'Match');
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 push (@args, $_);
> =A0 =A0 =A0 =A0 }
> =A0 =A0 =A0 =A0 my $savedtimeout =3D $tln->timeout(0);
> =A0 =A0 =A0 =A0 $tln->print ($cmd);
> =A0 =A0 =A0 =A0 print "Sent: =A0$cmd\n" if ($self->{'Debug'});
>
> =A0 =A0 =A0 =A0 for (my $i =3D 0; $i < $waitsecs; $i++) {
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 ($pre, $match) =3D $tln->waitfor(@args);
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 if (!$tln->timed_out) {
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 print "\rRecieved ($i sec=
onds): =A0 $match =A0 =A0 =A0 =A0 =A0 =A0 =A0 \n" if ($self->{'Debug'});
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 print "\n$pre\n" if (lc($=
self->{'Show_Prematch'}) eq 'yes');
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 last;
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 }
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 sleep (1);
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 if ($show_wait eq lc('yes')) {
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 print "\rWait progress: =
=A0".($i+1)." seconds =A0 =A0 =A0 =A0 =A0 " ;
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 print "\n" if ($i =3D=3D =
($waitsecs-1));
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 }
> =A0 =A0 =A0 =A0 }
> =A0 =A0 =A0 =A0 $tln->timeout($savedtimeout);
>
> =A0 =A0 =A0 =A0 ## check if timed out
> =A0 =A0 =A0 =A0 if ($tln->timed_out) {
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 print "\r** WAIT EXPIRED - $waitsecs seco=
nds ** =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 \n" if ($self->{=
'Debug'});
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 $self->{'Error'} =3D "Timed out ($waitsec=
s) executing command: =A0$cmd";
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 return 0;
> =A0 =A0 =A0 =A0 }
> =A0 =A0 =A0 =A0 ## return the index of the matched @Reply
> =A0 =A0 =A0 =A0 #return 1 if (!@Reply);
> =A0 =A0 =A0 =A0 my $pos =3D 0;
> =A0 =A0 =A0 =A0 for (@Reply) {
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 $pos++;
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 my $patcheck =3D "last if (\$match =3D~ $=
_);"; # pattern match check
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 #print "$patcheck\n";
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 eval $patcheck;
> =A0 =A0 =A0 =A0 }
> =A0 =A0 =A0 =A0 $self->{'Error'} =3D '';
> =A0 =A0 =A0 =A0 return $pos;
>
>
>
> }- Nascondi testo citato
>
> - Mostra testo citato -- Nascondi testo citato
>
> - Mostra testo citato -
=3D=3D=3D=3D=3D=3D=3D=3D
Thank you for your response !
I've figured out the problem. It was not a problem regarding TELNET
but regarding the flushing of the
Buffer verso STDOUT:
Instead of this printf OUTPUT_FILE "@output\n\n";
I've used print OUTPUT_FILE "@output\n\n";
At the top of the script I also inserted "Autoflush":
local $| =3D 1; # Default is 0
http://perldoc.perl.org/perlvar.html
------------------------------
Date: Fri, 23 Apr 2010 11:02:57 -0700 (PDT)
From: ccc31807 <cartercc@gmail.com>
Subject: why is child process a negative number?
Message-Id: <c6e63f09-a65b-46a0-8aa9-2e5806b40775@k33g2000yqc.googlegroups.com>
On Win32, the process id is whatever the value of $$ is.
When you fork(), the parent retains whatever the original pid was.
However, the child pid has a negative number. Why?
CODE
my $orig_pid = $$;
my $child = fork();
if ($$ > 0)
{
print qq(1. The pid is $$\n);
print qq(Parent process pid is $$, child is $child\n);
}
else
{
print qq(2. The pid is $$\n);
print qq(Child process pid is $$, parent is $orig_pid\n);
}
OUTPUT
1. The pid is 3172
Parent process pid is 3172, child is -2272
2. The pid is -2272
Child process pid is -2272, parent is 3172
------------------------------
Date: Fri, 23 Apr 2010 14:29:36 -0400
From: Charlton Wilbur <cwilbur@chromatico.net>
Subject: Re: why is child process a negative number?
Message-Id: <8639ymuinj.fsf@mithril.chromatico.net>
>>>>> "cc" == ccc31807 <cartercc@gmail.com> writes:
cc> On Win32, the process id is whatever the value of $$ is. When
cc> you fork(), the parent retains whatever the original pid was.
cc> However, the child pid has a negative number. Why?
Win32 is not Unix. perldoc perlfork
Charlton
--
Charlton Wilbur
cwilbur@chromatico.net
------------------------------
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:
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
Back issues are available via anonymous ftp from
ftp://cil-www.oce.orst.edu/pub/perl/old-digests.
#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 V11 Issue 2921
***************************************
