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.
Related
I have a simple server application written in Perl. Here's the working version of it.
my $client;
while ($client = $local->accept() ) {
print "Connected: ", $client->peerhost(), ":", $client->peerport(), "\n";
while (<$client>) {
if ($mod_ctr == -1) {
$num_count = $_;
init();
}
elsif ($mod_sayaci % 2 == 0) {
$plus_count = $_;
}
elsif ($mod_sayaci % 2 == 1) {
$minus_count = $_;
eval();
}
last if m/^q/gi;
$mod_sayaci++;
}
print "Server awaits..\n";
}
I'm positive this works perfectly. Now, When I change my code to take a starting char from the client to determine the operation instead of using mod:
my $client;
while ($client = $local->accept() ) {
print "Connected: ", $client->peerhost(), ":", $client->peerport(), "\n";
$input;
$operation;
$value;
while ($input = <$client>) {
$operation = substr($input, 0, 1);
$value = substr($input, 1, 1);
print "input: $input \n";
print "operation: $operation \n";
print "value: $value \n";
if ($operation == "r") {
print "entered r \n";
$num_count = $value;
init();
}
elsif ($operation == "a") {
print "entered a \n";
$plus_count = $value;
}
elsif ($operation == "e") {
print "entered e \n";
$minus_count = $value;
eval();
}
elsif ($operation == "q") {
# will quit here
}
}
print "Server awaits..\n";
}
At the client side, I make the user start with the request which sends r as operation. Everything works fine until now. After the first input, input, operation and value prints work fine, but it always enters the first if and prints entered r. What am I missing here?
You have changed from using numbers to using strings to dictate which of the branches should be executed. You need to use eq instead of == to do string comparisons.
Like this
if ($operation eq "r") {
print "entered r\n";
$num_count = $value;
init();
}
etc.
Also, you would be doing yourself and anyone who helps you a big favour if you added
use strict;
use warnings;
to the top of every Perl program you write. The "declarations"
$input;
$operation;
$value;
don't do anything useful except as a comment to say which variables are used within the block. Write this
my ($input, $operation, $value);
and you have done something much more useful.
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
I'm trying to parse through the file and collecting types of mismatches in the different modules and generating an xls. Below is the report pattern i need to parse( but actual report pattern is not simple as below):
outsocket ports in design1 not in design2
a
b
Insocket ports in design1 not in design2
g
h
There can be many design name(pushed to module list using $module) in the log but this pattern will not change.(Insocket/outsocket/othertype ports in <> not in <>)
Below is my core code.I'm facing issue with this code and it is not working(especially string concatenation) as expected please help me fix this.
while ($line = <FH>) {
if ( $line =~ /Insocket(\s*)ports(\s*)in(\s*)${design1}(\s*)not(\s*)in(\s*)${design2}/) {
$mismatch_type = "type_i_n";
}
elsif ($line =~ /Insocket(\s*)ports(\s*)in(\s*)${design2}(\s*)not(\s*)in(\s*)${design1}/) {
$mismatch_type = "type_i_r";
}
elsif ( $line =~ /outsocket(\s*)ports(\s*)in(\s*)${design2}(\s*)not(\s*)in(\s*)${design1}/ ) {
$mismatch_type = "type_o_n";
}
elsif ( $line =~ /outsocket(\s*)ports(\s*)in(\s*)${design1}(\s*)not(\s*)in(\s*)${design2}/ ) {
$mismatch_type = "type_o_r";
}
$result = $mismatch_type . "_code_ " . $module;
$$result = $$result .$line;
if(!present_in_list ($module,#module_list)) {
push #module_list,$module;
}
push #mismatch_type_list,$mismatch_type;
}#PARSING OF FILE ENDS
#NOW PROCESSING THE RESULTS BASED ON PARSING
foreach $module (#module_list) {
foreach $each_mismatch (#mismatch_type_list) {
$result = $mismatch_type . "_code_ " . $module;
print FH2" $$result,";
}
}
Here are a couple of guesses and general suggestions. I'm not sure this will fix your problem, but it will probably help:
The first two regexes have an extra } in ${design1}} and ${design2}}. Not sure if this is present in your original program or if it's an error that was introduced in posting here.
It looks like you're using string concatenation to build up the name of a $result variable, so you can then use that string as the name of another variable like $type_i_n_code_module_a. I strongly recommend that to reduce confusion, that you use a hash instead:
%result = ();
while ($line = <FH>) {
...
$result_key = $mismatch_type . "_code_ " . $module;
$result{$result_key} = $result{$result_key} . $line;
}
...
foreach $module (#module_list) {
foreach $each_mismatch (#mismatch_type_list) {
$result_key = $mismatch_type . "_code_ " . $module;
print FH2" $result{$result_key},";
}
}
Consider the dataset below. Each chunk begining with a number is a 'case'. In the real dataset I have hundreds of thousands of cases. I'd like to replace the word "Exclusion" with "0" when there's only one word Exclusion in a case (e.g. case 10001).
If I loop through lines, I can count how many "Exclusions" I have in each case. But, if there's only one line with the word "Exclusion", I don't know how to get back to that line and replace the word.
How can I do that?
10001
M1|F1|SP1;12;12;12;11;13;10;Exclusion;D16S539
M1|F1|SP1;12;10;12;9;11;9;3.60;D16S
M1|F1|SP1;12;10;10;7;11;7;20.00;D7S
M1|F1|SP1;13;12;12;12;12;12;3.91;D13S
M1|F1|SP1;11;11;13;11;13;11;3.27;D5S
M1|F1|SP1;14;12;14;10;12;10;1.99;CSF
10002
M1|F1|SP1;8;13;13;8;8;12;2.91;D16S
M1|F1|SP1;13;11;13;10;10;10;4.13;D7S
M1|F1|SP1;12;9;12;10;11;16;Exclusion;D13S
M1|F1|SP1;12;10;12;10;14;15;Exclusion;D5S
M1|F1|SP1;13;10;10;10;17;18;Exclusion;CSF
sub process_block {
my ($block) = #_;
$block =~ s/\bExclusion\b/0/
if $block !~ /\bExclusion\b.*\bExclusion\b/s;
print($block);
}
my $buf;
while (<>) {
if (/^\d/) {
process_block($buf) if $buf;
$buf = '';
}
$buf .= $_;
}
process_block($buf) if $buf;
As you read the file, buffer up all lines in a case, and count exclusions,
my ($case,$buf,$count) = (undef,"",0);
while(my $ln = <>) {
Use a regex to detect a case,
if( $ln =~ /^\d+$/ ) {
#new case, process/print old case
$buf =~ s/;Exclusion;/;0;/ if($count==1);
print $buf;
($case,$buf,$count) = ($ln,"",0);
}
use a regex to detect 'Exclusion' now?
elsif( $ln =~ /;Exclusion;/ ) { $count++; }
$buf .= $l;
}
And when you are done, you may have a case left to process,
if( length($buf)>0 ) {
$buf =~ s/;Exclusion;/;0;/ if($count==1);
print $buffer;
}
This is the best I could think of. Assume you read your file into #lines
# separate into blocks
foreach my $line (#lines) {
chomp($line);
if ($line =~ m/^(\d+)/) {
$key = $1;
}
else {
push (#{$block{$key}}, $line);
}
}
# go through each block
foreach my $key (keys %block) {
print "$key\n";
my #matched = grep ($_ =~ m/exclusion/i, #{$block{$key}});
if (scalar (1 == #matched)){
foreach my $line (#{$block{$key}}) {
$line =~ s/Exclusion/0/i;
print "$line\n";
}
}
else {
foreach my $line (#{$block{$key}}) {
print "$line\n";
}
}
}
There're already many correct answers here, which use buffers to store the content of a "case".
Here's another solution using tell and seek to rewind the file, so buffers are not necessary. This could be useful when your "case" is very large and you're sensitive to the performance or memory usage.
use strict;
use warnings;
open FILE, "text.txt";
open REPLACE, ">replace.txt";
my $count = 0; # count of 'Exclusion' in the current case
my $position = 0;
my $prev_position = 0;
my $first_occur_position = 0; # first occurence of 'Exclusion' in the current case
my $visited = 0; # whether the current line is visited before
while (<FILE>) {
# keep track of the position before reading
# the current line
$prev_position = $position;
$position = tell FILE;
if ($visited == 0) {
if (/^\d+/) {
# new case
if ($count == 1) {
# rewind to the first occurence
# of 'Exclusion' in the previous case
seek FILE, $first_occur_position, 0;
$visited = 1;
}
else {
print REPLACE $_;
}
}
elsif (/Exclusion/) {
$count++;
if ($count > 1) {
seek FILE, $first_occur_position, 0;
$visited = 1;
}
elsif ($count == 1) {
$first_occur_position = $prev_position;
}
}
else {
print REPLACE $_ if ($count == 0);
}
if (eof FILE && $count == 1) {
seek FILE, $first_occur_position, 0;
$visited = 1;
}
}
else {
if ($count == 1) {
s/Exclusion/0/;
}
if (/^\d+/) {
$position = tell FILE;
$visited = 0;
$count = 0;
}
print REPLACE $_;
}
}
close REPLACE;
close FILE;
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";
}