I am working on implementing something where i need to check whether value of a variable is defined or not and then proceed with exiting the code. I kept this logic in one script where it has to check for all files opened on my perforce client.
eval { $test = $temp->project($loc); };
unless ($test){
print "undefiled value.please check.\n\n";
exit(1);
}
There are other files which are opened on my perforce client which needs to be validated. Here my script gets exiting when it sees first issue.
Here i want to display all the issues by validating all opened files on my client.
Any suggestions?
I guess you'd want to change the code to something like this:
# Before your loop, set up a variable to store errors
my #errors;
# Where your code is
eval { $test = $temp->project($loc) };
unless ($test) {
# Don't exit, but store the error and move to the next iteration
push #errors, "Undefiled value <$loc>. Please check.\n\n";
next;
}
# After your loop, die id there are any errors
die join "\n", #errors if #errors;
Update: I like ikegami's suggestion in the comments.
# Before your loop, set up a variable to count errors
my $errors;
# Where your code is
eval { $test = $temp->project($loc) };
unless ($test) {
# Don't exit, but store the error and move to the next iteration
warn "Undefiled value <$loc>. Please check.\n\n";
++$errors;
next;
}
# After your loop, die id there are any errors
exit(1) if $errors;
Related
I am using the following lib Net::SSH2
I can connect to my device and get the output OK in most case. Below is the relevant code:
sub logIntoDevice
{
my $self = shift;
my ($ssh2) = #_;
if(! $ssh2->connect($self->deviceIP))
{
say "Failed to connect to device:",$self->deviceIP;
$ssh2->disconnect();
exit 0;
}
if(! $ssh2->auth_password($self->usr, $self->pass))
{
say "Authentication Fail to ",$self->deviceIP;
$ssh2->disconnect();
exit 0;
}
my $channel = $ssh2->channel();
$channel->blocking(0);
$channel->shell();
return $channel;
}
sub sendCmd
{
my $self = shift;
my ($cmd,$channel) = #_;
my #cmdOutput;
print $channel "$cmd\n";
while (<$channel>)
{
chomp $_;
push(#cmdOutput, $_);
}
return #cmdOutput;
}
So below are the cmd i sent to the sub's. They work fine and the output is write to file OK.
$self->writeToFile($fileName,$self->sendCmd("show clock",$channel));
$self->writeToFile($fileName,$self->sendCmd("\n",$channel));
$self->writeToFile($fileName,$self->sendCmd("dir",$channel));
with the exception of when i sent the following cmd:
$self->writeToFile($fileName,$self->sendCmd("sh run",$channel));
the output of the cmd on the device using putty is:
sh run
Building configuration...
Current configuration : 16575 bytes
!
!
!Last configuration change at 16:37:19 CET+1 Sat Mar 15 2014
.....
but in the log file all you see is
sh run
Building configuration...
so the issue is the blank lines after the Building configuration output make the while (<$channel>) think its the end of the output.
My issue is I cant figure a way to loop through the data without using a While loop.
UPDATE
Ok come up with this solution but seems very clunky. must be a better way if doing this
sub sendCmd
{
my $self = shift;
my ($cmd,$channel) = #_;
my #cmdOutput;
my $currPrompt;
#get prompt. i am sure there is a better way!!! just cant figure it out
print $channel "\n";
while (<$channel>)
{
$currPrompt = $_;
}
print $channel "$cmd\n";
while(42)
{
my $inerOutput;
while (<$channel>)
{
chomp $_;
$inerOutput = $_;
push(#cmdOutput, $_);
}
if($inerOutput ne $currPrompt)
{
sleep(7);
}
else
{
last;
}
}
return #cmdOutput;
}
I don't think your issue is blank lines. Most likely, the issue is that you are using non-blocking mode, and it takes time for the device to perform the command. So you are getting an empty line (or an undef) after "Building configuration..." is read because there is no extra output produced yet.
I would use Net::SSH2's poll method with a timeout, which will let you know when there is something to read. If "sh run" takes substantially longer than other commands you are issuing, your sendCmd method needs to be aware of this, and allow more time to pass before it decides no more output is coming its way.
Alternatively, you can (as is the custom when using, for example, Net::Telnet) wait for more output until you see the prompt, whatever the prompt is for the device in question,
and then you will know that the command has finished its execution.
Net::SSH2->poll is deprecated as result of libss2_poll deprecation
I have a problem I am hoping someone can shed some light on...
In my program I have two main subroutines containing the bulk of my code, from those subroutines I then call/reference other smaller subroutines that carry out smaller tasks e.g. deletes certain folders, prints something to screen and so on..
Example of my problem (greatly simplified for the purposes of explaining):
use warnings;
use strict;
sub mainprogram {
my #foldernames = ("hugefolder", "smallfolder", "giganticfolder");
SKIP:foreach my $folderName (#foldernames) {
eval {
$SIG{INT} = sub { interrupt() }; #to catch control-C keyboard command
my $results = `grep -R hello $folderName`; #this takes a long time to grep if its a big folder so pressing control-c will allow the user to skip to the next folder/iteration of the foreach loop
}
print "RESULTS: $results\n";
}
}
sub interrupt {
print "You pressed control-c, do you want to Quit or Skip this huge folder and go onto greping the next folder?\n";
chomp ($quitOrSkip = <STDIN>);
if ($quitOrSkip =~ /quit/) {
print "You chose to quit\n";
exit(0);
} elsif ($quitOrSkip =~ /skip/) {
print "You chose to skip this folder and go onto the next folder\n";
next SKIP; # <-- this is what causes the problem
} else {
print "Bad answer\n";
exit(0);
}
}
The problem I am having
As you can see in the code above if the user presses ctrl+c while the backticks grep command is running on a folder it will then give them the option to quit the program totally or choose to move onto the next folder in the arrayloop and start greping that.
With the code above though you would inevitably get the "Label not found for next SKIP...at line..." error because it obviously cannot find the SKIP label as its in the other subroutine.
Is there a way this could be done or something to the same effect i.e go to the next iteration of the foreach loop even though the "next SKIP" and the "SKIP:foreach" label are in different subroutines.
I am well aware I could combine the two subroutines so the "next SKIP" is in the same block as the "SKIP:foreach" so it would then work, but if a program calls the "interrupt" subroutine lots of times and in many places then this would mean a lot of repetitive code.
I may well be overlooking something very obvious, but your help is much appreciated, thanks
You could move the results printing inside the eval, then die if you don't want to print them.
foreach my $folderName (#foldernames) {
eval {
local $SIG{INT} = sub { interrupt() }; #to catch control-C keyboard command
my $results = `grep -R hello $folderName`; #this takes a long time to grep if its a big folder so pressing control-c will allow the user to skip to the next folder/iteration of the foreach loop
print "RESULTS: $results\n";
1;
} or do {
# handle the skip if required
};
}
sub interrupt {
...
die 'skip';
...
}
Alternatively:
foreach my $folderName (#foldernames) {
eval {
local $SIG{INT} = sub { interrupt() }; #to catch control-C keyboard command
my $results = `grep -R hello $folderName`; #this takes a long time to grep if its a big folder so pressing control-c will allow the user to skip to the next folder/iteration of the foreach loop
1;
} or do {
next; # Interrupted (or something went wrong), don't print the result.
};
print "RESULTS: $results\n";
}
sub interrupt {
...
die 'skip';
...
}
I just finished a Perl script (which is doing great) with the form:
my #plages_IP = ('10.7.10.103' ,'10,121,10,7', '10.120.10.10');
foreach my $IP (#plages_IP)
{
DO ALL THE THING I WANT;
}
My problem is that for some reason, 1 or more IP in my list may be busy at the time i launch the script. In that case, i get some perl error (wich are normal) and the script die:
'Error POSTing http://10,121,10,7/wcd/login.cgi: Can't connect to 10,121,10,7:80 (Bad hostname) at C:\Users\STAGEDVIR\Desktop\gnagna\Retrieve_Counter_C364_C224_C203.pl line 51.'
'Error POSTing http://10.64.10.3/wcd/login.cgi: Not Found at C:\Users\STAGEDVIR\Desktop\gnagna\Retrieve_Counter_C203.pl line 45.'
I don't want it to die if an error is found but to jump to the next item of the loop ;All those errors mean the same thing (IP currently busy), typically, what i want to do is:
if(ANY_ERROR && LOOP_NOT_EMPTY)
{
DON'T DIE;
JUMP TO THE NEXT ELEMENT OF THE LOOP;
}
I tried some solution with eval{ routine_might_die }; warn $# if $#; and some ways like:
unless($boolean_descripting_last_request->is_success)
{
print(STDERR "Currently busy $IP ! \n");
**next**;
}
But the script keeps dying to the first error he finds due to IP currently busy.
You're putting the eval in the wrong place. If you want to catch errors within your loop, put the eval there.
my #plages_IP = ('10.7.10.103' ,'10,121,10,7', '10.120.10.10');
foreach my $IP (#plages_IP) {
eval {
# stuff that might die
};
warn $# if $#;
}
There's no need for next since the loop will continue anyway.
I need to watch multiple files in Perl, and I am using Linux::Inotify2. However I am encountering an issue in that the first file being watched needs to be modified and hit, then the second, then the first etc etc
For example if the second file is changed before the first, it will not trigger out, or if the first is triggered twice in a row without the second being triggered in between.
This is the section of code I am using which is having this issue.
my $inotify = new Linux::Inotify2;
my $inotify2 = new Linux::Inotify2;
$inotify->watch ("/tmp/rules.txt", IN_MODIFY);
$inotify2->watch ("/tmp/csvrules.out", IN_MODIFY);
while () {
my #events = $inotify->read;
unless (#events > 0){
print "read error: $!";
last ;
}
foreach $mask (#events) {
printf "mask\t%d\n", $mask;
open (WWWRULES, "/tmp/rules.txt");
my #lines = <WWWRULES>;
foreach $line (#lines) {
#things = split(/,/, $line);
addrule(#things[0], #things[1], #things[2], #things[3], trim(#things[4]));
print "PRINTING: #things[0], #things[1], #things[2], #things[3], #things[4]";
close (WWWRULES);
open (WWWRULES, ">/tmp/rules.txt");
close (WWWRULES);
}
}
my #events2 = $inotify2->read;
unless (#events2 > 0){
print "read error: $!";
last ;
}
foreach $mask (#events) {
printf "mask\t%d\n", $mask;
open (SNORTRULES, "/tmp/csvrules.out");
my #lines2 = <SNORTRULES>;
foreach $line2 (#lines2) {
#things2 = split(/,/, $line2);
addrule("INPUT", #things2[0], #things2[1], #things2[2], trim(#things2[3]));
print "PRINTING: INPUT, #things2[0], #things2[1], #things2[2], #things2[3]";
close (SNORTRULES);
open (SNORTRULES, ">/tmp/csvrules.out");
close (SNORTRULES);
}
}
}
Ideally I would like to be watching 3 files but as I cannot get 2 working it seems a little pointless at this stage.
Thanks for any help!
A single inotify object can handle any number of watches. That's one of the advantages of inotify over the older and now obsolete dnotify. So you should be saying:
my $inotify = Linux::Inotify2->new;
$inotify->watch("/tmp/rules.txt", IN_MODIFY);
$inotify->watch("/tmp/csvrules.out", IN_MODIFY);
Then you can see which watch was triggered by checking the fullname property of the event object:
while () {
my #events = $inotify->read;
unless (#events > 0){
print "read error: $!";
last ;
}
foreach my $event (#events) {
print $event->fullname . " was modified\n" if $event->IN_MODIFY;
}
}
The big problem is that your code is modifying the same files that you're watching for modifications. When /tmp/rules.txt is modified, you open it, read it, and then truncate it, which triggers another modification notice, starting the whole process over again. In general, this is hard to solve without race conditions, but in your case, you should be able to just check for an empty file (next if -z $event->fullname).
You seem to be doing checks in serial on something that you want to happen in parallel. You're either going to want to fork a separate process, use threading, or integrate it in with a POE object.
Another option, which may or may not work for your application, is to set your tempdir to something more specific and keep all the files you're working on in there, then just watch the directory as a whole, which would then only require 1 inotify object, if i'm reading this right. (I haven't done anything with this module in particular but I have a pretty good idea of how it works by hooking syscalls to the file system).
EDIT:
I will try a better explication this time, this is the exact code from my script (sorry for all them coments, they are a result of your sugestions, and apear in the video below).
#use warnings;
#use Data::Dumper;
open(my $tmp_file, ">>", "/tmp/some_bad.log") or die "Can not open log file: $!\n";
#if( $id_client != "")
#allowed_locations = ();
#print $tmp_file "Before the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
if( $id_client )
{
# print $tmp_file "Start the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
# my $q = "select distinct id_location from locations inner join address using (id_db5_address) inner join zona_rural_detaliat using (id_city) where id_client=$id_client";
# my $st = &sql_special_transaction($sql_local_host, $sql_local_database, $sql_local_root, $sql_local_root_password, $q);
# print $tmp_file "Before the while loop: ref(st)='". ref($st) . "\n";
# while((my $id)=$st->fetchrow())
# {
# print $tmp_file "Row the while loop: ". Data::Dumper->Dump([$id]) . "";
# my $id = 12121212;
# push(#allowed_locations, $id);
# }
# print $tmp_file "After the while loop: ref(st)='". ref($st) . "\n";
# my($a) = 1;
#} else {
# my($a) = 0;
}
#print $tmp_file "After the if: ". Data::Dumper->Dump([\#allowed_locations, $id_client]) . "";
close($tmp_file) or die "Can not close file: $!\n";
#&html_error(#allowed_locations);
First off all, somebody said that I should try to run it in command line, the script works fine in command line (no warnings, It was uncommented then), but when triyng to load in via apache in the browser it fails, please see this video where I captured the script behavior, what I tried to show in the video:
I have opened 2 tabs the first doesn't define the variable $id_client, the second defines the variable $id_client that is read from GET: ?id_client=36124 => $id_client = 36124; , both of them include the library in the video "locallib.pl"
When running the script with all the
new code commented the page loads
when uncoment the line that defines
the #allowed_locations = (); the
script fails
leave this definition and uncoment
the if block, and the definition of
my $a; in the if block; Now the script works fine when $id_client is
defined, but fails when $id_client
is not defined
Uncoment the else block and the
definition of my $a; in the else
block. Now the script works fine
with or without $id_client
now comment all the my $a;
definisions and comment the else
block, the script fails
but if I'm using open() to open
a file before the IF, and
close() to close it after the if it does't fail even if the IF block
is empty and event if there is no
else block
I have replicated all the steps when running the script in the command line, and the script worked after each step.
I know it sounds like something that cannot be the behavior of the script, but please watch the video (2 minutes), maybe you will notice something that I'm doing wrong there.
Using perl version:
[root#db]# perl -v
This is perl, v5.8.6 built for i386-linux-thread-mult
Somebody asked if I don't have a test server, answer: NO, my company has a production server that has multiple purposes, not only the web interface, and I cannot risk to update the kernel or the perl version, and cannot risk instaling any debuger, as the company owners say: "If it works, leave it alone", and for them the solution with my ($a); is perfect beacause it works, I'm asking here just for me, to learn more about perl, and to understand what is going wrong and what can I do better next time.
Thank you.
P.S. hope this new approach will restore some of my -1 :)
EDIT:
I had success starting the error logging, and found this in the error log after each step that resulted in a failure I got this messages:
[Thu Jul 15 14:29:19 2010] [error] locallib.pl did not return a true value at /var/www/html/rdsdb4/cgi-bin/clients/quicksearch.cgi line 2.
[Thu Jul 15 14:29:19 2010] [error] Premature end of script headers: quicksearch.cgi
What I found is that this code is at the end of the main code in the locallib.pl after this there are sub definitions, and locallib.pl is a library not a program file, so it's last statement must returns true. , a simple 1; statement at the end of the library ensures that (I put it after sub definitions to ensure that noobody writes code in the main after the 1;) and the problem was fixed.
Don't know why in CLI it had no problem ...
Maybe I will get a lot of down votes now ( be gentle :) ) , but what can I do ...and I hope that some newbies will read this and learn something from my mistake.
Thank you all for your help.
You need to explicitly check for definedness.
If you want to enter the loop when $client is defined,
use if ( defined $client ).
If you want to enter the loop when $client is defined and a valid integer,
use if ( defined $client && $client =~ /^-?\d+$/ ).
I assume it's an integer from the context, if it can be a float, the regex needs to be enhanced - there's a standard Perl library containing pre-canned regexes, including ones to match floats. If you require a non-negative int, drop -? from regex's start.
If you want to enter the loop when $client is defined and a non-zero (and assuming it shouldn't ever be an empty string),
use if ( $client ).
If you want to enter the loop when $client is defined and a valid non-zero int,
use if ( $client && $client =~ /^-?\d+$/ ).
Your #ids is "undef" when if condition is false, which may break the code later on if it relies on #ids being an array. Since you didn't actually specify how the script breaks without an else, this is the most likely cause.
Please see if this version works (use whichever "if" condition from above you need, I picked the last one as it appears to match the closest witrh the original code's intent - only enter for non-zero integers):
UPDATED CODE WITH DEBUGGING
use Data::Dumper;
open(my $tmp_file, ">", "/tmp/some_bad.log") or die "Can not open log file: $!\n";
#ids = (); # Do this first so #ids is always an array, even for non-client!
print $tmp_file "Before the if: ". Data::Dumper->Dump([\#ids, $client]) . "\n";
if ( $client && $client =~ /^-?\d+$/ ) # First expression catches undef and zero
{
print $tmp_file "Start the if: ". Data::Dumper->Dump([\#ids, $client]) . "\n";
my $st = &sql_query("select id from table where client=$client");
print $tmp_file "Before the while loop: ref(st)='". ref($st) . "'\n";
while(my $row = $st->fetchrow())
{
print $tmp_file "Row the while loop: ". Data::Dumper->Dump([row]) . "'\n";
push(#ids, $row->[0]);
}
print $tmp_file "After the while loop: ref(st)='". ref($st) . "'\n";
# No need to undef since both variables are lexically in this block only
}
print $tmp_file "After the if\n";
close($tmp_file) or die "Can not close file: $!\n";
when checking against a string, == and != should be respectively 'eq' or 'ne'
if( $client != "" )
should be
if( $client ne "" )
Otherwise you don't get what you're expecting to get.
Always begin your script with :
use warnings;
use strict;
these will give you usefull informations.
Then you could write :
my #ids;
if (defined $client) {
#ids = (); # not necessary if you run this part only once
my $st = sql_query("select id from table where client=$client");
while( my ($id) = $st->fetchrow ) {
push #ids, $id;
}
} else {
warn '$client not defined';
}
if (#ids) { # Your query returned something
# do stuff with #ids
} else {
warn "client '$client' does not exist in database";
}
Note: this answer was deleted because I consider that this is not a real question. I am undeleting it to save other people repeating this.
Instead of
if( $client != "" )
try
if ($client)
Also, Perl debugging is easier if you
use warnings;
use strict;
What I found is that this code is at the end of the main code in the locallib.pl after this there are sub definitions, and locallib.pl is a library not a program file, so it's last statement must returns true, a simple 1; statement at the end of the library ensures that (put it after sub definitions to ensure that noobody writes code in the main after the 1;) and the problem was fixed.
The conclusion:
I have learned that every time you write a library or modify one, ensure that it's last statment returns true;
Oh my... Try this as an example instead...
# Move the logic into a subroutine
# Forward definition so perl knows func exists
sub getClientIds($);
# Call subroutine to find id's - defined later.
my #ids_from_database = &getClientIds("Joe Smith");
# If sub returned an empty list () then variable will be false.
# Otherwise, print each ID we found.
if (#ids_from_database) {
foreach my $i (#ids_from_database) {
print "Found ID $i \n";
}
} else {
print "Found nothing! \n";
}
# This is the end of the "main" code - now we define the logic.
# Here's the real work
sub getClientIds($) {
my $client = shift #_; # assign first parameter to var $client
my #ids = (); # what we will return
# ensure we weren't called with &getClientIds("") or something...
if (not $client) {
print "I really need you to give me a parameter...\n";
return #ids;
}
# I'm assuming the query is string based, so probably need to put it
# inside \"quotes\"
my $st = &sql_query("select id from table where client=\"$client\"");
# Did sql_query() fail?
if (not $st) {
print "Oops someone made a problem in the SQL...\n";
return #ids;
}
my #result;
# Returns a list, so putting it in a list and then pulling the first element
# in two steps instead of one.
while (#result = $st->fetchrow()) {
push #ids, $result[0];
}
# Always a good idea to clean up once you're done.
$st->finish();
return #ids;
}
To your specific questions:
If you want to test if $client is defined, you want "if ( eval { defined $client; } )", but that's almost certainly NOT what you're looking for! It's far easier to ensure $client has some definition early in the program (e.g. $client = "";). Also note Kaklon's answer about the difference between ne and !=
if (X) { stuff } else { } is not valid perl. You could do: if (X) { stuff } else { 1; } but that's kind of begging the question, because the real issue is the test of the variable, not an else clause.
Sorry, no clue on that - I think the problem's elsewhere.
I also echo Kinopiko in recommending you add "use strict;" at the start of your program. That means that any $variable #that %you use has to be pre-defined as "my $varable; my #that; my %you;" It may seem like more work, but it's less work than trying to deal with undefined versus defined variables in code. It's a good habit to get into.
Note that my variables only live within the squiggliez in which they are defined (there's implicit squiggliez around the whole file:
my $x = 1;
if ($x == 1)
{
my $x = 2;
print "$x \n"; # prints 2. This is NOT the same $x as was set to 1 above.
}
print "$x \n"; # prints 1, because the $x in the squiggliez is gone.