I'm using Redis.pm in perl scrpit and try to execute next command:
zrevrangebyscore <key> <highscore> 0 WITHSCORES LIMIT 0 1
In appliance with redis documentation i write next and it's working fine
my $data = { $redis->zrevrangebyscore($rkey, $ipl, 0, 'WITHSCORES') };
but when i try to subst 'limit...' in perl command:
my $data = { $redis->zrevrangebyscore($rkey, $ipl, 0, 'WITHSCORES','LIMIT 0 1') };
i got error
[zrevrangebyscore] ERR syntax error, at /usr/local/lib/perl5/site_perl/5.14/Redis.pm line 163
Redis::__ANON__(undef, 'ERR syntax error') called at /usr/local/lib/perl5/site_perl/5.14/Redis.pm line 195
Redis::wait_one_response('Redis=HASH(0x801075300)') called at /usr/local/lib/perl5/site_perl/5.14/Redis.pm line 183
Redis::wait_all_responses('Redis=HASH(0x801075300)') called at /usr/local/lib/perl5/site_perl/5.14/Redis.pm line 172
How i can pass to arg 'LIMIT 0 1' in Redis.pm ?
The answer is:
my $data = { $redis->zrevrangebyscore($rkey, $ipl, 0, 'WITHSCORES', qw{LIMIT 0 1})};
May be it will be usefull for somebody. Thanks!
If you are just looking to iterate through your sorted set, and always fetch the highest entry, just use
zrange
(zrange documentation)
instead of zrevrangebyscore.
my $start = -1; #-1 is last element = the element with the highest score
my $stop = -1;
while (my $data = $redis->zrange($rkey, $start--, $stop--, 'WITHSCORES')) {
#fetch the ultimate element, then the penultimate, etc....
};
Related
We periodically runs jobs and we need to save the output into a PDS and then parse the output to extract parts of it to save into another member. It needs to be done by issuing a REXX command using the percent sign and the REXX member name as an SDSF command line. I've attempted to code a REXX to do this, but it is getting an error when trying to invoke an ISPF service, saying the ISPF environment has not been established. But, this is SDSF running under ISPF.
My code has this in it (copied from several sources and modified):
parse arg PSDSFPARMS "(" PUSERPARMS
parse var PSDSFPARMS PCURRPNL PPRIMPNL PROWTOKEN PPRIMCMD .
PRIMCMD=x2c(PPRIMCMD)
RC = isfquery()
if RC <> 0 then
do
Say "** SDSF environment does not exist, exec ending."
exit 20
end
RC = isfcalls("ON")
Address SDSF "ISFGET" PPRIMPNL "TOKEN('"PROWTOKEN"')" ,
" (" VERBOSE ")"
LRC = RC
if LRC > 0 then
call msgrtn "ISFGET"
if LRC <> 0 then
Exit 20
JOBNAME = value(JNAME.1)
JOBNBR = value(JOBID.1)
SMPDSN = "SMPE.*.OUTPUT.LISTINGS"
LISTC. = ''
SMPODSNS. = ''
SMPODSNS.0 = 0
$ = outtrap('LISTC.')
MSGVAL = msg('ON')
address TSO "LISTC LVL('"SMPDSN"') ALL"
MSGVAL = msg(MSGVAL)
$ = outtrap('OFF')
do LISTCi = 1 to LISTC.0
if word(LISTC.LISTCi,1) = 'NONVSAM' then
do
parse var LISTC.LISTCi . . DSN
SMPODSNS.0 = SMPODSNS.0 + 1
i = SMPODSNS.0
SMPODSNS.i = DSN
end
IX = pos('ENTRY',LISTC.LISTCi)
if IX <> 0 then
do
IX = pos('NOT FOUND',LISTC.LISTCi,IX + 8)
if IX <> 0 then
do
address ISPEXEC "SETMSG MSG(IPLL403E)"
EXITRC = 16
leave
end
end
end
LISTC. = ''
if EXITRC = 16 then
exit 0
address ISPEXEC "TBCREATE SMPDSNS NOWRITE" ,
"NAMES(TSEL TSMPDSN)"
I execute this code by typing %SMPSAVE next to the spool output line on the "H" SDSF panel and it runs fine until it gets to this point in the REXX:
114 *-* address ISPEXEC "TBCREATE SMPDSNS NOWRITE" ,
"NAMES(TSEL TSMPDSN)"
>>> "TBCREATE SMPDSNS NOWRITE NAMES(TSEL TSMPDSN)"
ISPS118S SERVICE NOT INVOKED. A VALID ISPF ENVIRONMENT DOES NOT EXIST.
+++ RC(20) +++
Does anyone know why it says I don't have a valid ISPF environment and how I can get around this?
I've done quite a bit in the past with REXX, including writing REXX code to handle line commands, but this is the first time I've tried to use ISPEXEC commands within this code.
Thank you,
Alan
I´m looking for a way to create a script in Perl to count the elements in my text file and do it in parts. For example, my text file has this form:
ID Position Potential Jury agreement NGlyc result
(PART 1)
NP_073551.1_HCoV229Egp2 23 NTSY 0.5990 (8/9) +
NP_073551.1_HCoV229Egp2 62 NTSS 0.7076 (9/9) ++
NP_073551.1_HCoV229Egp2 171 NTTI 0.5743 (5/9) +
...
(PART 2)
QJY77946.1_NA 20 NGTN 0.7514 (9/9) +++
QJY77946.1_NA 23 NTSH 0.5368 (5/9) +
QJY77946.1_NA 51 NFSF 0.7120 (9/9) ++
QJY77946.1_NA 62 NTSS 0.6947 (9/9) ++
...
(PART 3)
QJY77954.1_NA 20 NGTN 0.7694 (9/9) +++
QJY77954.1_NA 23 NTSH 0.5398 (5/9) +
QJY77954.1_NA 51 NFSF 0.7121 (9/9) ++
...
(PART N°...)
Like you can see the ID is the same in each part (one for PART 1, other to PART 2 and then...). The changes only can see in the columns Position//Potential//Jury agreement//NGlyc result Then, my main goal is to count the line with Potential 0,7 >=.
With this in mind, I´m looking for output like this:
Part 1:
1 (one value 0.7 >=)
Part 2:
2 (two values 0.7 >=)
Part 3:
2 (two values 0.7 >=)
Part N°:
X numbers of values 0.7 >=
This output tells me the number of positive values (0.7 >=) for each ID.
The pseudocode I believe would be something like this:
foreach ID in LIST
foreach LINE in FILE
if (ID is in LINE)
... count the line ...
end foreach LINE
end foreach ID
I´m looking for any suggestion (for a package or script idea) or comment to create a better script.
Thanks! Best!
To count the number of lines, for each part, that match some condition on a certain column, you can just loop over the lines, skip the header, parse the part number, and use an array to count the number of lines matching for each part.
After this you can just loop over the counts recorded in the array and print them out in your specific format.
#!/usr/bin/perl
use strict;
use warnings;
my $part = 0;
my #cnt_part;
while(my $line = <STDIN>) {
if($. == 1) {
next;
}elsif($line =~ m{^\(PART (\d+)\)}) {
$part = $1;
}else {
my #cols = split(m{\s+},$line);
if(#cols == 6) {
my $potential = $cols[3];
if(0.7 <= $potential) {
$cnt_part[$part]++;
};
};
};
};
for(my $i=1;$i<=$#cnt_part;$i++){
print "Part $i:\n";
print "$cnt_part[$i] (values 0.7 <=)\n";
};
To run it, just pipe the entire file through the Perl script:
cat in.txt | perl count.pl
and you get an output like this:
Part 1:
1 (values 0.7 <=)
Part 2:
2 (values 0.7 <=)
Part 3:
2 (values 0.7 <=)
If you want to also display the counts into words, you can use Lingua::EN::Numbers (see this program ) and you get an output very similar to the one in your post:
Part 1:
1 (one values 0.7 <=)
Part 2:
2 (two values 0.7 <=)
Part 3:
2 (two values 0.7 <=)
All the code in this post is also available here.
I have a code where I read a file and remove a block of line if a certain keyword matches. If I see the key word THERMST, I delete the line before and all lines until I reach a & :
QNODE "CExtHrn - Heater_Bidon" 1.0 T884 TOTAL
THERMST "CExtHrn" 0 2.500000E+01 3.000000E+01 883 ID 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 "Heater_Bidon"
NAME2 Heater_ CExtHrn - Heater_Bidon
NAME Heater_ 40097 40170 1
TABTYPE 884 TABLE OPERATION
TABDATA 884 885 INTERP
TABDATA 884 883 THERMST
TABTYPE 885 QNODE TIME
TABDATA 885 2.000000E+01 0.000000E+00
$
However, for an obscure reason, when I print to a new file, it gives several null characters on a certain line. The weird thing is that this line is not related with the line I just changed. If I don't modify the file, by commenting the following lines, I don't get any null characters.
# We delete the last 2 line and skip the rest of the qnode/thermst definition
splice #INPF1_OUT, -2;
# Skipping the lines until next comment line.
$ii++ until substr($INPF1_IN[$ii], 0, 1) eq '$';
$ii = $ii - 1;
Any idea what this could be? The null characters are causing problems for what I do with the file.
Here is what the line should be :
NAME winte_T 101269 101270 1
here is what it prints in the new file :
NAME winte_T ULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNULNUL 101269 101270 1
You can see that the line that cause the error is not related to the one that should be modified
Thank you, the code is below
#!/bin/perl
use strict;
use Text::ParseWords;
open (INPF1_in, '<', $INPF1)
or die "Not able to open : $INPF1";
my #INPF1_IN = <INPF1_in>;
close INPF1_in;
my #INPF1_OUT; # Output INPF1
my $cardno = 1;
my $ii = 0;
until ($ii > $#INPF1_IN) {
my $INPF_line = $INPF1_IN[$ii];
push(#INPF1_OUT, $INPF_line); # Adding line
chomp($INPF_line);
if ($INPF_line eq "-1") {
$cardno++;
}
if ($cardno == 9) {
my #line = parse_line(" ", 0, $INPF_line); # parsing the line elements
if ($line[0] eq "THERMST") { # If Thermostat
# We delete the last 2 line and skip the rest of the qnode/thermst definition
splice #INPF1_OUT, -2;
$ii++ until substr($INPF1_IN[$ii], 0, 1) eq '$';
$ii = $ii-1; # Skipping the lines until next comment line.
}
}
$ii++;
}
open (INPF1_out, '>', $INPF1);
print INPF1_out $_ foreach #INPF1_OUT;
close INPF1_out;
I may be misreading your code, but it look like you're trying to do something very simple in perl, a very hard way.
If I'm reading it right, what you're trying to do is take an input record format, and conditionally print certain lines. Perl has a very good tool for this, called the 'range operator'.
I think you will be able to accomplish what you want with something considerably simpler.
#!/bin/perl
use strict;
use warnings;
while ( <DATA> ) {
print unless ( m/^THERMST/ ... m/^\$$/ );
}
__DATA__
QNODE "CExtHrn - Heater_Bidon" 1.0 T884 TOTAL
THERMST "CExtHrn" 0 2.500000E+01 3.000000E+01 883 ID 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 "Heater_Bidon"
NAME2 Heater_ CExtHrn - Heater_Bidon
NAME Heater_ 40097 40170 1
TABTYPE 884 TABLE OPERATION
TABDATA 884 885 INTERP
TABDATA 884 883 THERMST
TABTYPE 885 QNODE TIME
TABDATA 885 2.000000E+01 0.000000E+00
$
This is an example, based on the data you've given so far - if you can give a bit more to show exactly what you're trying to accomplish, I would be pretty sure you can extract the information you need without having to do iterating through elements in an array of words. Perl can do better than that.
(I am guessing a bit, as it's completely unclear where you're getting $cardno from. However this should be quite easy to modify to suit your needs)
I have a perl script that needs to run in the background constantly. It consists of several .pm module files and a main .pl file. What the program does is to periodically gather some data, do some computation, and finally update the result recorded in a file.
All the critical data structures are declared in the .pl file with our, and there's no package variable declared in any .pm file.
I used the function arena_table() in the Devel::Gladiator module to produce some information about the arena in the main loop, and found that the SVs of type SCALAR and GLOB are increasing slowly, resulting in a gradual increase in the memory usage.
The output of arena_table (I reformat them, omitting the title. after a long enough period, only the first two number is increasing):
2013-05-17#11:24:34 36235 3924 3661 3642 3376 2401 720 201 27 23 18 13 13 10 2 2 1 1 1 1 1 1 1 1 1 1
After running for some time:
2013-05-17#12:05:10 50702 46169 36910 4151 3995 3924 2401 720 274 201 26 23 18 13 13 10 2 2 1 1 1 1 1 1 1 1 1
The main loop is something like:
our %hash1 = ();
our %hash2 = ();
# and some more package variables ...
# all are hashes
do {
my $nowtime = time();
collect_data($nowtime);
if (calculate() == 1) {
update();
}
sleep 1;
get_mem_objects(); # calls arena_table()
} while (1);
Except get_mem_objects, other functions will operate on the global hashes declared by our. In update, the program will do some log rotation, the code is like:
sub rotate_history() {
my $i = $main::HISTORY{'count'};
if ($i == $main::CONFIG{'times'}{'total'}) {
for ($i--; $i >= 1; $i--) {
$main::HISTORY{'data'}{$i} = dclone($main::HISTORY{'data'}{$i-1});
}
} else {
for (; $i >= 1; $i--) {
$main::HISTORY{'data'}{$i} = dclone($main::HISTORY{'data'}{$i-1});
}
}
$main::HISTORY{'data'}{'0'} = dclone(\%main::COLLECT);
if ($main::HISTORY{'count'} < $main::CONFIG{'times'}{'total'}) {
$main::HISTORY{'count'}++;
}
}
If I comment the calls to this function, in the final report given by Devel::Gladiator, only the SVs of type SCALAR is increasing, the number of GLOBs will finally enter a stable state. I doubt the dclone may cause the problem here.
My questions are,
what exactly does the information given by that module mean? The statements in the perldoc is a little vague for a perl newbie like me.
And, what are the common skills to lower the memory usage of long-running perl scripts?
I know that package variables are stored in the arena, but how about the lexical variables? How are the memory consumed by them managed?
I'm trying to use a Munin plugin for software raid. Here's the plugin's code: https://github.com/munin-monitoring/contrib/blob/master/plugins/disk/raid
Currently my raid is rebuilding, here's the current output:
# cat /proc/mdstat
Personalities : [raid0] [raid1] [raid6] [raid5] [raid4] [raid10]
md2 : active raid1 sda3[0] sdb3[1]
2925544767 blocks super 1.2 [2/2] [UU]
[==>..................] resync = 14.4% (422554560/2925544767) finish=5246.6min speed=7950K/sec
md1 : active raid1 sda2[0] sdb2[1]
524276 blocks super 1.2 [2/2] [UU]
resync=DELAYED
md0 : active raid1 sda1[0] sdb1[1]
4193268 blocks super 1.2 [2/2] [UU]
resync=DELAYED
unused devices: <none>
But when I run the plugin I get the following output (stating that all disks are synced):
# munin-run raid
md2.value 100
md2_rebuild.value 100
md1.value 100
md1_rebuild.value 100
md0.value 100
md0_rebuild.value 100
In the following lines I understand (I'm no programmer) that during the time the code runs, $pct is >= 100, and so $rpct gets set to 100 (which is my output for all raid arrays).
So which values do $nact and $nmem represent in my cat /proc/mdstat output? This would help me find out why $pct is >= 100.
my $pct = 100 * $nact / $nmem;
my $rpct = 100;
if ( $pct < 100 ) {
my #output = `/sbin/mdadm -D /dev/$dev | grep Rebuild`;
if( $output[0] =~ /([0-9]+)% complete/ ) {
$rpct = $1;
} else {
$rpct = 0;
}
I think this regexp holds the answer, but as I said, I'm no programmer :P
while ($text =~ /(md\d+)\s+:\s+active\s+(\(auto-read-only\)\s+|)(\w+)\s+(.*)\n.*\[(\d+)\/(\d+)]\s+\[(\w+)]/ ) {
my($dev,$dummy,$type,$members,$nmem,$nact,$status) = ($1,$2,$3,$4,$5,$6,$7);
Thanks in advance :-)
change this:
if ( $pct < 100 ) {
to this:
if ( $pct <= 100 ) {
and make sure you're running the plugin as root