I have tried couple of things, didn't tried using regex bcoz I am not good with this. The log file looks exactly like this.
timestamp : 2018121
streams : Total : 579 461 0 0 24 80 0
ABC : 630
A-1 : 98
B-2 : 87
C-3 : 0
timestamp : 2018127
stream : Total : 476 372 0 0 20 74 0 10 0
ABC : 511
B-2 : 77
C-3 : 0
D-4: 86
timestamp : 2018128
stream : Total : 76 37 0 0 20 74 0 10 0
ABC : 517
A-1 : 74
C-3 : 9
D-4 : 18
I am trying to export in csv in a transpose manner. For streams I just want to export only the first value.
timestamp streams ABC A-1 B-2 C-3 D-4
2018121 579 630 98 87 0 NULL
2018127 476 511 NULL 77 0 186
2018128 76 517 74 NULL 9 18
Hi i think you have to perform your proper logic code because your file was soo tipycal i have work around 10 minutes you have this result it's small code snapp
i have done some change in input because you have in line streams and in other stream ... and in line ' ' and in other ' ' ? soo i think you have a issues in your log generator.
Input :
timestamp : 2018121
streams : Total : 579 461 0 0 24 80 0
ABC : 630
A-1 : 98
B-2 : 87
C-3 : 0
timestamp : 2018127
stream : Total : 476 372 0 0 20 74 0 10 0
ABC : 511
B-2 : 77
C-3 : 0
D-4: 86
timestamp : 2018128
stream : Total : 76 37 0 0 20 74 0 10 0
ABC : 517
A-1 : 74
C-3 : 9
D-4 : 18
Some Code :
$fileContent = Get-Content "C:\Temp\logTest.log"
$resultTab = #();
$beginIdentifierRows = "timestamp".ToLower();
for($i = 0; $i -lt $fileContent.Length; $i++){
if($fileContent[$i].ToLower().StartsWith($beginIdentifierRows)){
#Read all rows value strams to D-4 or other
$A1 = "NULL";
$B2 = "NULL";
$C3 = "NULL";
$D4 = "NULL";
$streams= "NULL";
$ABC = "NULL";
$timestamp = $fileContent[$i].Split(":")[1];
# Write-Host $fileContent[$i];
$jj = 0;
for($j = $i + 1; $j -lt ($i + 6); $j++){
$lineContentJ = $fileContent[$j].Replace(" "," ").Replace(" "," ").Replace(" "," ").Replace(" "," ").Replace(" "," ");
# $lineContentJ
switch -Wildcard ($lineContentJ) {
"ABC *"{
# streams todo
$ABC = $lineContentJ.Split(":")[1];
break;
}
"stream*"{
# streams todo
$streams = $lineContentJ.Split(":")[2].Split(" ")[1];
break;
}
"A-1 *"{
# A-1 todo
$A1 = $lineContentJ.Split(":")[1];
break;
}
"B-2 *"{
# B-2 todo
$B2 = $lineContentJ.Split(":")[1];
break;
}
"C-3 *"{
# C-3 todo
$C3 = $lineContentJ.Split(":")[1];
break;
}
"D-4 *"{
# D-4 todo
$D4 = $lineContentJ.Split(":")[1];
break;
}
}$jj = $j;
}
$i=$jj;
$array_name = [pscustomobject]#{timestamp = $timestamp; streams = $streams; ABC = $ABC; "A-1" = $A1; "B-2"=$B2; "C-3" = $C3; "D-4"=$D4}
$resultTab += $array_name;
}
#else {
#Do nothing
#}
}
$resultTab | ft;
RESULT :
timestamp streams ABC A-1 B-2 C-3 D-4
--------- ------- --- --- --- --- ---
2018121 579 630 98 87 0 NULL
2018127 476 511 NULL 77 0 86
2018128 76 517 74 NULL 9 18
Related
I am trying to get the wordwheelquery out of HKU into a csv. This is the original output:
$reg.PSProvider.Description
MRUListEx : {3, 0, 0, 0...}
0 : {104, 0, 97, 0...}
1 : {97, 0, 99, 0...}
2 : {107, 0, 117, 0...}
3 : {97, 0, 112, 0...}
I want to be able to get each property into their own row under the corresponding heading (property name). So far, this is as far as I've gotten:
$reg = Get-ItemProperty -Path REGISTRY::HKEY_USERS\*\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\WordWheelQuery
foreach($reg_properties in $reg.PsObject.Properties){$_properties.Name, $_properties.Value
#{Name=$reg.Name; Expression={$reg.Value}}
MRUListEx
3
0
0
0
2
0
0
0
1
0
0
0
0
0
0
0
255
255
255
255
0
104
0
97
0
108
0
32
0
108
0
101
0
111
0
110
0
97
0
114
0
100
0
0
0
1
97
0
99
0
97
0
100
0
101
0
109
0
105
0
99
0
0
0
2
107
0
117
0
112
0
100
0
102
0
46
0
110
0
101
0
116
0
95
0
104
0
97
0
108
0
45
0
108
0
101
0
111
0
110
0
97
0
114
0
100
0
45
0
103
0
117
0
105
0
116
0
97
0
114
0
45
0
109
0
101
0
116
0
104
0
111
0
100
0
45
0
98
0
111
0
111
0
107
0
45
0
49
0
46
0
112
0
100
0
102
0
0
0
3
97
0
112
0
112
0
100
0
97
0
116
0
97
0
0
0
PSPath
Microsoft.PowerShell.Core\Registry::HKEY_USERS\S-1-5-21-xxxxxxxx29-xxxxxxx50-54xxxxxxxxx9-1001\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER\WordWheelQuery
PSParentPath
Microsoft.PowerShell.Core\Registry::HKEY_USERS\S-1-5-21-xxxxxxxx29-xxxxxxx50-54xxxxxxxxx9-1001\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\EXPLORER
PSChildName
WordWheelQuery
PSProvider
When exported to a CSV, I still get issues about system.string[] and for the life of me can't get around it.
EDIT: For reference, here is the length of each property
PS C:\> $reg.MRUListEx | Measure-Object
Count : 20
Average :
Sum :
Maximum :
Minimum :
Property :
PS C:\> $reg.0 | Measure-Object
Count : 24
Average :
Sum :
Maximum :
Minimum :
Property :
PS C:\> $reg.1 | Measure-Object
Count : 18
Average :
Sum :
Maximum :
Minimum :
Property :
PS C:\> $reg.2 | Measure-Object
Count : 94
Average :
Sum :
Maximum :
Minimum :
Property :
PS C:\> $reg.3 | Measure-Object
Count : 16
Average :
Sum :
Maximum :
Minimum :
Property :
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 5 years ago.
Improve this question
I have this perl script below to calculate sequence length and their frequency along with nucleotide frequency(A,T,G and C). This script works fine for a file with large number of sequences, but it does not give the right result for a file of small size like this:
infile.fasta
>NC_013116_1051_1114
TTGTCCCTTTGAGTCTCTGG
>NC_013116_1051_1114
GCGCAGCCGATATGGATAA
>NC_013116_1051_1114
TCGAGACTTTGTAATGTTTGGG
>NC_013116_1051_1114
TATTCCACGTCAGGTGCTTTT
>NC_013116_1051_1114
TAGAGCCGATTCCAGACTGTTCC
>NC_013116_1051_1114
TACAGGACCAAGCTCTTCACTC
>NC_013116_1051_1114
CCGTCAAGTTCAGCTCCAATAA
>NC_013116_6_301
CCACGCAACGGACAATCAAACA
>NC_013116_6_301
GGACACTTCCAACTATAAATA
>NC_013116_6_301
CCACGCAACGGACAATCAAACA
>NC_013116_1051_1114
GCTCTTCACTCTTCCTCGTCT
>NC_013116_1051_1114
TTGGGAAAAAGAAGTTGCTGCAGC
>NC_013116_1051_1114
TCGCAGTATCTCTGAAGTTG
count.pl
#!/usr/bin/perl -w
#usage ./count.pl infile min_length max_length
#usage ./count.pl infile 18 34
my $min_len = $ARGV[1];
my $max_len = $ARGV[2];
my $read_len = 0;
my #lines = ("header1","sequence","header2","quality");
my #lray = ();
my $count = 0;
my $total = 0;
my $i = 0;
my #Aray = ();
my #Cray = ();
my #Gray = ();
my #Tray = ();
my$FN = "";
for ($i=$min_len; $i<=$max_len; $i++){
$lray[$i] = 0;
}
open (INFILE, "<$ARGV[0]") || die "couldn't open input file!";
while (<INFILE>) {
$lines[$count] = $_;
chomp($lines[$count]);
$count++;
if($count eq 4){
$read_len = length($lines[1]);
# print "$read_len $lines[1]\n";
$FN = substr $lines[1], 0, 1;
$lray[$read_len]++;
if ($FN eq "T") { $Tray[$read_len]++;}
else {
if ($FN eq "A"){ $Aray[$read_len]++;}
else {
if ($FN eq "C"){ $Cray[$read_len]++;}
else {
if ($FN eq "G"){ $Gray[$read_len]++;}
}
}
}
$count = 0;
}
}
print "length\tnumber\tA\tC\tG\tT\n";
for ($i=$min_len; $i<=$max_len; $i++){
print "$i\t$lray[$i]\t$Aray[$i]\t$Cray[$i]\t$Gray[$i]\t$Tray[$i]\n";
}
exit;
This is the type of result I get from a big file with many sequences.
length number A C G T
18 4473 542 710 471 2750
19 12647 990 1680 1103 8874
20 31194 3010 3354 2743 22087
21 61214 6288 7196 5784 41946
22 128642 14596 11902 12518 89626
23 65190 6859 6525 7773 44033
24 10012 611 1401 1112 6888
25 1406 231 192 435 548
26 661 169 91 105 296
27 407 126 81 65 135
28 602 391 49 68 94
29 520 54 30 370 66
30 175 26 93 18 38
31 156 35 28 29 64
32 106 22 16 24 44
33 97 45 17 16 19
34 0
I would really appreciate if you could help me correct this code. Thanks
Trying do not reinvent the wheel, so, using the FAST module, got:
use 5.014;
use warnings;
use FAST::Bio::SeqIO;
my $fasta = FAST::Bio::SeqIO->new(-file => "infile.fasta", -format => 'Fasta');
my $seqnum=0;
while ( my $seq = $fasta->next_seq() ) {
my $stats;
$stats->{len} = length($seq->seq);
$stats->{$_}++ for split //, $seq->seq;
say ++$seqnum, " #$stats{qw(len A C G T)}";
}
The above, for your demo infile.fasta prints:
1 20 1 5 5 9
2 19 6 4 6 3
3 22 4 2 7 9
4 21 3 5 4 9
5 23 5 7 5 6
6 22 6 8 3 5
7 22 7 7 3 5
8 22 10 8 3 1
9 21 9 5 2 5
10 22 10 8 3 1
11 21 1 9 2 9
12 24 8 3 8 5
13 20 4 4 5 7
or the
use 5.014;
use warnings;
use FAST::Bio::SeqIO;
my $fasta = FAST::Bio::SeqIO->new(-file => "file.fasta", -format => 'Fasta');
my $stats;
while ( my $seq = $fasta->next_seq() ) {
my $len = length($seq->seq);
$stats->{$len}{count}++;
$stats->{$len}{$_}++ for split //, $seq->seq;
}
say "Length $_ ($stats->{$_}->{count} times) Letters freq: #{$stats->{$_}}{qw(A C G T)}" for sort { $a <=> $b } keys %$stats;
produce:
Length 19 (1 times) Letters freq: 6 4 6 3
Length 20 (2 times) Letters freq: 5 9 10 16
Length 21 (3 times) Letters freq: 13 19 8 23
Length 22 (5 times) Letters freq: 37 33 19 21
Length 23 (1 times) Letters freq: 5 7 5 6
Length 24 (1 times) Letters freq: 8 3 8 5
and so on...
I have a file with 16 different columns (tab-separated values):
22 51169729 G 39 A 0 0 C 0 0 G 38 0.974359 T 1 0.025641
22 51169730 A 36 A 36 1 C 0 0 G 0 0 T 0 0
22 51169731 C 39 A 0 0 C 39 1 G 0 0 T 0 0
22 51169732 G 37 A 0 0 C 0 0 G 37 1 T 0 0
22 51169733 G 33 A 0 0 C 0 0 G 33 1 T 0 0
22 51169734 C 35 A 0 0 C 35 1 G 0 0 T 0 0
22 51169735 A 32 A 32 1 C 0 0 G 0 0 T 0 0
22 51169736 G 32 A 0 0 C 0 0 G 32 1 T 0 0
22 51169737 C 30 A 0 0 C 30 1 G 0 0 T 0 0
22 51169738 T 27 A 0 0 C 0 0 G 0 0 T 27 1
22 51169739 G 26 A 0 0 C 0 0 G 26 1 T 0 0
22 51169740 A 25 A 25 1 C 0 0 G 0 0 T 0 0
22 51169741 C 22 A 0 0 C 22 1 G 0 0 T 0 0
22 51169742 G 23 A 0 0 C 0 0 G 23 1 T 0 0
22 51169743 C 21 A 0 0 C 21 1 G 0 0 T 0 0
22 51169744 C 22 A 0 0 C 22 1 G 0 0 T 0 0
22 51169745 C 19 A 0 0 C 19 1 G 0 0 T 0 0
22 51169746 C 19 A 0 0 C 19 1 G 0 0 T 0 0
22 51169747 A 15 A 14 0.933333 C 1 0.0666667 G 0 0 T 0 0
22 51169748 C 20 A 0 0 C 20 1 G 0 0 T 0 0
The third column can be A, G, C or T.
I would like to:
remove columns 5, 6 and 7 when column 3 is an 'A' OR when $7=='0'.
Similarly, remove columns 8, 9, 10 when $3== 'C' OR when $10=='0'.
remove columns 11, 12, 13 when $3=='G' OR when $13=='0'.
and remove columns 14, 15, 16 when $3=='T' OR when $16=='0'.
When this is done for the entire file, there would only be 4 columns left in some cases and 7 columns in other cases, like in the following example:
22 51169729 G 39 T 1 0.025641
22 51169730 A 36
22 51169731 C 39
22 51169732 G 37
22 51169733 G 33
22 51169734 C 35
22 51169735 A 32
22 51169736 G 32
22 51169737 C 30
22 51169738 T 27
22 51169739 G 26
22 51169740 A 25
22 51169741 C 22
22 51169742 G 23
22 51169743 C 21
22 51169744 C 22
22 51169745 C 19
22 51169746 C 19
22 51169747 A 15 C 2 0.133333
22 51169748 C 20
Any suggestions?
Perl solution for the first part:
#!/usr/bin/perl
use warnings;
use strict;
my %remove = ( A => 4, # Where to start removing the columns
C => 7, # for a given character in column #3.
G => 10,
T => 13,
);
$\ = "\n"; # Add newline to prints.
$, = "\t"; # Separate values by tabs.
while (<>) { # Read input line by line;
chomp; # Remove newline.
my #F = split /\t/; # Split on tabs, populate an array.
splice #F, $remove{ $F[2] }, 3; # Remove the columns.
print #F; # Output.
}
Once you clarify the second requirement, I can try to add more code. What values do you want to remove? Can you show more examples?
Here's one way to do the first part, assuming no empty fields:
$ cat tst.awk
$3 == "A" { $5=$6=$7="" }
$3 == "C" { $8=$9=$10="" }
$3 == "G" { $11=$12=$13="" }
$3 == "T" { $14=$15=$16="" }
{ gsub(/[[:space:]]+/,"\t"); print }
$ awk -f tst.awk file
1 957584 C 157 A 1 0.006 G 0 0 T 0 0
I don't really understand what you're trying to do in the 2nd part but it sounds like this might be what you want if the test on $7/10/13 is the modified field numbers after the first phase:
$3 == "A" { $5=$6=$7="" }
$3 == "C" { $8=$9=$10="" }
$3 == "G" { $11=$12=$13="" }
$3 == "T" { $14=$15=$16="" }
{ $0=$0 }
$7 ~ /0/ { c++ }
$10 ~ /0/ { c++ }
$13 ~ /0/ { c++ }
c > 1 { $8=$9=$10="" }
{ c=0; gsub(/[[:space:]]+/,"\t"); print }
or this if the test on $7/10/13 is the original field numbers:
$7 ~ /0/ { c++ }
$10 ~ /0/ { c++ }
$13 ~ /0/ { c++ }
$3 == "A" { $5=$6=$7="" }
$3 == "C" { $8=$9=$10="" }
$3 == "G" { $11=$12=$13="" }
$3 == "T" { $14=$15=$16="" }
c > 1 { $8=$9=$10="" }
{ c=0; gsub(/[[:space:]]+/,"\t"); print }
If not, edit your question to clarify with a better example.
I'm trying to implement a custom perl nagios script to check for rogue dhcp servers remotely with nrpe. On the central server when i run:
/usr/local/nagios/libexec/check_nrpe -H 10.9.0.25 -c check_roguedhcp
In my debugging logs i'm seeing this:
Host is asking for command 'check_roguedhcp' to be run...
Running command: sudo /usr/lib64/nagios/plugins/check_roguedhcp.pl
Command completed with return code 1 and output:
Return Code: 1, Output: NRPE: Unable to read output
Locally if i run the script (even as the nrpe user) I get the expected output.
On the local server my /etc/nagios/nrpe.cfg has the following settings:
command[check_roguedhcp]=sudo /usr/lib64/nagios/plugins/check_roguedhcp.pl
command[check_dhcp]=sudo /usr/lib64/nagios/plugins/check_dhcp -v
nrpe_user=nrpe
nrpe_group=nagios
ps aux shows nrpe is running as user nrpe (nrpe is in group nagios)
nrpe 5941 0.0 0.1 52804 2384 ? Ss 08:25 0:00 /usr/sbin/nrpe -c /etc/nagios/nrpe.cfg -d
I've added the command to /etc/sudoers
%nagios ALL=(ALL) NOPASSWD: /usr/lib/nagios64/plugins/check_dhcp, /usr/lib64/nagios/plugins/check_roguedhcp.pl
on my central server that does the nrpe calls, i have the following service groups and configurations:
define servicegroup{
servicegroup_name rogue_dhcp
alias All dhcp monitors
}
define service{
name security-service
servicegroups rogue_dhcp
register 0
max_check_attempts 1
}
Nagios can run any other check_users etc script via nrpe on this server.
Here's the perl script itself, though we know that the file executes locally just fine.
1 #!/usr/bin/perl -w
2 # nagios: -epn
3 # the above makes nagios run the script separately.
4 use POSIX;
5 use lib "/usr/lib64/nagios/plugins";
6 use utils qw(%ERRORS);
7
8 sub fail_usage {
9 if (scalar #_) {
10 print "$0: error: \n";
11 map { print " $_\n"; } #_;
12 }
13 print "$0: Usage: \n";
14 print "$0 [-v [-v [-v]]] [ []] \n";
15 print "$0 [-v [-v [-v]]] [-s] [[-s] [[-s] ]] \n";
16 print " \n";
17 exit 3 ;
18 }
19
20 my $verbose = 0;
21 my %servers=(
22 "x", "10.x.x.x",
23 "x", "10.x.x.x",
24 "x", "10.x.x.x",
25 "x", "10.x.x.x"
26 );
27
28 # examine commandline args
29 while ($ARGV=$ARGV[0]) {
30 my $myarg = $ARGV;
31 if ($ARGV eq '-s') {
32 shift #ARGV;
33 if (!($ARGV = $ARGV[0])) { fail_usage ("$myarg needs an argument"); }
34 if ($ARGV =~ /^-/) { fail_usage ("$myarg must be followed by an argument"); }
35 if (!defined($servers{$ARGV})) { $servers{$ARGV}=1; }
36 }
37 elsif ($ARGV eq '-v' ) { $verbose++; }
38 elsif ($ARGV eq '-h' or $ARGV eq '--help' ) { fail_usage ; }
39 elsif ($ARGV =~ /^-/ ) { fail_usage " invalid option ($ARGV)"; }
40 elsif ($ARGV =~ /^\d+\.\d+\.\d+\.\d+$/)
41 # servers should be ip addresses. I'm not doing detailed checks for this.
42 { if (!defined($servers{$ARGV})) { $servers{$ARGV}=1; } }
43 else { last; }
44 shift #ARGV;
45 }
46 # for some reason I can't test for empty ARGs in the while loop
47 #ARGV = grep {!/^\s*$/} #ARGV;
48 if (scalar #ARGV) { fail_usage "didn't understand arguments: (".join (" ",#ARGV).")"; }
49
50 my $serversn = scalar keys %servers;
51
52 if ($verbose > 2) {
53 print "verbosity=($verbose)\n";
54 print "servers = ($serversn)\n";
55 if ($serversn) { for my $i (keys %servers) { print "server ($i)\n"; } }
56 }
57
58 if (!$serversn) { fail_usage "no servers"; }
59 my $responses=0;
60 my $responders="";
61 my #check_dhcp = qx{/usr/lib64/nagios/plugins/check_dhcp -v};
62 foreach my $value (#check_dhcp) {
63 if ($value =~ /Added offer from server \# /i){
64 $value =~ m/(\d+\.\d+\.\d+\.\d+)/i;
65 my $host = $1;
66 # we find a server in our list
67 if (defined($servers{$host})) { $responses++; $responders.="$host "; }
68 # we find a rogue DHCP server. Danger Will Robinson!
69 else {
70 print "DHCP:CRITICAL: DHCP service running on $host";
71 exit $ERRORS{'OK'}
72 }
73 }
74 }
75 # we saw all the servers in our list. All is good.
76 if ($responses == $serversn) {
77 print "DHCP:OK: $responses of $serversn Expected Responses to DHCP Broadcast";
78 exit $ERRORS{'OK'};
79 }
80 # we found no DHCP responses.
81 if ($responses == 0) {
82 print "DHCP:OK: no rogue servers detected!!!!#!##";
83 exit $ERRORS{'OK'}
84 }
85 # we found less DHCP servers than we should have. Oh Nos!
86 $responders =~ s/ $//;
87 print "DHCP:OK: $responses of $serversn Responses to DHCP Broadcast. ($responders) responded. ";
88 exit $ERRORS{'OK'};
Here's what I am seeing (of relevance) when I do an strace of the nrpe process.
955 6950 stat("/usr/lib64/nagios/plugins/check_roguedhcp.pl", {st_mode=S_IFREG|S_ISUID|S_ISGID|0755, st_size=2799, ...}) = 0
956 6950 setresuid(4294967295, 4294967295, 4294967295) = 0
957 6950 setresgid(4294967295, 536347864, 4294967295) = 0
958 6950 setgroups(3, [536347864, 536347137, 536353632]) = 0
959 6950 open("/dev/tty", O_RDWR|O_NOCTTY) = -1 ENXIO (No such device or address)
960 6950 socket(PF_NETLINK, SOCK_RAW, 9) = 3
961 6950 fcntl(3, F_SETFD, FD_CLOEXEC) = 0
962 6950 fcntl(3, F_SETFD, FD_CLOEXEC) = 0
963 6950 ioctl(0, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff3de81ac0) = -1 ENOTTY (Inappropriate ioctl for device)
964 6950 ioctl(1, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff3de81ac0) = -1 EINVAL (Invalid argument)
965 6950 ioctl(2, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff3de81ac0) = -1 ENOTTY (Inappropriate ioctl for device)
966 6950 getcwd("/", 4096) = 2
967 6950 sendto(3, "d\0\0\0c\4\5\0\1\0\0\0\0\0\0\0cwd=\"/\" cmd=\"/us"..., 100, 0, {sa_family=AF_NETLINK, pid=0, groups=00000000}, 12) = 100
968 6950 poll([{fd=3, events=POLLIN}], 1, 500) = 1 ([{fd=3, revents=POLLIN}])
969 6950 recvfrom(3, "$\0\0\0\2\0\0\0\1\0\0\0&\33\0\0\0\0\0\0d\0\0\0c\4\5\0\1\0\0\0"..., 8988, MSG_PEEK|MSG_DONTWAIT, {sa_family=AF_NE TLINK, pid=0, groups=00000000}, [12]) = 36
970 6950 recvfrom(3, "$\0\0\0\2\0\0\0\1\0\0\0&\33\0\0\0\0\0\0d\0\0\0c\4\5\0\1\0\0\0"..., 8988, MSG_DONTWAIT, {sa_family=AF_NETLINK, pi d=0, groups=00000000}, [12]) = 36
971 6950 write(2, "sudo", 4) = 4
972 6950 write(2, ": ", 2) = 2
973 6950 write(2, "sorry, you must have a tty to ru"..., 38) = 38
974 6950 write(2, "\n", 1) = 1
975 6950 setresuid(4294967295, 4294967295, 4294967295) = 0
976 6950 setresgid(4294967295, 4294967295, 4294967295) = 0
977 6950 exit_group(1) = ?
978 6949 <... read resumed> "", 4096) = 0
979 6949 --- SIGCHLD (Child exited) # 0 (0) ---
980 6949 close(5) = 0
981 6949 wait4(6950, [{WIFEXITED(s) && WEXITSTATUS(s) == 1}], 0, NULL) = 6950
970 6950 recvfrom(3, "$\0\0\0\2\0\0\0\1\0\0\0&\33\0\0\0\0\0\0d\0\0\0c\4\5\0\1\0\0\0"..., 8988, MSG_DONTWAIT, {sa_family=AF_NETLINK, pi d=0, groups=00000000}, [12]) = 36
971 6950 write(2, "sudo", 4) = 4
972 6950 write(2, ": ", 2) = 2
973 6950 write(2, "sorry, you must have a tty to ru"..., 38) = 38
974 6950 write(2, "\n", 1) = 1
975 6950 setresuid(4294967295, 4294967295, 4294967295) = 0
976 6950 setresgid(4294967295, 4294967295, 4294967295) = 0
977 6950 exit_group(1) = ?
This was solved by adding the following to /etc/sudoers
Defaults:nagios !requiretty
in my case i have resolved changing permissions of scripts file under /nagios/libexec/
do not work with root:root and WORK with nagios:nagios user permission!
I changed permission of my specific script on libexec folder to allow the "Other" (non-root users) to execute it chmod 755 myfile.pl, and it worked well.
Consider these two use cases:
sub test1 {
my $v = 1;
sub test2 { print $v }
# ...
}
and
for (0..3) {
my $foo = $_;
sub test1 { print $foo }
# ...
}
The first one produces a Variable will not stay shared warning, while the second doesn't. It seems that the variable is not shared in both cases. Why isn't there any warning in the second case?
It seems that this may be a bug or omission in the warnings pragma.
Adding to the fun, this arrangement gives a different warning:
BEGIN {*outer = sub {
my $x;
sub inner {$x}
}}
Which warns Variable "$x" is not available
These warnings all come from the pad_findlex() API call defined in pad.c.
806 =for apidoc pad_findlex
807
808 Find a named lexical anywhere in a chain of nested pads. Add fake entries
809 in the inner pads if it's found in an outer one.
810
811 Returns the offset in the bottom pad of the lex or the fake lex.
812 cv is the CV in which to start the search, and seq is the current cop_seq
813 to match against. If warn is true, print appropriate warnings. The out_*
814 vars return values, and so are pointers to where the returned values
815 should be stored. out_capture, if non-null, requests that the innermost
816 instance of the lexical is captured; out_name_sv is set to the innermost
817 matched namesv or fake namesv; out_flags returns the flags normally
818 associated with the IVX field of a fake namesv.
819
820 Note that pad_findlex() is recursive; it recurses up the chain of CVs,
821 then comes back down, adding fake entries as it goes. It has to be this way
822 because fake namesvs in anon protoypes have to store in xlow the index into
823 the parent pad.
824
825 =cut
826 */
827
828 /* the CV has finished being compiled. This is not a sufficient test for
829 * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
830 #define CvCOMPILED(cv) CvROOT(cv)
831
832 /* the CV does late binding of its lexicals */
833 #define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
834
835
836 STATIC PADOFFSET
837 S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
838 SV** out_capture, SV** out_name_sv, int *out_flags)
839 {
840 dVAR;
841 I32 offset, new_offset;
842 SV *new_capture;
843 SV **new_capturep;
844 const AV * const padlist = CvPADLIST(cv);
845
846 PERL_ARGS_ASSERT_PAD_FINDLEX;
847
848 *out_flags = 0;
849
850 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
851 "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
852 PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
853
854 /* first, search this pad */
855
856 if (padlist) { /* not an undef CV */
857 I32 fake_offset = 0;
858 const AV * const nameav = MUTABLE_AV(AvARRAY(padlist)[0]);
859 SV * const * const name_svp = AvARRAY(nameav);
860
861 for (offset = AvFILLp(nameav); offset > 0; offset--) {
862 const SV * const namesv = name_svp[offset];
863 if (namesv && namesv != &PL_sv_undef
864 && strEQ(SvPVX_const(namesv), name))
865 {
866 if (SvFAKE(namesv)) {
867 fake_offset = offset; /* in case we don't find a real one */
868 continue;
869 }
870 /* is seq within the range _LOW to _HIGH ?
871 * This is complicated by the fact that PL_cop_seqmax
872 * may have wrapped around at some point */
873 if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
874 continue; /* not yet introduced */
875
876 if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
877 /* in compiling scope */
878 if (
879 (seq > COP_SEQ_RANGE_LOW(namesv))
880 ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
881 : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
882 )
883 break;
884 }
885 else if (
886 (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
887 ?
888 ( seq > COP_SEQ_RANGE_LOW(namesv)
889 || seq <= COP_SEQ_RANGE_HIGH(namesv))
890
891 : ( seq > COP_SEQ_RANGE_LOW(namesv)
892 && seq <= COP_SEQ_RANGE_HIGH(namesv))
893 )
894 break;
895 }
896 }
897
898 if (offset > 0 || fake_offset > 0 ) { /* a match! */
899 if (offset > 0) { /* not fake */
900 fake_offset = 0;
901 *out_name_sv = name_svp[offset]; /* return the namesv */
902
903 /* set PAD_FAKELEX_MULTI if this lex can have multiple
904 * instances. For now, we just test !CvUNIQUE(cv), but
905 * ideally, we should detect my's declared within loops
906 * etc - this would allow a wider range of 'not stayed
907 * shared' warnings. We also treated already-compiled
908 * lexes as not multi as viewed from evals. */
909
910 *out_flags = CvANON(cv) ?
911 PAD_FAKELEX_ANON :
912 (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
913 ? PAD_FAKELEX_MULTI : 0;
914
915 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
916 "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
917 PTR2UV(cv), (long)offset,
918 (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
919 (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
920 }
921 else { /* fake match */
922 offset = fake_offset;
923 *out_name_sv = name_svp[offset]; /* return the namesv */
924 *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
925 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
926 "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
927 PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
928 (unsigned long) PARENT_PAD_INDEX(*out_name_sv)
929 ));
930 }
931
932 /* return the lex? */
933
934 if (out_capture) {
935
936 /* our ? */
937 if (SvPAD_OUR(*out_name_sv)) {
938 *out_capture = NULL;
939 return offset;
940 }
941
942 /* trying to capture from an anon prototype? */
943 if (CvCOMPILED(cv)
944 ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
945 : *out_flags & PAD_FAKELEX_ANON)
946 {
947 if (warn)
948 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
949 "Variable \"%s\" is not available", name);
950 *out_capture = NULL;
951 }
952
953 /* real value */
954 else {
955 int newwarn = warn;
956 if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
957 && !SvPAD_STATE(name_svp[offset])
958 && warn && ckWARN(WARN_CLOSURE)) {
959 newwarn = 0;
960 Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
961 "Variable \"%s\" will not stay shared", name);
962 }
963
964 if (fake_offset && CvANON(cv)
965 && CvCLONE(cv) &&!CvCLONED(cv))
966 {
967 SV *n;
968 /* not yet caught - look further up */
969 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
970 "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
971 PTR2UV(cv)));
972 n = *out_name_sv;
973 (void) pad_findlex(name, CvOUTSIDE(cv),
974 CvOUTSIDE_SEQ(cv),
975 newwarn, out_capture, out_name_sv, out_flags);
976 *out_name_sv = n;
977 return offset;
978 }
979
980 *out_capture = AvARRAY(MUTABLE_AV(AvARRAY(padlist)[
981 CvDEPTH(cv) ? CvDEPTH(cv) : 1]))[offset];
982 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
983 "Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
984 PTR2UV(cv), PTR2UV(*out_capture)));
985
986 if (SvPADSTALE(*out_capture)
987 && !SvPAD_STATE(name_svp[offset]))
988 {
989 Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
990 "Variable \"%s\" is not available", name);
991 *out_capture = NULL;
992 }
993 }
994 if (!*out_capture) {
995 if (*name == '#')
996 *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
997 else if (*name == '%')
998 *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
999 else
1000 *out_capture = sv_newmortal();
1001 }
1002 }
1003
1004 return offset;
1005 }
1006 }
1007
1008 /* it's not in this pad - try above */
1009
1010 if (!CvOUTSIDE(cv))
1011 return NOT_IN_PAD;
1012
1013 /* out_capture non-null means caller wants us to capture lex; in
1014 * addition we capture ourselves unless it's an ANON/format */
1015 new_capturep = out_capture ? out_capture :
1016 CvLATE(cv) ? NULL : &new_capture;
1017
1018 offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
1019 new_capturep, out_name_sv, out_flags);
1020 if ((PADOFFSET)offset == NOT_IN_PAD)
1021 return NOT_IN_PAD;
1022
1023 /* found in an outer CV. Add appropriate fake entry to this pad */
1024
1025 /* don't add new fake entries (via eval) to CVs that we have already
1026 * finished compiling, or to undef CVs */
1027 if (CvCOMPILED(cv) || !padlist)
1028 return 0; /* this dummy (and invalid) value isnt used by the caller */
1029
1030 {
1031 /* This relies on sv_setsv_flags() upgrading the destination to the same
1032 type as the source, independent of the flags set, and on it being
1033 "good" and only copying flag bits and pointers that it understands.
1034 */
1035 SV *new_namesv = newSVsv(*out_name_sv);
1036 AV * const ocomppad_name = PL_comppad_name;
1037 PAD * const ocomppad = PL_comppad;
1038 PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
1039 PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
1040 PL_curpad = AvARRAY(PL_comppad);
1041
1042 new_offset
1043 = pad_add_name_sv(new_namesv,
1044 (SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
1045 SvPAD_TYPED(*out_name_sv)
1046 ? SvSTASH(*out_name_sv) : NULL,
1047 SvOURSTASH(*out_name_sv)
1048 );
1049
1050 SvFAKE_on(new_namesv);
1051 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1052 "Pad addname: %ld \"%.*s\" FAKE\n",
1053 (long)new_offset,
1054 (int) SvCUR(new_namesv), SvPVX(new_namesv)));
1055 PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
1056
1057 PARENT_PAD_INDEX_set(new_namesv, 0);
1058 if (SvPAD_OUR(new_namesv)) {
1059 NOOP; /* do nothing */
1060 }
1061 else if (CvLATE(cv)) {
1062 /* delayed creation - just note the offset within parent pad */
1063 PARENT_PAD_INDEX_set(new_namesv, offset);
1064 CvCLONE_on(cv);
1065 }
1066 else {
1067 /* immediate creation - capture outer value right now */
1068 av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
1069 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
1070 "Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
1071 PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
1072 }
1073 *out_name_sv = new_namesv;
1074 *out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
1075
1076 PL_comppad_name = ocomppad_name;
1077 PL_comppad = ocomppad;
1078 PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
1079 }
1080 return new_offset;
1081 }
It seems it has to do with if the containing pad is held within a CV or not, but I am not sure of the exact specifics.