I've got my program keymap (it is not yet actually mapping any keys yet and is currently only printing out what it sees in hex) here:
#!/usr/bin/env perl
use strict;
use warnings;
use Term::ReadKey;
ReadMode 4;
END {
ReadMode 0; # Reset tty mode before exiting
}
if ($ARGV[0] ~~ ["h", "-h", "--help", "help"]) {
print "Usage: (h|-h|--help|help)|(code_in codes_out [code_in codes_out]+)\nNote: output codes can be arbitrary length";
exit;
}
$#ARGV % 2 or die "Even number of args required.\n";
$#ARGV >= 0 or warn "No args provided. Output should be identical to input.\n";
my $interactive = -t STDIN;
my %mapping = #ARGV;
{
local $| = 1;
my $key;
while (ord(($key = ReadKey(0))) != 0) {
printf("saw \\x%02X\n",ord($key));
if ($interactive and ord($key) == 4) {
last;
}
}
}
Here's what happens:
slu#new-host:~/util 20:50:20
❯ keymap a b
saw \x61
saw \x62
saw \x04
There I had typed on my keyboard abCtrl+D.
slu#new-host:~/util 20:50:24
❯ echo "^D^Da" | keymap
No args provided. Output should be identical to input.
saw \x04
saw \x04
saw \x61
saw \x0A
Use of uninitialized value $key in ord at /Users/slu/util/keymap line 30.
I'm wondering what the meaning of this is. Is it simply a case of Perl "not counting" the loop condition as "setting" $key? Is there some sort of thing I can do to suppress the warning here? I know about no warnings "uninitialized";, I don't want that.
There's a known bug that warnings issued by the condition expression of a while loop can be misattributed to the statement in the loop evaluated just before the while condition.
The code issuing the warning is actually the condition of the while loop, ord(($key = ReadKey(0))) != 0.
ReadKey(0) is returning undef, and you are trying to get the ord or it.
while (1) {
my $key = ReadKey(0);
last if !defined($key) || ord($key) == 0;
printf("saw \\x%02X\n",ord($key));
last if $interactive and ord($key) == 4;
}
Related
I am encountering an issue while trying to execute a perl script that takes 2 number arguments, well say $ARGV[0] is 2, and $ARGV[1] is 4. I need to print a list that shows 2,3,4 with no comma after the last item. Below is my script as it is now:
unless ((#ARGV)==2){
print "error: incorrect number of arguments",
"\n",
"usage: inlist.pl a b (where a < b)",
"\n";
exit VALUE;
}
if ($ARGV[0] > $ARGV[1]){
print "error: first argument must be less than second argument",
"\n",
"usage: intlist.pl a b (where a < b)",
"\n";
exit VALUE;
}
else {
$COUNTER=$ARGV[0];
while($COUNTER <= $ARGV[1]){
print $COUNTER;
$COUNTER += 1;
if ($COUNTERELATIONAL < $ARGV[1]){
print ", ";
}
else {
print "\n";
}
$COUNTERSYNTAX
}
}
exit VALUE;
I tried using join but to no avail I keep getting as return of 2,3,4,
I feel like i must be missing something simple
Rewriting your code to simplify it:
# Prefer 'if' over 'unless' in most circumstances.
if (#ARGV != 2) {
# Consider using 'die' instead of 'print' and 'exit'.
print "error: incorrect number of arguments\n",
"usage: inlist.pl a b (where a < b)\n";
# Not sure what VALUE is, but I assume you've
# defined it somewhere.
exit VALUE;
}
if ($ARGV[0] > $ARGV[1]) {
# Consider using 'die' instead of 'print' and 'exit'.
print "error: first argument must be less than second argument\n",
"usage: intlist.pl a b (where a < b)\n";
exit VALUE;
}
# Removed 'else' branch as it's unnecessary.
# Use 'join' instead of a complicated loop.
print join(',', $ARGV[0] .. $ARGV[1]), "\n";
# This looks like a successful execution to me, so
# that should probably be 'exit 0'.
exit VALUE;
If I was writing it for myself, I'd make it a little shorter:
my %errors = (
NUMBER => 'incorrect number of arguments',
RANGE => 'first argument must be less than second argument',
);
my $usage = 'usage: inlist.pl a b (where a < b)';
die "$errors{NUMBER}\n$usage\n" if #ARGV != 2;
die "$errors{RANGE}\n$usage\n" if $ARGV[0] > $ARGV[1];
print join(',', $ARGV[0] .. $ARGV[1]), "\n";
exit 0;
I figured it out:
while($COUNTER <= $ARGV[1]){
print $COUNTER;
$COUNTER += 1;
if ($COUNTER <= $ARGV[1]){
print ", ";
}
else {
print "\n";
}
I needed to change the if to $COUNTER and <= and it printed correctly. Thank you for the join suggestion, that would have worked if I had designed the script more efficiently
I was having a difficulty about perl script..I have a script that includes a loop but never breaks out of it once it gets the exit status zero.The loop will run only once the exit status results a 1 upon checking initially by the "if" statement.
my $a = "/home/vivek/generated_mdsum_reference.out";
my $b = "/home/vivek/generated_mdsum_new.out";
sub CHECK {
print "\n";
print "\n";
print "\n\tGenerating MD5SUM ....";
my $dumpfile = "/home/vivek/file_dump.dmp";
print "\n";
# my $md5sum = system("md5sum $dumpfile");
my $md5sum = `md5sum $dumpfile`;
print "\n";
print "\nChecksum: $md5sum.";
# Put checksum in file
my $ochksumfile = "/home/vivek/generated_mdsum_new.out";
open (my $fh, '>', "$ochksumfile") or die "no file:$!";
my $output = $md5sum;
die "$!" if $?;
$value = (split / /, "$output")[0];
print $fh $value;
my $status =compare($b, $a);
}
my $status =compare($b, $a);
if ( $status == 1 ){
do
CHECK;
until ($status == 0 ) {
print "\n\tfiles are now Ok. Exiting..";
print "\n\t";
}
All the variables I have set in there works fine, I only ended up in the until loop which it keeps on running endlessly which I think it cannot get through until the rest of the function "CHECK"
Please help me guys.
Let's look at the block in question
my $status = compare($b, $a);
if ( $status == 1 ) {
do
CHECK;
until ($status == 0 ) {
print "\n\tfiles are now Ok. Exiting..";
print "\n\t";
}
whether you meant it or not, this is equivalent to
my $status = compare($b, $a);
if ( $status == 1 ) {
do CHECK;
until ( $status == 0 ) {
print "\n\tfiles are now Ok. Exiting..";
print "\n\t";
}
So the contents of your until loop is just two print statements, which aren't going to change the value of $status so it will loop forever
What I think you meant is
my $status = compare($b, $a);
if ( $status == 1 ) {
do {
CHECK;
} until $status == 0;
print "\n\tfiles are now Ok. Exiting..";
print "\n\t";
}
which will repeatedly call CHECK until $status is set to zero
EXCEPT THAT you should always use lower-case characters in your local identifiers. Upper-case is reserved for global identifiers such as package names. In this situation you have unwittingly created a CHECK block
perldoc perlmod says this
Five specially named code blocks are executed at the beginning and at the end of a running Perl program. These are the BEGIN , UNITCHECK , CHECK , INIT , and END blocks.
These code blocks can be prefixed with sub to give the appearance of a subroutine (although this is not considered good style). One should note that these code blocks don't really exist as named subroutines (despite their appearance). The thing that gives this away is the fact that you can have more than one of these code blocks in a program, and they will get all executed at the appropriate moment. So you can't execute any of these code blocks by name.
So because "these code blocks don't really exist as named subroutines" your program will only call CHECK during compilation, and subsequent explicit calls will be ignored
So rename your subroutine to check and chnage your code to this
my $status = compare($b, $a);
if ( $status == 1 ) {
do {
CHECK;
} until $status == 0;
print "\n\tfiles are now Ok. Exiting..";
print "\n\t";
}
and all will be well
I do not understand why the until loop should stop.
In short, you get an md5 sum for a file in your "CHECK" sub.
sub CHECK {
open (my $fh, '>', "/home/vivek/generated_mdsum_new.out");
my $dump_file = "/home/vivek/file_dump.dmp";
my $md5sum = `md5sum $dump_file`;
my $value = (split(" ",$md5sum))[0];
print $fh $value;
close $fh;
compare($a,$b);
# question: what is in $a / $b and what does compare do ?
}
Now you compare $a and $b and return that result.
Assuming $a / $b contain something useful, there is nothing in the until block or CHECK block that I see to change either, so the comparison would keep returning the same result ( assuming "compare" compares and does not change anything, which would be a bad naming if it did ).
So in the until block, do something to influence the CHECK, otherwise you are stuck in a loop.
You should always use lower-case characters in your local identifiers. Upper-case is reserved for global identifiers such as package names. In this situation you have unwittingly created a CHECK block
perldoc perlmod says this
Five specially named code blocks are executed at the beginning and at the end of a running Perl program. These are the BEGIN , UNITCHECK , CHECK , INIT , and END blocks.
These code blocks can be prefixed with sub to give the appearance of a subroutine (although this is not considered good style). One should note that these code blocks don't really exist as named subroutines (despite their appearance). The thing that gives this away is the fact that you can have more than one of these code blocks in a program, and they will get all executed at the appropriate moment. So you can't execute any of these code blocks by name.
So because "these code blocks don't really exist as named subroutines" your program will only call CHECK during compilation. That means explicit calls to CHECK will be ignored, and $status never changes
Change your subroutine to check and all will be well
The problem is here:
until ($status == 0 ) {
print "\n\tfiles are now Ok. Exiting..";
print "\n\t";
}
Nowhere in the loop are you changing the value of $status.
The "do CHECK;" isn't part of the loop.
Would eval a file by the name of the return value of the CHECK sub
If it had actually called that sub.
Which it won't because it isn't actually a subroutine.
The other form of until is:
do {
CHECK; # doesn't work as this is a special name
} until $status == 0;
print "\n\tfiles are now Ok. Exiting..";
print "\n\t";
Which is still a problem as CHECK is a special name for a block that only gets called once at CHECK time, that you can't actually call.
Plus the code in CHECK would always have the same result, so calling it repeatedly doesn't make sense, and could still result in an infinite loop if it didn't work the first time.
This is how I might have written it
This is a first pass of making your code make sense to me, also fixing some of the errors pointed out above.
I also changed $a and $b to $ref and $new since $a and $b are reserved variables.
I improved it by using modules that come with Perl, so that I don't have to check the return values of open() and close() ( autodie ), or rely on conventions of a particular platform ( Digest::MD5, and File::Spec::Functions ).
I assume that you loaded File::Compare.
I removed the setting of $status from the check sub to reduce the use of global variables.
#! /usr/bin/env perl
use strict;
use warnings;
use 5.10.1; # set minimum version which was released in 2009
use autodie;
use File::Spec::Functions qw' catfile catdir rootdir curdir ';
use Digest::MD5;
use File::Compare qw' compare ';
# should be // not ||, but it will work if your dir isn't named "0" or ""
my $basedir = $ENV{HOME} || catdir rootdir, qw' home vivek ';
# try the current directory if it doesn't exist
$basedir = curdir unless -d $basedir;
my $ref = catfile $basedir, 'generated_mdsum_reference.out';
my $new = catfile $basedir, 'generated_mdsum_new.out';
my $dumpfile = catfile $basedir, 'file_dump.dmp';
# forward declare so that we can put them at the end
sub md5_hex_file;
sub md5_sum;
sub check;
#-------------------------------------------------------
if ( compare($new, $ref) != 0 ){
if ( check($dumpfile,$new) == 0 ){
print "\n\tfiles are now Ok. Exiting..\n";
} else {
local $| = 1; # make sure the output is flushed to STDOUT
print "\n\tfiles are NOT OK. Exiting..\n";
exit 1;
}
}
#-------------------------------------------------------
# helper subroutines
sub md5_hex_file {
my ($filename) = #_;
# let Digest::MD5 read the file for us
my $ctx = Digest::MD5->new;
{ # limit scope of $fh
open my $fh, '<', $filename;
binmode $fh;
$ctx->addfile( $fh );
close $fh;
}
$ctx->hexdigest;
}
# no longer necessary
sub md5_sum {
my ($filename) = #_;
# `md5sum -b $filename`
md5_hex_file($filename) . " $filename\n";
}
sub check {
my ( $infile, $outfile ) = #_
print "\n" x 3, "\tGenerating MD5SUM ....\n";
my $md5_hex = md5_hex_file $infile;
print "\n" x 2, "Checksum: $md5_hex.\n";
# Put checksum in file
{
open my $out_fh, '>', $outfile;
print {$out_fh} $md5_hex;
close $out_fh;
}
my $status = compare $new, $ref;
return $status if $status == 0;
# add a newline and hope that fixes it
{
open my $out_fh, '>>', $outfile;
print {$out_fh} "\n";
close $out_fh;
}
return compare $new, $ref;
}
Really I think you could have just used these "one-liners"
$ perl -Mautodie -MDigest::MD5 -e \
'open $fh, q[<], shift;
print Digest::MD5->new->addfile($fh)->hexdigest' \
file_dump.dmp > generated_mdsum_new.out
$ perl -MFile::Compare -e \
'if ( compare(shift(),shift()) == 0 ){
print qq[They match\n]
} else {
print qq[They don\'t match\n]
}' \
generated_mdsum_new.out generated_mdsum_reference.out
I am unable to get desired output.
Please help to correct my errors.
file1
A
B
C
D
E
F
file2
A
D
C
Desired Output (if found print '1' at relative position in larger file and if not print '0')
1
0
1
1
0
0
code
#!/usr/bin/perl -w
open(FH,$file);
#q=<FH>;
open(FH1,$file2);
#d=<FH1>;
open(OUT,">out.txt");
foreach $i(#q) {
foreach $j(#d) {
if ($i eq $j) {
$id=1 ;
goto LABEL;
} elsif ($i ne $j) {
$id=1;
goto LABEL;
}
}
}
print OUT "1\t";
LABEL:
print OUT "0\t";
}
close FH;
close FH1;
close OUT;
note: actual files are much much larger and contain uneven number of elements.
You were looking for
for $q (#q) {
my $found = 0;
for $d (#d) {
if ($q eq $d) {
$found = 1;
goto LABEL;
}
}
LABEL: print "$found\n";
}
The above is better written as follows:
for $q (#q) {
my $found = 0;
for $d (#d) {
if ($q eq $d) {
$found = 1;
last;
}
}
print "$found\n";
}
But those solutions perform poorly. You can avoid iterating over #d repeatedly by using a hash.
my %d = map { $_ => 1 } #d;
for $q (#q) {
print $d{$q} ? "1" : "0", "\n";
}
Consider the following approach:
use strict;
use warnings;
use autodie;
use feature 'say';
open my $fh1, '<', 'file1';
open my $fh2, '<', 'file2';
say <$fh1> eq <$fh2> ? '1' : '0'
until eof $fh1 or eof $fh2;
Notes:
use strict; use warnings; to maintain sanity
autodie to take care of failed file opens
Lexical filehandles are preferred to bareword filehandles
say for syntactic sugar to automatically append a newline at the end of every 1 or 0
Diamond operator to read in each filehandle line-by-line
eq to string-compare the two lines
Ternary operator (COND ? TRUE : FALSE) to decide whether to print 1 or 0
until is a negated while
eof to tell the loop when either of the two filehandles has been exhausted
As it was said don't use LABEL. And to be honest you don't need perl for that, because join and sed do the job (may be you need to sort the files first):
join -a1 -a2 -e "0" -o 2.1 file1.txt file2.txt | sed "s/[^0]/1/g"
May be you need to sort your files first - in this case have a look at this post: comparing to unsorted files.
To be honest LABEL is not your friend - don't do that. For me it sounds more like a job for the join. But if you want to solve it using Perl I would try the following:
If the input files are sorted (otherwise you can use sort to achieve that) compare them line by line and print the result:
while ($line_from_f1 = <F1>)
{
$line_from_f2=<F2>;
if ($line_from_f1 eq $line_from_f2)
{
print "1\n";
}
else
{
print "0\n";
}
}
Shorter version (untested):
while (<F1>)
{
print ($_ eq <F2>)."\n";
}
Note: These versions compare the files line by line - if a line is missing in the middle it does not work properly.
#!/usr/bin/env perl
use Term::ReadKey;
ReadMode 4;
END {
ReadMode 0; # Reset tty mode before exiting
}
while (<>) {
$key = ReadKey(0);
$key == "\x04" and last; # Ctrl+D breaks the loop
print $key;
}
When I had it without the while loop, it was printing back what I typed in.
It doesn't even produce any output at the end (if it was buffering it or something). Like I'd run it and type a few letters and hit Ctrl+D. It prints nothing.
I'm trying to make a program to convert mouse scroll escape codes into keypresses. I hope I'm not barking up the wrong tree.
This line
while (<>)
reads a line from STDIN (assuming you ran the program with no command line arguments). Once a line has been read, it enters the body of the while loop. Whatever you typed up to and including the newline is now in $_.
Now, you press a key, it's stored in $key and numerically compared to CTRL-D. Since neither is numeric, they both end up being zero, the loop terminates.
This is why you should turn on warnings which would have told you:
Argument "^D" isn't numeric in numeric eq (==) at ./tt.pl line 15, line 1.
Argument "c" isn't numeric in numeric eq (==) at ./tt.pl line 15, line 1.
Of course, it would make sense to put the loop-termination condition where it belongs as well:
#!/usr/bin/env perl
use strict;
use warnings;
use Term::ReadKey;
ReadMode 4;
END {
ReadMode 0; # Reset tty mode before exiting
}
my $input;
{
local $| = 1;
while ((my $key = ReadKey(0)) ne "\x04") {
print $key;
$input .= $key;
}
}
print "'$input'\n";
Just replace the while condition to:
while(1) {
# ...
}
I have the following question:
I want to create a perl script that reads from a text file (file with several columns of numbers) and calculate some statistics (mean, median, sd, variance). I already built one script, but as I am not in love yet with perl, I can't fix the problems of syntax on it...
Here is my perl script..
#!/usr/bin/perl -w
use strict;
open(FILEHANDLE, data.txt);
while (<FILEHANDLE>) {
shift #ARGV;
my #array = split(\t,$_);
}
close(FILEHANDLE);
###### mean, sum and size
$N = $sum = 0;
$array[$x-1];
$N++;
$sum += $array[$x-1];
###### minimum and the maximum
($min = 0, $max = 0);
$max = $array[$x-1] if ($max < $array[$x-1]), (my#sorted = sort { $a <=> $b } #samples) {
print join(" ",#sorted);
}
##### median
if ($N % 2==1) {
print "$median = $sorted[int($N/2)]\n"; ## check this out
};
else ($median = ($sorted[$N/2] + $sorted[($N/2)-1]) / 2)) {
print "$median\n"; # check this out
};
##### quantiles 1º and 3º
if $qt1 = $sorted[$r25-1] {
print "\n"; # check this out
};
else $qt1 = $fr*($sorted[$ir] - $sorted[$ir-1]) + $sorted[$ir-1] {
print "\n"; # check this out
};
##### variance
for (my $i=0;
$i<scalar(#samples);
$i++)
{
$Var += ($samples[$i]-$mean)**2;
$Var = $Var/($N-1);
};
###### standard error
($Std = sqrt($Var)/ sqrt($N));
############################################################
print "$min\n";
print "$max\n";
print "$mean\n";
print "$median\n";
print "$qt1\n";
print "$var\n";
print "$std\n";
exit(0);
I want to get it working. Please help. THANKS IN ADVANCE!
Errors in your code:
open(FILEHANDLE, data.txt);
data.txt needs to be quoted. You are not checking the return value of the open, e.g. ... or die $!. You should use a lexical filehandle and three argument open, e.g. open my $fh, '<', "data.txt" or die $!.
shift #ARGV;
This does nothing except remove the first value from you argument list, which is then promptly discarded.
my #array = split(\t,$_);
You are using \t as a bareword, it should be a regex, /\t/. Your #array is declared inside a lexical scope of the while loop, and will be undefined outside this block.
$N = $sum = 0;
Both variables are not declared, which will cause the script to die when you use strict (which is a very good idea). Use my $N to solve that. Also, $N is not a very good variable name.
$array[$x-1];
This will do nothing. $x is not declared (see above), and also undefined. The whole statement does nothing, it is like having a line 3;. I believe you will get an error such as Useless use of variable in void context.
$N++;
This increments $N to 1, which is a useless thing to do, since you only a few lines above initialized it to 0.
Well.. the list goes on. I suggest you start smaller, use strict and warnings since they are very good tools, and work out the errors one by one. A very good idea would be to make subroutines of your calculations, e.g.:
sub sum {
# code here
return $sum;
}
Go to perldoc.perl.org and read the documentation. Especially useful would be the syntax related ones and perlfunc.
Also, you should be aware that this functionality can be found in modules, which you can find at CPAN.
Your main problem is you have not declared your variables such as $N, $max, etc.
You need to introduce all new variables with my the first time you reference them. Just like you did with $array and $i. So for example
$N = $sum = 0;
Should become
my( $N, $sum ) = ( 0, 0 );