I have the following Perl code::
#!/usr/bin/perl
use threads;
use Thread::Queue;
use DateTime;
$| = 1; my $numthreads = 20;
$min = 1;
$max = 100;
my $fetch_q = Thread::Queue->new();
our $total = 0;
sub fetch {
while ( my $target = $fetch_q->dequeue() ) {
print $total++ . " ";
}
}
my #workers = map { threads->create( \&fetch ) } 1 .. $numthreads;
$fetch_q->enqueue( $min .. $max );
$fetch_q->end();
foreach my $thr (#workers) {$thr->join();}
The code creates 20 threads and then increments a variable $total.
The current output is something like:
0 0 0 0 0 1 0 0 1 1 2 0 0 1 0 2 0 3 0 1 0 2 1 0 2 1 0 0 3 0
But the desired output is:
1 2 3 4 5 6 7 8 9 10 .... 30
Is there a way to have Perl increment the variable? The order does not matter (i.e. its fine if it is 1 2 4 5 3).
use threads::shared;
my $total :shared = 0;
lock $total;
print ++$total . " ";
Related
how to set rss correctly, can let all queue receive packets ?
this is my rss configure as follows:
.rxmode.mq_mode = ETH_MQ_RX_RSS;
.rx_adv_conf.rss_conf.rss_key = NULL; .rx_adv_conf.rss_conf.rss_hf = ETH_RSS_IP | ETH_RSS_UDP | ETH_RSS_TCP;
.txmode.mq_mode = ETH_MQ_TX_NONE;
but only queue 0 receive packets, other queues display 0 packets;
command as follows:
/root/dpdk-18.11/app/test-pmd/testpmd -w 0000:3c:00.0 -l 0-9 -n 4 -- --rxq=10 --txq=10 --rxd=256 --txd=4096 -i --nb-cores=9
testpmd> show port xstats all
NIC extended statistics for port 0
rx_good_packets: 56
tx_good_packets: 18
rx_good_bytes: 4932
tx_good_bytes: 1767
rx_missed_errors: 0
rx_errors: 0
tx_errors: 0
rx_mbuf_allocation_errors: 0
rx_q0packets: 56
rx_q0bytes: 4932
rx_q0errors: 0
rx_q1packets: 0
rx_q1bytes: 0
rx_q1errors: 0
rx_q2packets: 0
rx_q2bytes: 0
rx_q2errors: 0
rx_q3packets: 0
rx_q3bytes: 0
rx_q3errors: 0
rx_q4packets: 0
rx_q4bytes: 0
rx_q4errors: 0
rx_q5packets: 0
rx_q5bytes: 0
rx_q5errors: 0
rx_q6packets: 0
rx_q6bytes: 0
rx_q6errors: 0
rx_q7packets: 0
rx_q7bytes: 0
rx_q7errors: 0
rx_q8packets: 0
rx_q8bytes: 0
rx_q8errors: 0
rx_q9packets: 0
rx_q9bytes: 0
rx_q9errors: 0
I have recently been using perl (v5.10.1) on a Linux system to connect to a database and perform some tasks.
To do this more efficiently I have been using fork() to be able to perform the tasks in parallel. Whilst doing this I have noticed some problems if the child exits with some sort of error (killed by kill command, dies etc.)
I have searched the forum for possible explanations but have not found anything related to using fork() while connected to a database.
Below is my initial program structure. My actual code is more complex but this simplified code illustrates the idea.
use strict;
use warnings;
use utf8;
use APR::UUID ;
use DBI ;
use DBD::Oracle ;
use Data::Dumper;
$ENV{'ORACLE_HOME'} = "/home/data/ora11g2" ;
$ENV{'NLS_LANG'} = "french_france.AL32UTF8" ;
$ENV{'LANG'} = "fr_FR.utf-8" ;
my $IDJOB = APR::UUID->new->format ;
my $DB="DB_val";
my $SRV="SRV_val";
my %attr = (
PrintError => 1,
RaiseError => 0
);
my %attr_CHILD = (
PrintError => 1,
RaiseError => 0
);
my $db = DBI->connect("dbi:Oracle:$SRV/$DB", "user", "pword", \%attr ) or die "impossible de se connecter à $SRV / $DB";
$db->{AutoCommit} = 0 ;
$db->{InactiveDestroy} = 1; # This needs to be set to 1 if any parallel processing will be used.
# Otherwise database is disconnected in parent after children have finished.
my $Crash_Error_String='';
my #Res1;
eval{#Res1=Mainsub($db)};
#
$Crash_Error_String=$# unless #Res1 ;
$Res1[0] = 501 unless #Res1 ;
print "ERROR code:" . $Res1[0] . " (Error string:$Crash_Error_String)\n";
$db->commit if defined($db) ;
$db->disconnect if defined($db) ;
#
#
#
sub Mainsub{
my $db=shift;
#
my $Program_Termination_Code=0;
my #Results=(0,0,0,0);
my $Processes_To_Use_After_Calc=4;
my $fh1PR_E_filename_STEM="/tmp/error_file_Test_parallel_rows_" . $IDJOB . "_";
my $forked = 0;
my $err = 0;
my #child_pids_rows;
my #child_ispawns_rows;
my $start = time;
for my $ispawn (1 .. $Processes_To_Use_After_Calc){
my $ispawn_XML=$ispawn-1;
my $child_pid = fork();
if(!defined $child_pid){
$err++
} else {
push #child_pids_rows,$child_pid;
push #child_ispawns_rows,$ispawn;
}
if(defined $child_pid && $child_pid > 0) {
## Parent
$forked++;
} elsif(defined $child_pid){
my $db_child;
my $fh1PR_E_filename=$fh1PR_E_filename_STEM . $ispawn . ".err";
#$SIG{__DIE__} = $SIG{TERM} = $SIG{INT} = sub {
# my $ERROR_Val=$!;
# open(my $fh1PR_E, '>:encoding(UTF-8)', $fh1PR_E_filename);
# print $fh1PR_E "Caught an errorsignal: $ERROR_Val (child $ispawn)";
# close $fh1PR_E;
# $db_child->commit unless $db_child->{AutoCommit};
# $db_child->disconnect if defined($db_child);
# exit;
#};
my $ERROR_Code_child=0;
$db_child = DBI->connect("dbi:Oracle:$SRV/$DB", "user", "pword", \%attr_CHILD ) or die "impossible de se connecter à $SRV / $DB";
$db_child->{AutoCommit} = 0 ;
$db_child->commit unless $db_child->{AutoCommit} ;
#
#
#
#my $ased=4/0 if $ispawn==2 || $ispawn==1;
$db_child->commit unless $db_child->{AutoCommit} ;
$db_child->disconnect if defined($db_child) ;
exit;
} else {
## unable to fork
$err++;
}
}
my $Total_Children_Errors=0;
my $Total_Children_Exited=0;
my $Error_Messages="";
while (scalar #child_pids_rows) {
my $pid = $child_pids_rows[0];
my $ispawn=$child_ispawns_rows[0];
my $kid = waitpid $pid, 0;
my $ERROR_Count=0;
if($kid > 0){
my ($rc, $sig, $core) = ($? >> 8, $? & 127, $? & 128);
if ($core){
$ERROR_Count++;
$Total_Children_Errors++;
$Error_Messages eq "" ? $Error_Messages="$pid dumped core" : $Error_Messages=$Error_Messages . "\n" . "$pid dumped core";
} elsif($sig == 9){
$ERROR_Count++;
$Total_Children_Errors++;
$Error_Messages eq "" ? $Error_Messages="$pid was murdered!" : $Error_Messages=$Error_Messages . "\n" . "$pid was murdered!";
} else {
print "$pid returned $rc";
print ($sig?" after receiving signal $sig":"\n");
my $fname=$fh1PR_E_filename_STEM . $ispawn . ".err";
if(-f "$fname"){
$Total_Children_Errors++;
$ERROR_Count++;
if($Error_Messages eq ""){
$Error_Messages="Error found in parallel row process $ispawn (see file " . $fh1PR_E_filename_STEM . $ispawn . ".err for details)";
} else {
$Error_Messages=$Error_Messages . "\n" . "Error found in parallel row process $ispawn (see file " .
$fh1PR_E_filename_STEM . $ispawn . ".err for details)";
}
}
}
} else {
$ERROR_Count++;
$Total_Children_Errors++;
$Error_Messages eq "" ? $Error_Messages="$pid... um... disappeared..." : $Error_Messages=$Error_Messages . "\n" . "$pid... um... disappeared...";
}
$Total_Children_Exited++;
if($ERROR_Count==0){
print "Child $pid exited successfully (" . eval($forked-$Total_Children_Exited) . " of " . $forked . " Children left)\n";
} else {
print "Child $pid exited with ERROR! (" . eval($forked-$Total_Children_Exited) . " of " . $forked . " Children left)\n";
}
shift #child_pids_rows;
shift #child_ispawns_rows;
}
#print "Total child errors:$Total_Children_Errors\n";
if($Total_Children_Errors>0){
$Program_Termination_Code=915;
print $Error_Messages . "\n";
#Results=($Program_Termination_Code,0,0);
goto END101;
} else {
if($err > 0){
$Program_Termination_Code=919;
#Results=($Program_Termination_Code,0,0);
goto END101;
} else {
print "ALL Child processes terminated correctly (Parallel Rows)!\n";
}
}
END101:
return #Results;
}
Running this code produces the output:
27713 returned 0
Child 27713 exited successfully (3 of 4 Children left)
27714 returned 0
Child 27714 exited successfully (2 of 4 Children left)
27715 returned 0
Child 27715 exited successfully (1 of 4 Children left)
27716 returned 0
Child 27716 exited successfully (0 of 4 Children left)
ALL Child processes terminated correctly (Parallel Rows)!
ERROR code:0 (Error string:)
So far no problems. However, now I introduce a deliberate division by zero error in the child process by uncommenting the line (see original code above)
my $ased=4/0 if $ispawn==2 || $ispawn==1;
Now I get the output
ERROR code:501 (Error string:Illegal division by zero at /home/public/AGO/testcode/BArt_F/perl/DB_forking_with_errors_test_code_1.pl line 83.)
ERROR code:501 (Error string:Illegal division by zero at /home/public/AGO/testcode/BArt_F/perl/DB_forking_with_errors_test_code_1.pl line 83.)
30744 returned 0
Child 30744 exited successfully (3 of 4 Children left)
30745 returned 0
Child 30745 exited successfully (2 of 4 Children left)
30746 returned 0
Child 30746 exited successfully (1 of 4 Children left)
30747 returned 0
Child 30747 exited successfully (0 of 4 Children left)
ALL Child processes terminated correctly (Parallel Rows)!
ERROR code:0 (Error string:)
DBD::Oracle::db commit failed: ORA-03113: fin de fichier sur canal de communication
ID de processus : 22739
ID de session : 1, Numéro de série : 54727 (DBD ERROR: OCITransCommit) at /home/public/AGO/testcode/BArt_F/perl/DB_forking_with_errors_test_code_1.pl line 35.
Here I have lost the connection to the database in the parent and the code does not terminate correctly!
Finally, to sort this out, I uncomment the code in the child process (see original code above):
$SIG{__DIE__} = $SIG{TERM} = $SIG{INT} = sub {
my $ERROR_Val=$!;
open(my $fh1PR_E, '>:encoding(UTF-8)', $fh1PR_E_filename);
print $fh1PR_E "Caught an errorsignal: $ERROR_Val (child $ispawn)";
close $fh1PR_E;
$db_child->commit unless $db_child->{AutoCommit};
$db_child->disconnect if defined($db_child);
exit;
};
Now running the code I get:
946 returned 0
Child 946 exited with ERROR! (3 of 4 Children left)
947 returned 0
Child 947 exited with ERROR! (2 of 4 Children left)
948 returned 0
Child 948 exited successfully (1 of 4 Children left)
949 returned 0
Child 949 exited successfully (0 of 4 Children left)
Error found in parallel row process 1 (see file /tmp/error_file_Test_parallel_rows_53a6e838-def0-11eb-b482-8f8e0f0aecb2_1.err for details)
Error found in parallel row process 2 (see file /tmp/error_file_Test_parallel_rows_53a6e838-def0-11eb-b482-8f8e0f0aecb2_2.err for details)
ERROR code:915 (Error string:)
Now the error is trapped and the parent exits correctly.
All of this seems fine until I have read (https://www.perlmonks.org/?node_id=1173708) that I should not use
$SIG{__DIE__}
However I cannot find any alternative method that allows my parent program to exit correctly if any of the child processes die.
Could anyone tell me if there is an alternative method to using
$SIG{__DIE__}
I have a file with a wide range of information and I want to extract some data from here. I only will post here the interesting part. I want to extract IQ and JQ values as well as the J_ij[meV] value which is two lines above. I read this question How to print 5 consecutive lines after a pattern in file using awk where a pattern is used to extract information bellow and I was thinking doing something similar. My initial idea was:
awk '/IQ =/ { print $6,$12 } /IQ =/ {for(i=2; i<=2; i++){ getline; print $11 }}' input.text > output.txt
Loop appears not to working
IT IQ JT JQ N1 N2 N3 DRX DRY DRZ DR J_ij [mRy] J_ij [meV]
IT = 1 IQ = **1** JT = 1 JQ = **1**
->Q = ( -0.250, 0.722, 0.203) ->Q = ( -0.250, 0.722, 0.203)
1 1 1 1 0 0 0 0.000 0.000 0.000 0.000 0.000000000 **0.000000000**
IT = 1 IQ = **1** JT = 6 JQ = **6**
->Q = ( -0.250, 0.722, 0.203) ->Q = ( 0.000, 1.443, 0.609)
1 1 6 6 -1 0 -1 -0.250 -0.144 -0.406 0.498 0.135692822 **1.846194885**
IT = 1 IQ = **1** JT = 8 JQ = **8**
->Q = ( -0.250, 0.722, 0.203) ->Q = ( 0.000, 0.577, 0.609)
1 1 8 8 0 0 -1 0.250 -0.144 -0.406 0.498 0.017676555 **0.240501782**
My expected output is:
IQ JQ J_ij [meV]
1 1 0.000000000
1 6 1.846194885
1 8 0.240501782
It comes from the bold words (** **), first line is only indicative.
Could you please try following. Written and tested with shown examples.
awk '
BEGIN{
print "IQ JQ J_ij [meV]"
}
FNR>1 && /IQ =/{
value=$6 OFS $12
found=1
next
}
found && NF && !/ ->Q/{
if(value){
print value OFS $NF
}
value=found=""
}' Input_file
Output will be as follows.
IQ JQ J_ij [meV]
1 1 0.000000000
1 6 1.846194885
1 8 0.240501782
Homework is to modify this script to take exec as an argument, but first I want to be able to run the script to try to figure out how to modify it
tcsh $ cat foreach_1
#!/bin/tcsh
# routine to zero-fill argv to 20 arguments
#
set buffer = (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
set count = 1
#
if ($#argv > 20) goto toomany
#
foreach argument ($argv[*])
set buffer[$count] = $argument
# count++
end
# REPLACE command ON THE NEXT LINE WITH
# THE PROGRAM YOU WANT TO CALL.
exec command $buffer[*]
#
toomany:
echo "Too many arguments given."
echo "Usage: foreach_1 [up to 20 arguments]"
exit 1
But I get this error when trying to run it:
./foreach_1: line 5: syntax error near unexpected token `('
./foreach_1: line 5: `set buffer = (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)'
I don't have any extra quotes, so why is this happening?
In many shells (and I believe that tcsh is counted among the bourne compatibles), you must place the left-hand side of the expression, the =, and the right-hand side all directly adjacent to one another.
# shorten the ` = ` to `=` below:
set buffer=(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
set count=1
if ($#argv > 20) goto toomany
#
foreach argument ($argv[*])
set buffer[$count] = $argument
# count++
end
# REPLACE command ON THE NEXT LINE WITH
# THE PROGRAM YOU WANT TO CALL.
exec command $buffer[*]
#
toomany:
echo "Too many arguments given."
echo "Usage: foreach_1 [up to 20 arguments]"
exit 1
This question is unlikely to help any future visitors; it is only relevant to a small geographic area, a specific moment in time, or an extraordinarily narrow situation that is not generally applicable to the worldwide audience of the internet. For help making this question more broadly applicable, visit the help center.
Closed 10 years ago.
This is a sample line from my file:
42001232 2011-07-01 51 100001 0 100002 0 2011-07-02 51 100003 0 100004 0
How do I arrange it to look like this
42001232 2011-07-01 51 100001 0
42001232 2011-07-01 51 100002 0
42001232 2011-07-02 51 100003 0
42001232 2011-07-02 51 100004 0
Apart from the first column, all the columns are repeating starting with a date.
I need to organize it in a tabular form. Also, the delimiter here is TAB.
Here's one way using awk. Run like:
awk -f script.awk file
Contents of script.awk:
BEGIN {
FS=OFS="\t"
}
{
for(i=2;i<=NF;i++) {
if ($i ~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
for (j=i+2;j<=NF;j+=2) {
if ($j ~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) {
break
}
else {
print $1, $i, $(i+1), $j, $(j+1)
}
}
}
}
}
Results:
42001232 2011-07-01 51 100001 0
42001232 2011-07-01 51 100002 0
42001232 2011-07-02 51 100003 0
42001232 2011-07-02 51 100004 0
Alternatively, here's the one-liner:
awk 'BEGIN { FS=OFS="\t" } { for(i=2;i<=NF;i++) if ($i ~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) for (j=i+2;j<=NF;j+=2) if ($j ~ /^[0-9]{4}-[0-9]{2}-[0-9]{2}$/) break; else print $1, $i, $(i+1), $j, $(j+1) }' file
This works on the given data:
#!/usr/bin/env perl
use strict;
use warnings;
use English qw( -no_match_vars );
$OFS = qq"\t";
while (<>)
{
chomp;
my(#fields) = split /\s+/, $_;
my $col1 = shift #fields;
my $date = shift #fields;
my $col3 = shift #fields;
while (scalar(#fields) > 1)
{
if ($fields[0] =~ /^\d{4}-\d\d-\d\d$/)
{
$date = shift #fields;
$col3 = shift #fields;
next;
}
else
{
my $col4 = shift #fields;
my $col5 = shift #fields;
print $col1, $date, $col3, $col4, "$col5\n";
}
}
print STDERR "oops - debris $fields[0] left over\n" if (scalar(#fields) != 0);
}
The output I got is:
42001232 2011-07-01 51 100001 0
42001232 2011-07-01 51 100002 0
42001232 2011-07-02 51 100003 0
42001232 2011-07-02 51 100004 0
That's a perfectly horrid format to have to parse. I've had to make some assumptions about the way the repetitions are handled, so that the column after a date is fixed until the next date, for example.