For example, I am running standalone Blast+ for thousands of EST sequences with remote (NCBI) server. I am not getting any status message like 15 of 100 sequence is running. Is it possible to get any status message like that? or any other way to send one after another sequence using perl scripts?
Many thanks!
I suggest using Bioperl (http://metacpan.org/pod/BioPerl) and the Bio::Tools::Run::RemoteBlast module. See http://metacpan.org/pod/Bio::Tools::Run::RemoteBlast and here is the code example they give in the RemoteBlast.pm module
while (my $input = $str->next_seq()){
#Blast a sequence against a database:
#Alternatively, you could pass in a file with many
#sequences rather than loop through sequence one at a time
#Remove the loop starting 'while (my $input = $str->next_seq())'
#and swap the two lines below for an example of that.
my $r = $factory->submit_blast($input);
#my $r = $factory->submit_blast('amino.fa');
print STDERR "waiting..." if( $v > 0 );
while ( my #rids = $factory->each_rid ) {
foreach my $rid ( #rids ) {
my $rc = $factory->retrieve_blast($rid);
if( !ref($rc) ) {
if( $rc < 0 ) {
$factory->remove_rid($rid);
}
print STDERR "." if ( $v > 0 );
sleep 5;
} else {
my $result = $rc->next_result();
#save the output
my $filename = $result->query_name()."\.out";
$factory->save_output($filename);
$factory->remove_rid($rid);
print "\nQuery Name: ", $result->query_name(), "\n";
while ( my $hit = $result->next_hit ) {
next unless ( $v > 0);
print "\thit name is ", $hit->name, "\n";
while( my $hsp = $hit->next_hsp ) {
print "\t\tscore is ", $hsp->score, "\n";
}
}
}
}
}
}
Look at the method retrieve_blast (http://metacpan.org/pod/Bio::Tools::Run::RemoteBlast#retrieve_blast). It will return a status code to let you know if the blast job is finished. Let me know if you have more questions and I will try to clarify further.
Paul
Related
I've been trying to create a config file parser to parse Cisco IOS configs and such. The final objective would be to show relevant data in contexts based on filters in a configuration file. For example, with such a config file it would display all interfaces where we've found the line "access vlan" as a child of the "interface" context and only show lines containing "speed", "duplex" and "description".
{
'Context' => '^interface',
'Types' => [
'Switch',
],
'Condition' => 'access vlan',
'Filter' => [
'speed',
'duplex',
'description'
]
};
So far, so good. I read the "running-config" and I index the lines depth (given that a non-empty line , not beginning with a space (\s) has a depth of 0) in an array.
Then, in another read I use that index to read the data again, this time using relative position based on depth to create the "childs" of a context. Here's the function :
sub getDeep {
my #data = (#_);
my ($bighash,$hash);
#First read
foreach my $idx (0.. $#data) {
my ($spaces, $content) = ($data[$idx] =~ m/^(\s*)(.*)/);
my $depth = length $spaces;
$bighash->{node}{$idx}{depth} = $depth;
}
# Variables for the first read
my $ldepth = 0;
my $lcontext;
my $lid;
# Second read
foreach my $id (0 .. $#data) {
$data[$id] =~ s/^\s*//;
next if ($data[$id] =~ /^!/);
my $depth = $bighash->{node}{$id}{depth};
if ($depth eq 0) {
push (#{$hash->{global}} , $data[$id]);
$lcontext = $data[$id];
$lid = $id;
}
if (($depth gt 0) && ($id - $lid eq 1)) {
push (#{$hash->{$lcontext}}, (" " x $depth. $data[$id]));
$lid = $id;
}
}
return $hash;
}
Using this sub, I can return a hash, then based on the presence of an arrayref for a given key, apply filters as explained. This works pretty well, so far very proud of this piece of code.
Problem comes when I want to find childs of childs. In the example below, the childs of "given param2" would reprensent my next challenge.
interface XYZ
given param1 -> child of "interface XYZ"
given param2 -> child of "interface XYZ"
given param2.1 -> child of "given param2"
given param2.2 -> child of "given param2"
given param3 -> child of "interface XYZ"
So after thinking about this for a while and failing with different approaches, my question comes in 2 separate parts :
1) Is there a better way to do this that I'm not seeing ?
2) How could I keep tagging childs of childs as the lines dig deeper and identify them properly in a data structure ?
Thank you for reading up to this line :)
This thread contains the solution I was hoping for :) Since it might benefit to others, here's the link :
https://perlmonks.org/?node_id=1224600
Cheers !
I have written something to do exactly this. I can't figure out how to put it on metacpan. However, im sure there is better already on there if I knew where to look. It's on of the first i wrote in perl, so it's a bit of a mess. But basically you can type "gettree -l Node interface" and on a XR device it'll pull all of the config. "gettree -s Node Description_keyword" will pull all of a single interface config. you can also use it with STDIN e.g., "cat file | gettree -l interface".
Program
#!/usr/bin/perl
use lib '/PATH_TO_Gettree.pm_MODULE/';
use strict;
use warnings;
use Gettree;
use Getopt::Std;
my %opts;
getopts('eislnpm' , \%opts);
my $searchstr;
my $filename;
my $debug=0;
if($ARGV[0]=~m/help/ || $ARGV[0]=~m/^\?$/ )
{ die usage(); }
if($#ARGV<0||$#ARGV>1)
{
usage();
killapp("Please specifiy node and search term, use --help for the help menu");
}
elsif($#ARGV==0)
{
Gettree::setopts( \%opts , \$ARGV[0] );
while(<STDIN>)
{
Gettree::gettree_stream_passline( \$_ );
}
print Gettree::gettree_getreturnstring();
}
else
{
$filename= $ARGV[0];
$filename="/CONFIGS_DIR/".lc $filename if ! $opts{e};
print Gettree::gettree_file ( \%opts , \$filename , \$ARGV[1]) ; #\$filename , $searchstring
}
sub killapp
{
print $_[0]."\n";
exit;
}
sub usage
{
print "
Usage: gettree [OPTION]... [NODE] STRING
Search for PATTERN in each FILE or standard input.
usage gettree <options> <node> <string>
-s include same level
-l include lower levels
-n show line numbers (do not use with STDIN, it wont work)
-i case insensitive
-e exact file location (rather than just the nodename)
-p print parent's same level lines
-m minimal print, do not print parents
Examples:
gettree Node text
gettree -sln NODE CCT_Ref
gettree -l NODE POS8/0
\n\n";
exit;
}
Module
#!/usr/bin/perl
package Gettree;
use strict;
use warnings;
my $line;
my $wsdiff = 0;
my $iopt = 0;
my $sopt = 0;
my $lopt = 0;
my $nopt = 0;
my $popt = 0;
my $mopt = 0;
my $linecounter = 0;
my $matched = -1;
my $debug = 0; ##remove later
my #arr;
my #sopt_arr;
my #popt_arr;
my $searchstr;
my $returnstring;
sub setopts # \%opthash , $searchstring
{
cleardata();
push #arr, [ 0, "",0];
my %hash=%{$_[0]};
$iopt = 1 if $hash{i};
$sopt = 1 if $hash{s};
$lopt = 1 if $hash{l};
$nopt = 1 if $hash{n};
$popt = 1 if $hash{p};
$mopt = 1 if $hash{m};
if ( defined $hash{qopts} )
{
$iopt = 1 if $hash{qopts} =~ /i/;
$lopt = 1 if $hash{qopts} =~ /l/;
$nopt = 1 if $hash{qopts} =~ /n/;
$sopt = 1 if $hash{qopts} =~ /s/;
$popt = 1 if $hash{qopts} =~ /p/;
$mopt = 1 if $hash{qopts} =~ /m/;
}
if ( ref($_[1]) ) { $searchstr=$iopt? qr/${$_[1]}/i : qr/${$_[1]}/ ; }
else { $searchstr=$iopt? qr/$_[1]/i : qr/$_[1]/ ; }
}
sub gettree_stream_passline # \$line
{
process_line(${$_[0]});
}
sub gettree_getreturnstring
{
return $returnstring;
}
sub gettree_varable # \%opthash , \$text , $searchstring
{
setopts($_[0] , $_[2]);
my $str=${$_[1]};
while($str=~m#(.*\n)#g)
{
process_line($1);
}
return $returnstring;
}
sub gettree_file # \%opthash , \$filename , $searchstring
{
setopts($_[0] , $_[2]);
my $filename;
if ( ref($_[1]) ) { $filename=${$_[1]}; }
else { $filename=$_[1] ; }
open FH, "<", $filename or die "\nFile ".$filename." cannot be found\nerror : ".$!."\n";
while(my $text=<FH>)
{
process_line($text);
}
close FH;
return $returnstring;
}
sub process_line
{
$line=shift;
if($line=~m/^([ \t]+)/) { $wsdiff=length($1) }
else { $wsdiff=0 };
if($wsdiff>$arr[$#arr][0])
{
push #arr, [ $wsdiff , $line , $linecounter ];
if ( $sopt || $popt )
{
#popt_arr=#sopt_arr if $popt;
#sopt_arr=() if defined $sopt_arr[0];
}
}
else
{
while( #arr && $arr[$#arr][0]>$wsdiff )
{
pop #arr;
#sopt_arr=#popt_arr if ( $sopt || $popt );
#popt_arr=() if $popt;
}
if($#arr<0)
{
push #arr, [ $wsdiff , $line, $linecounter ];
}
else
{
push #sopt_arr, $arr[$#arr] if $sopt || $popt ;
$arr[$#arr]=[ $wsdiff , $line , $linecounter ];
}
}
#sopt_arr=() if $#sopt_arr>200; ## to avoid filling the memory
#popt_arr=() if $#popt_arr>200; ## to avoid filling the memory
##used in l and s opts to print lines after match
if($matched>=0)
{
if($wsdiff>$matched)
{
printline(\$line) if $lopt==1 ;
}
elsif ($wsdiff<$matched)
{
$matched=-1;
}
else
{
if ($sopt )
{ printline(\$line) }
else
{ $matched=-1 }
}
}
if( $matched==-1 && $line=~m/$searchstr/ )
{
printtree();
$matched=$wsdiff if $sopt || $lopt;
}
$linecounter++;
}
sub printtree
{
if(!$mopt)
{
for (0..$#arr-(1+$popt))
{
printline( \$arr[$_][1] , \$arr[$_][2] );
}
}
if($popt)
{
for (0..$#popt_arr)
{
printline( \$popt_arr[$_][1] , \$popt_arr[$_][2] );
}
printline( \$arr[$#arr-1][1] , \$arr[$#arr-1][2] ); #print the parent
#popt_arr=() ;
}
if($sopt)
{
for (0..$#sopt_arr)
{
printline( \$sopt_arr[$_][1] , \$sopt_arr[$_][2] );
}
#sopt_arr=() ;
}
printline( \$arr[$#arr][1] , \$arr[$#arr][2] );
#arr=();
push #arr, [ $wsdiff , $line , $linecounter ];
}
sub printline
{
$nopt==1? $returnstring.= ${$_[1]}+1 ." : ".${$_[0]} : $returnstring.= ${$_[0]};
}
sub cleardata
{
$line="";
$wsdiff = 0;
$iopt = 0;
$sopt = 0;
$lopt = 0;
$nopt = 0;
$popt = 0;
$mopt = 0;
$linecounter = 0;
$matched = -1;
#arr=();
#sopt_arr=();
#popt_arr=();
$searchstr="";
$returnstring="";
}
1;
Breif explanation how it works
The program is just a link to the module. I's a module because i've used it in many programs and stand alone. Gettree.pm will send data line by line to process_line(). process line will get the white-space ($wsdiff) and use this as a marker. any line directly before an increment in whitespace will be stored in #arr. for printing if a match is found later. so the parent is stored. #sopt_arr is for the same line, so it stores previous lines of the same white-space. #popt_arr is for the parent match, but this doesn't work very well (i dont really use it, it could be removed). when a match for the search string is made, #arr,Sopt_arr, & #popt_arr are printed, $matched is set, this will be used for -l option. all lines after the match are printed until the white-space is < the matched white-space. so in summary, it will take each unique white-space before an increment. it works for Juniper and Alcatel too. I'm sure it would work on others too.
remember to modify CONFIGS_DIR and PATH_TO_Gettree.pm_MODULE to match your filesystem paths
I am making a score-keeping script in Perl, and would like to have it ask how many players there are, and ask for a name, then score, for each player. I have a good bit of this script done, but only for 3 players. the current script can be found on github here: skore
(from link:)
#!/usr/bin/env perl
use strict;
my $version = "1.0";
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
$subname =~ s/-/_/g;
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
if (!defined($sub))
{
print STDERR "Invalid command given.\nUse \e[1;32m./skore help\e[0m for a list of commands.\n";
exit 1;
}
else
{
$sub->(#ARGV);
exit 0;
}
# Main command
sub cmd_go()
{
print "\e[2J\e[0G\e[0d"; # J = Erase in Display, 2 = Entire Screen, (G, d) = Move cursor to (..,..)
print "••••••••••••••••••••\n";
print "• Welcome to \e[1;32mskore\e[0m •\n";
print "••••••••••••••••••••\n\n";
my #game = prompt("What game are we scoring?\n");
print "••• Game name locked: #game\n\n";
my #p1name = prompt("Player 1 name?\n");
my #p2name = prompt("Player 2 name?\n");
my #p3name = prompt("Player 3 name?\n");
print "\n";
print "••• Player names locked: #p1name #p2name #p3name\n\n";
my #p1score = prompt_num("score for #p1name?\n");
my #p2score = prompt_num("score for #p2name?\n");
my #p3score = prompt_num("score for #p3name?\n");
print "\n";
print "••• Game: #game\n";
print "••• #p1name\n";
print "••••• \e[1;32m#p1score\e[0m\n";
print "••• #p2name\n";
print "••••• \e[1;32m#p2score\e[0m\n";
print "••• #p3name\n";
print "••••• \e[1;32m#p3score\e[0m\n";
exit 1;
}
sub cmd_help()
{
print "To get right into using skore, simply type ./skore\n";
print "For details about skore, such as version, use ./skore pkg\n";
}
sub cmd_pkg()
{
print "skore version: $version\n";
print "Detected OS: ";
exec "uname -r";
}
sub prompt {
my ($query) = #_; # take a prompt string as argument
local $| = 1; # activate autoflush to immediately show the prompt
print $query;
chomp(my $answer = <STDIN>); return $answer;
}
sub prompt_num {
NSTART:
my ($querynum) = #_;
print $querynum;
chomp(my $pnum = <STDIN>);
if ($pnum eq $pnum+0) { return $pnum; }
else { print "Error: That is not a number. Try again.\n"; goto NSTART; }
}
sub prompt_yn {
my ($queryyn) = #_;
my $answer = prompt("$queryyn (y/N): ");
return lc($answer) eq 'y';
}
I'd like to also point out that I'm new to perl.
OK, wow. Stop for a moment, step back and put the code down. Think about what you're trying to accomplish here.
There's a bunch of things you're doing in your code that's really going to benefit from taking a step back, and understanding what's going on, before proceeding.
First off:
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
What is this intended to do? You only use $arg 3 times here, and one of those is to copy it to $subname.
This could be quite simplified by:
my $subname = shift;
cmd_go() unless defined $subname;
Now this:
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
Where did that come from? Because I'm pretty sure that - as a beginner to perl - you didn't write that yourself, not least because you don't have any subroutines prefixed with dev_ or hid. And this sort of redirect is serious overkill for a program that basically does just one thing.
(And normally, you'd use flags like getopt rather than a command that you leave blank in a default state).
You are also massively overusing arrays - which suggests you're not really sure the difference between #game and $game.
E.g. this:
my #game = prompt("What game are we scoring?\n");
prompt does this though:
chomp(my $answer = <STDIN>); return $answer;
It returns a scalar (a single line) and you're putting it into an array for - as far as I can tell - no particular reason.
Likewise this:
my #p1score = prompt_num("score for #p1name?\n");
my #p2score = prompt_num("score for #p2name?\n");
my #p3score = prompt_num("score for #p3name?\n");
First off - you're using a bunch of single element arrays. But then you're numbering them. When ... actually, the whole point of arrays is to have numbered values.
So how about instead:
print "Num players?:\n";
chomp ( my $num = <STDIN> );
my #players;
my %scores;
for ( 1..$num ) {
print "Player name\n";
chomp ( my $name = <STDIN> );
push ( #players, $name );
}
foreach my $person ( #players ) {
print "Score for $person:\n";
chomp ( my $score = <STDIN> );
while ( $score =~ /\D/ ) {
print "Invalid - please enter numeric value\n";
chomp ( $score = <STDIN> );
}
$scores{$person} = $score;
}
foreach my $person ( #players ) {
print "$person => $score{$person}\n";
}
There are a bunch of other things that you're doing that is more complicated than it needs to be.
What I would suggest you do:
go re-read the perl basics. perldata in particular.
have a look at getopt which is a good (and standard) way to take program 'flag' style input. (e.g. showing version, if that's what you really want.
it looks a lot like you've cargo-culted the code here. I would suggest you re-write from the ground up, and when you hit a problem - ask about it on Stack Overflow, if you can't figure it out from the perl docs.
Try this. Hope this is what you wanted.
#!/usr/bin/env perl
use strict;
my $version = "1.0";
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
$subname =~ s/-/_/g;
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
if (!defined($sub))
{
print STDERR "Invalid command given.\nUse \e[1;32m./skore help\e[0m for a list of commands.\n";
exit 1;
}
else
{
$sub->(#ARGV);
exit 0;
}
# Main command
sub cmd_go()
{
print "\e[2J\e[0G\e[0d"; # J = Erase in Display, 2 = Entire Screen, (G, d) = Move cursor to (..,..)
print "••••••••••••••••••••\n";
print "• Welcome to \e[1;32mskore\e[0m •\n";
print "••••••••••••••••••••\n\n";
my #game = prompt("What game are we scoring?\n");
print "••• Game name locked: #game\n\n";
my $players= prompt("Enter total number of players:\n");
my #players_list;
for(my $i=0;$i<$players;$i++){
push(#players_list , prompt("Enter Player ".($i+1)." name\n"));
}
print "\n";
print "••• Player names locked: ";
for(my $i=0;$i<$players;$i++){
print $players_list[$i]."\t";
}
print "\n\n";
my #players_score;
for(my $i=0;$i<$players;$i++){
push(#players_score, prompt("score for $players_list[$i]?\n"));
}
print "\n";
print "••• Game: #game\n";
for(my $i=0;$i<$players;$i++){
print "$players_list[$i]\n";
print "••••• \e[1;32m$players_score[$i]\e[0m\n";
}
exit 1;
}
sub cmd_help()
{
print "To get right into using skore, simply type ./skore\n";
print "For details about skore, such as version, use ./skore pkg\n";
}
sub cmd_pkg()
{
print "skore version: $version\n";
print "Detected OS: ";
exec "uname -r";
}
sub prompt {
my ($query) = #_; # take a prompt string as argument
local $| = 1; # activate autoflush to immediately show the prompt
print $query;
chomp(my $answer = <STDIN>); return $answer;
}
sub prompt_num {
NSTART:
my ($querynum) = #_;
print $querynum;
chomp(my $pnum = <STDIN>);
if ($pnum eq $pnum+0) { return $pnum; }
else { print "Error: That is not a number. Try again.\n"; goto NSTART; }
}
sub prompt_yn {
my ($queryyn) = #_;
my $answer = prompt("$queryyn (y/N): ");
return lc($answer) eq 'y';
}
I am trying to build a program wich creates some forks and writes the results of the forks back to the main program. Thereby I try to use IO::Pipe
sub ForkRequests {
my $pipe = IO::Pipe->new();
my $pid;
foreach my $feature ( #features ) {
if ( $pid = fork() ) {
$pipe->reader();
while ( <$pipe> ) {
print $_. "\n";
}
}
elsif ( defined $pid ) {
#child
$pipe->writer();
#somecalculations [...]
print $pipe $calcresults;
}
}
}
I got my code for doing a pipe from the module's documentation.
If i now try to execute, I get an error message
Can't locate object method "reader" via package "IO::Pipe::End" at lmtest3.pl line 56.
Can't locate object method "writer" via package "IO::Pipe::End" at lmtest3.pl line 63.
Can't locate object method "reader" via package "IO::Pipe::End" at lmtest3.pl line 56, <GEN0> line 1.
Can't locate object method "writer" via package "IO::Pipe::End" at lmtest3.pl line 63, <GEN0> line 1.
So, my code does not seem to initiate a pipe object, but an IO::Pipe::End.
So my question is, can anybody see the mistake in there? Why does it return the wrong object, and how would this be done correctly?
EDIT
I have some requests to some servers (most of the time 1 request to 7 ervers).
Those request names are saved in #features, and will be executed at the point of #somecalculations.
Because the server response is pretty slow, I want those requests to start in parallel. They all have to get back to the main program and print the reply to the console.
I tried this code
sub ForkRequests {
my $i = 0;
my #pipes;
my $pid;
foreach my $feature ( #features ) {
#pipes[$i] = IO::Pipe->new();
if ( $pid = fork() ) {
#pipes[$i]->reader();
}
elsif ( defined $pid ) {
#child
#pipes[$i]->writer();
# calculations
my $w = #pipes[$i];
print $w $calc;
print $w "end\n";
}
$i++;
}
}
if ( $pid == 1 ) {
while ( 1 ) {
foreach my $pipe ( #pipes ) {
while ( <$pipe> ) {
unless ( $_ == "end" ) {
print $_. "\n";
}
else { last; }
}
}
}
}
else {
exit;
}
}
as said, to save those pipes, but I still got a problem in reading them, as the program exits before it gets answers.
The problem is that you are forking multiple child processes but trying to use the same pipe for all of them.
The reader method converts $pipe into an IO::Pipe::End object that you can read data from, so the first child is connected correctly. But you then call reader again on the same $pipe, and the error is thrown because it is no longer an object of the right class.
You simply need to create a new pipe for each child process:
sub fork_requests {
for my $feature ( #features ) {
my $pipe = IO::Pipe->new;
my $pid;
if ( $pid = fork ) {
$pipe->reader;
print while <$pipe>;
}
elsif ( defined $pid ) {
$pipe->writer;
# some calculations . . .
print $pipe $calcresults;
exit;
}
}
}
Update
Okay I think I understand what it is you need. This complete program should show you.
I have written fork_requests so that it expects a list of features as parameters, and I have written the child code so that it sleeps for two seconds to emulate the processing time and then simply prints the name of the feature.
The parent code stores all the pipes in an array, as I suggested, and prints the output from each of them in the order they were queued. All five child processes complete after two seconds, so the parent is suspended for that time and then prints the features originally passed in.
use strict;
use warnings;
use IO::Pipe;
STDOUT->autoflush;
fork_requests('A' .. 'E');
sub fork_requests {
my #pipes;
for my $feature ( #_ ) {
my $pipe = IO::Pipe->new;
my $pid;
if ( $pid = fork ) {
$pipe->reader;
push #pipes, $pipe;
}
elsif ( defined $pid ) {
$pipe->writer;
select $pipe;
# some calculations . . .
sleep 2;
my $calcresults = $feature;
print $calcresults, "\n";
exit;
}
}
for my $pipe ( #pipes ) {
print while <$pipe>;
}
}
output
A
B
C
D
E
foreach (#raw_data) {
if ($raw_data[$count] =~ /Date/) {
#dur = split(/:/, $raw_data[$count]);
$durtime = "$dur[1]" . ":" . "$dur[2]" . ":$dur[3]";
#dur = split(/,/, $durtime);
$startlocaltime = $dur[1];
$starttime = str2time($dur[1]);
# $starttime=10000;
$count++;
$status = "PASS";
if ($raw_data[$count] =~ /Command/) {
#cmdsyntax = split(/:/, $raw_data[$count]);
$cmdcount++;
#Splitting Command name
#cmdname = split(/\(/, $cmdsyntax[1]);
$cmdlog = $cmdsyntax[1] . "\n";
$count += 2;
#Parsing for command output
while ($raw_data[$count] =~ /[COMPLETED]/) {
#Checking status of commmand
if ($raw_data[$count] =~ /Error/i) {
$status = "FAIL";
}
if ($raw_data[$count] =~ s/\"/\'/g) {
$raw_data[$count] = $raw_data[$count];
}
if ($raw_data[$count] =~ s/&/ /g) {
$raw_data[$count] = $raw_data[$count];
}
#Forming comandlog
$cmdlog .= $raw_data[$count] . "\n";
$count++;
}
#Changes Added
my $xyz = "false";
if ($raw_data[$count] =~ /^GetFTSJOBStatusResult/) {
my $xyz = "true";
next;
}
if ($xyz =~ /true/) {
if ($line =~ /.*,([A-Za-z]*),.*/) {
$status = $1;
if ($status = ~/ACTIVE/) {
sleep(1000);
system("/bin/sh /tmp/uday/cliTestExecution1.sh 135.250.70.161 alcatel Linux1.* 11.54");
goto START;
}
}
}
#Changes ends
$cmdlog .= $raw_data[$count] . "\n";
$count++;
}
I have two test cases in log file ActivateJob and GetJOBStatus as below.
My Perl script currently sets PASS as default and searches for Error in the below test cases.
If it finds an error it marks the test case as FAIL.
For GetJOBStatus test case if it is ACTIVE script has to sleep for couple of mins and it has to perform GetJOBStatus again, and if it is success test case has to be passed or else fail.
I have tried by adding sleep for few seconds and again calling script, but this is not working.
Please help me out in finding the right logic.
log file
Date and Time is:Thu, 20-06-2013 06:04:19
Line 4 Command:ActivateJob(Job=Test_Abort_New1);
Answer:
ActivateFTSJobResult = Success
COMPLETED
Date and Time is:Thu, 20-06-2013 06:04:19
Line 5 Command:GetJOBStatus(Job=Test_Abort_New1);
Answer:
GetJOBStatusResult = NELabel,Status,ErrorReason,Progress,CurrentUnit,Total
TSS_320_1,ACTIVE,No Error,0,BACKUP.DSC,0
COMPLETED
if ($status = ~/ACTIVE/)
Is not a regex check, the space is in the wrong place. Without strict or warnings, it'll likely treat '~/ACTIVE/' as a bareword string then assign it to $status.
How to make script very interactive?
Script purpose:
Get user entered number and find mod via get_mod_val function; if it returns 1 then say "good" and exit the script; if it returns 0, then ask user to enter odd number.
Validation:
accept only numbers, no character, decimal, special characters.
do not end the script until user has entered the odd number.
The following code works fine; it follows above validation point 1 rules, but it is not very interactive as per our requirement law. When above rules fails, script exits and we need to execute the script again.
How can we make the following code very interactive?
$ip_no = $ARGV[0];
if ($ip_no!="") {
$get_mod_op = get_mod_val($ip_no);
if ($ip_no =~ /\D/){
print "Entered number only.....";
exit;
}else{
if ($get_mod_op==1) {
print "Good odd number(${get_mod_op}): ${ip_no} ";
exit;
}else{
print "Good even number(${get_mod_op}): ${ip_no} ";
exit;
}
}
}else{
print "Enter number.";
exit;
}
Thank to all, finally i have done the code with your suggestions, Following snippet reached my requirement, review the code and advise for optimization.
if ($ARGV[0] != "") {
$user_ip = $ARGV[0];
}elsif (($ARGV[0] =~ /\D/ ) || ($ARGV[0] eq "") ){
print "Enter odd number only: ";
$user_ip = <STDIN>;
}else{
$user_ip = <STDIN>;
}
do{ #get mod value, if mod_off is 1 then entered number is odd otherwise ask user to enter the odd number
$mod_off = find_mod_val($user_ip);
if (($user_ip == "") || ($user_ip eq "") || ($user_ip eq "") || ($mod_off == 0)) {
print "Enter odd number only: ";
$user_ip = <STDIN>;
}
}until($mod_off == 1);
print "Good odd number ${user_ip}";
sub find_mod_val($user_ip){
return $user_ip%2;
}
__END__
TIMTOWTDI, this time with recursion! The benefit is that you can reuse the function to validate other inputs too. I guess you could make a sub that wraps a loop, but c'mon this is fun!
sub get_input {
my ($message, $valid) = #_;
print "$message: ";
chomp(my $response = <>);
unless( $response =~ $valid ) {
print "Invalid response!\n";
$response = get_input($message, $valid);
}
return $response;
}
my $response = get_input("Enter a number", qr/^\d+$/);
print "Got: $response\n";
Don't use ARGV[0] and read from STDIN (so you need to run your script and type the word you want). I have rewritten your code:
my $finish = 0;
while( ! $finish ) {
print "Enter number.";
my $ip_no = <STDIN>;
chomp($ip_no);
$get_mod_op = get_mod_val($ip_no);
if( $ip_no =~ /\D/ ){
print "Entered number only.....";
}
elsif( $get_mod_op == 1 ) {
print "Good odd number(${get_mod_op}): ${ip_no} ";
$finish = 1;
}
else {
print "Good even number(${get_mod_op}): ${ip_no} ";
$finish = 1;
}
}
Are you sure you want it to be interactive; doing that makes it much less useful in other scripts.
If you must, then put the testing code into a sub, then use the sub to validate $ARGV[0], and if that fails, go into a loop that requests input and runs the validation.
Check out the Perl IO::Prompt module.
my $val;
for (;;) {
print "Some prompt: ";
$val = <STDIN>;
chomp $val;
last if is_valid($val);
print "Bad input. Valid inputs are ...\n";
}