Read single characters, and use Return as EOL instead of Ctrl-D in Linux - perl

I'm a beginner to perl, and just started reading user input in my script.
chomp(my $inp = <> );
I have been used to using Return key as the terminator for user input in other languages, and am unsure how to stop reading user input after getting a single key press, or some characters followed by Return key. In perl running on unix, capturing input via the diamond operator, seems to require pressing Ctrl-D for end of input.
My problem is that I'd like to build an interactive menu where user is presented a list and asked to press "A", "B" or "C". Once he presses any of these keys, I'd like to loop according to conditions, without waiting for him to press Ctrl D. How can I get this level of interactive user input in perl? In C, I'd use getch. In Bash, I'd use a read and $REPLY.
I'd also like to know how to use the Return key to terminate user input.
For getting single characters, perldoc mentions:
if ($BSD_STYLE) {
system "stty cbreak </dev/tty >/dev/tty 2>&1";
}
else {
system "stty", '-icanon', 'eol', "\001";
}
$key = getc(STDIN);
if ($BSD_STYLE) {
system "stty -cbreak </dev/tty >/dev/tty 2>&1";
}
else {
system 'stty', 'icanon', 'eol', '^#'; # ASCII NUL
}
print "\n";
Surely in a language like perl, it isnt that difficult?
Edit: It seems like what I was looking for isnt natively available. However, IO::Prompter seems to be the solution.

The diamond operator reads one line in scalar context, and one file in array context. Ctrl-D is EOF, Return is EOL.
Because chomp supplies a list context, you have to break this up:
my $inp = <>;
chomp $inp;
The portable way to read a single keypress is Term::Readkey. See http://learn.perl.org/faq/perlfaq5.html#How-can-I-read-a-single-character-from-a-file-From-the-keyboard-

Related

Discarding extra newlines on STDIN in Perl without Term::ReadKey

I've been digging through search engine results and Stack Overflow trying to solve this problem, and I've tried a dozen different "solutions" to no avail. I cannot use Term::ReadKey, as most solutions suggest, due to limitations of my environment.
The existing Perl script does:
my $mode1=<STDIN>;
chomp($mode1);
but many of the prompts don't evaluate the input - for example the user could enter an arbitrary string - but the script only chomps the input and then ignores the contents. Several prompts ask for input but pressing [ENTER] without entering input applies default values.
If the user gets impatient while the script is in a blocking function or checks to see if the terminal is responding by pressing [ENTER], those newline characters advance the script inappropriately when the blocking function ends. I don't want to rely on user training instead of automation, and it seems like there must be an easy obvious solution but I can't seem to dig one up.
It isn't originally my script, and its author admits it was quick-and-dirty to begin with.
The 4-argument select function is a little cryptic to use, but it can tell you, in many cases, whether there is any unread input waiting on an input filehandle. When it is time for your program to prompt the user for input, you can use select to see if there is any extra input on STDIN, and clear it before you prompt the user again and ask for additional input.
print "Prompt #48: are you tired of answering questions yet? [y/N]";
clearSTDIN();
$ans48 = <STDIN>;
...
sub clearSTDIN {
my $rin = "";
vec($rin, fileno(STDIN), 1) = 1;
my ($found,$left) = select $rin,undef,undef,0;
while ($found) {
# $found is non-zero if there is any input waiting on STDIN
my $waste = <STDIN>; # consume a line of STDIN
($found,$left) = select $rin,undef,undef,0;
}
seek STDIN,0,1; # clears eof flag on STDIN handle
}
Is the easy solution to close STDIN?
print "Are you sick of answering questions yet? [y/N] ";
$ans = <STDIN>;
if ($ans =~ /^y/i) {
close STDIN;
# from now on, further calls to <STDIN> will immediately
# return undef and will assign default values
}
...

Script is not running or showing errors

I am writing a script that looks at an access_log file to see how many times each search engine was accessed and to see which one is accessed the most. I am sure there are problems with some of my syntax, but I can't even tell since I am not receiving any information back when running it. Any help would be appreciated!
Code:
#!/usr/bin/perl
use 5.010;
$googleCount = 0;
$msnCount = 0;
$yahooCount = 0;
$askCount = 0;
$bingCount = 0;
while (<STDIN>)
{
if (/(google.com)/)
{
$googleCount++;
}
if (/(msn.com)/)
{
$msnCount++;
}
if (/yahoo.com/)
{
$yahooCount++;
}
if (/ask.com/)
{
$askCount++;
}
if (/bing.com/)
{
$bingCount++;
}
}
print "Google.com was accessed $googleCount times in this log.\n";
print "MSN.com was accessed $msnCount times in this log.\n";
print "Yahoo.com was accessed $yahooCount times in this log.\n";
print "Ask.com was accessed $askCount times in this log.\n";
print "Bing.com was accessed $bingCount times in this log.\n";
I am running MacOS. In the terminal I am typing:
perl -w access_scan.pl access_log.1
When I press enter, nothing happens.
Beside the fact that your script didn't work as you expected, there are a few things wrong with your script:
In regexes, the dot . matches any non-newline character. This includes a literal period, but is not restricted to that. Either escape it (/google\.com/) or protect special characters with \Q...\E: /\Qgoogle.com\E/.
There is a programming proverb “Three or more, use a for”. All your conditionals inside your loop are the same, except for the regex. You counts are actually one variable. Your report at the end is the same line multiple times.
You can use a hash to ease the pain:
#!/usr/bin/perl
use strict; use warnings; use feature 'say';
my %count; # a hash is a mapping of strings to scalars (e.g. numbers)
my #sites = qw/google.com msn.com yahoo.com ask.com bing.com/;
# initialize the counts we are interested in:
$count{$_} = 0 foreach #sites;
while (<>) { # accept input from files specified as command line options or STDIN
foreach my $site (#sites) {
$count{$site}++ if /\Q$site\E/i; # /i for case insensitive matching
}
}
foreach my $site (#sites) {
say "\u$site was accessed $count{$site} times in this log";
}
The \u uppercases the next character, this is required to produce identical output.
The say is exactly like print, but appends a newline. It is available in perl5 v10 or later.
The script is trying to read from STDIN, but you are providing the filename to read from as an argument.
"Nothing happens" because the script is waiting for input (which, since you haven't redirected anything to standard input, it expects you to type).
Change <STDIN> to <> or change the command to perl -w access_scan.pl < access_log.1
Your script is reading from stdin, but you're providing your input as a file. You need to redirect thus:
perl -w access_scan.pl < access_log.1
The < file construct provides the contents of your file as the standard input for your script.
The script works fine (I tested it), but you need to feed it with the log in the STDIN:
cat access_log.1 | perl -w access_scan.pl

Clear already printed values using perl

I need to clear the printed values in perl console window. For an example,
Note: I am developing this in Windows OS.
use strict;
my $mode;
Initialize();
sub Initialize{
print "Enter 1 or 2";
$mode=<STDIN>;
chomp($mode);
check_mode($mode);
}
sub check_mode{
if(($mode!=1) and ($mode!=2)){
print "invalid selection";
Initialize();
}
else{
print "valid selection";
sleep 5;
}
}
While entering wrong selection, I have called the Initialize function, it is printing again. But, what I want is while calling the function it should delete already printed value in the console window and it should print again. Is it possible?
Please give your valuable suggestions.
While you can use the backspace character code "\b" to erase characters on the current line, that has limitations since when the user hits enter it will print a linefeed and your backspace characters won't carry back up to erase the previous line.
See Win32::Console which should allow you to print your prompt at a fixed location and then later overwrite the wrong selection or you can get input a single character at a time using the InputChar method and suppress the newline...
for specific to window os and linux os
system($^O =~ /win/i ? 'cls' : 'clear');

In Perl, how do I determine if there's a standard input present?

I've got a script that grabs standard input:
&process_input
sub process_input {
while(<STDIN>) {
$log_data .= $_;
}
}
When I run the script:
myscript.pl -param1=a -param2=b
I get stuck in this subroutine. Everything runs OK if I do:
echo "" | myscript.pl -param1=a -param2=b
How do I determine if I even have a standard input?
I would have thought that while(<STDIN>) would return false and not run, but I'm guessing it's actually waiting for you to type something in that why it's 'stuck'.
You want to check where your STDIN (STanDard INput) is coming from: another application or a terminal. In your case, it's the second option, causing a read operation to stall the process until the user inputs something. For a solution, see How can I tell if STDIN is connected to a terminal in Perl?.
if (-t STDIN) {
# input attached to terminal and will probably ask user
} else {
# input from other process
}
There's also IO::Interactive that might do better/more reliable checking.
The statement <STDIN> does not return until you press Enter on the console. If you want to get around this, I believe that you can use IO::Handle to wrap STDIN, and call $stdin->blocking(0) to enable non-blocking I/O.
That's normal. Standard usage for Unix tools is to use STDIN if no input file is given as an argument. Try cat, less, grep, etc. It's up to the caller to provide input, if only
tool < /dev/null
I strongly advise against trying to determine if "input" is available as it will introduce problems no matter how you achieve this. Specifically, avoid -t since it's problematic to fake a terminal when needed. Instead, rely on a more conventional interface.
If you want to make it possible to pass no input to your tool, it's weird that you'd be using STDIN in the first place. One would normally use an optional argument.
tool --foo file
tool --foo <( echo "" )
Another option would be to request that the user tells you when there is no input.
tool --batch
In order to help you with the design problems of your interface, it would really help to know what your tool does.
Your program will continue when the user types Ctrl + D, the end-of-file character.

Can someone suggest how this Perl script works?

I have to maintain the following Perl script:
#!/usr/bin/perl -w
die "Usage: $0 <file1> <file2>\n" unless scalar(#ARGV)>1;
undef $/;
my #f1 = split(/(?=(?:SERIAL NUMBER:\s+\d+))/, <>);
my #f2 = split(/(?=(?:SERIAL NUMBER:\s+\d+))/, <>);
die "Error: file1 has $#f1 serials, file2 has $#f2\n" if ($#f1 != $#f2);
foreach my $g (0 .. $#f1) {
print (($f2[$g] =~ m/RESULT:\s+PASS/) ? $f2[$g] : $f1[$g]);
}
print STDERR "$#f1 serials found\n";
I know pretty much what it does, but how it's done is difficult to follow. The calls to split() are particulary puzzling.
It's fairly idiomatic Perl and I would be grateful if a Perl expert could make a few clarifying suggestions about how it does it, so that if I need to use it on input files it can't deal with, I can attempt to modify it.
It combines the best results from two datalog files containing test results. The datalog files contain results for various serial numbers and the data for each serial number begins and ends with SERIAL NUMBER: n (I know this because my equipment creates the input files)
I could describe the format of the datalog files, but I think the only important aspect is the SERIAL NUMBER: n because that's all the Perl script checks for
The ternary operator is used to print a value from one input file or the other, so the output can be redirected to a third file.
This may not be what I would call "idiomatic" (that would be use Module::To::Do::Task) but they've certainly (ab)used some language features here. I'll see if I can't demystify some of this for you.
die "Usage: $0 <file1> <file2>\n" unless scalar(#ARGV)>1;
This exits with a usage message if they didn't give us any arguments. Command-line arguments are stored in #ARGV, which is like C's char **argv except the first element is the first argument, not the program name. scalar(#ARGV) converts #ARGV to "scalar context", which means that, while #ARGV is normally a list, we want to know about it's scalar (i.e. non-list) properties. When a list is converted to scalar context, we get the list's length. Therefore, the unless conditional is satisfied only if we passed no arguments.
This is rather misleading, because it will turn out your program needs two arguments. If I wrote this, I would write:
die "Usage: $0 <file1> <file2>\n" unless #ARGV == 2;
Notice I left off the scalar(#ARGV) and just wrote #ARGV. The scalar() function forces scalar context, but if we're comparing equality with a number, Perl can implicitly assume scalar context.
undef $/;
Oof. The $/ variable is a special Perl built-in variable that Perl uses to tell what a "line" of data from a file is. Normally, $/ is set to the string "\n", meaning when Perl tries to read a line it will read up until the next linefeed (or carriage return/linefeed on Windows). Your writer has undef-ed the variable, though, which means when you try to read a "line", Perl will just slurp up the whole file.
my #f1 = split(/(?=(?:SERIAL NUMBER:\s+\d+))/, <>);
This is a fun one. <> is a special filehandle that reads line-by-line from each file given on the command line. However, since we've told Perl that a "line" is an entire file, calling <> once will read in the entire file given in the first argument, and storing it temporarily as a string.
Then we take that string and split() it up into pieces, using the regex /(?=(?:SERIAL NUMBER:\s+\d+))/. This uses a lookahead, which tells our regex engine "only match if this stuff comes after our match, but this stuff isn't part of our match," essentially allowing us to look ahead of our match to check on more info. It basically splits the file into pieces, where each piece (except possibly the first) begins with "SERIAL NUMBER:", some arbitrary whitespace (the \s+ part), and then some digits (the \d+ part). I can't teach you regexes, so for more info I recommend reading perldoc perlretut - they explain all of that better than I ever will.
Once we've split the string into a list, we store that list in a list called #f1.
my #f2 = split(/(?=(?:SERIAL NUMBER:\s+\d+))/, <>);
This does the same thing as the last line, only to the second file, because <> has already read the entire first file, and storing the list in another variable called #f2.
die "Error: file1 has $#f1 serials, file2 has $#f2\n" if ($#f1 != $#f2);
This line prints an error message if #f1 and #f2 are different sizes. $#f1 is a special syntax for arrays - it returns the index of the last element, which will usually be the size of the list minus one (lists are 0-indexed, like in most languages). He uses this same value in his error message, which may be deceptive, as it will print 1 fewer than might be expected. I would write it as:
die "Error: file $ARGV[0] has ", $#f1 + 1, " serials, file $ARGV[1] has ", $#f2 + 1, "\n"
if $#f1 != $#f2;
Notice I changed "file1" to "file $ARGV[0]" - that way, it will print the name of the file you specified, rather than just the ambiguous "file1". Notice also that I split up the die() function and the if() condition on two lines. I think it's more readable that way. I also might write unless $#f1 == $#f2 instead of if $#f1 != $#f2, but that's just because I happen to think != is an ugly operator. There's more than one way to do it.
foreach my $g (0 .. $#f1) {
This is a common idiom in Perl. We normally use for() or foreach() (same thing, really) to iterate over each element of a list. However, sometimes we need the indices of that list (some languages might use the term "enumerate"), so we've used the range operator (..) to make a list that goes from 0 to $#f1, i.e., through all the indices of our list, since $#f1 is the value of the highest index in our list. Perl will loop through each index, and in each loop, will assign the value of that index to the lexically-scoped variable $g (though why they didn't use $i like any sane programmer, I don't know - come on, people, this tradition has been around since Fortran!). So the first time through the loop, $g will be 0, and the second time it will be 1, and so on until the last time it is $#f1.
print (($f2[$g] =~ m/RESULT:\s+PASS/) ? $f2[$g] : $f1[$g]);
This is the body of our loop, which uses the ternary conditional operator ?:. There's nothing wrong with the ternary operator, but if the code gives you trouble we can just change it to an if(). Let's just go ahead and rewrite it to use if():
if($f2[$g] =~ m/RESULT:\s+PASS/) {
print $f2[$g];
} else {
print $f1[$g];
}
Pretty simple - we do a regex check on $f2[$g] (the entry in our second file corresponding to the current entry in our first file) that basically checks whether or not that test passed. If it did, we print $f2[$g] (which will tell us that test passed), otherwise we print $f1[$g] (which will tell us the test that failed).
print STDERR "$#f1 serials found\n";
This just prints an ending diagnostic message telling us how many serials were found (minus one, again).
I personally would rewrite that whole hairy bit where he hacks with $/ and then does two reads from <> to be a loop, because I think that would be more readable, but this code should work fine, so if you don't have to change it too much you should be in good shape.
The undef $/ line deactivates the input record separator. Instead of reading records line by line, the interpreter will read whole files at once after that.
The <>, or 'diamond operator' reads from the files from the command line or standard input, whichever makes sense. In your case, the command line is explicitely checked, so it will be files. Input record separation has been deactivated, so each time you see a <>, you can think of it as a function call returning a whole file as a string.
The split operators take this string and cut it in chunks, each time it meets the regular expression in argument. The (?= ... ) construct means "the delimiter is this, but please keep it in the chunked result anyway."
That's all there is to it. There would always be a few optimizations, simplifications, or "other ways to do it," but this should get you running.
You can get quick glimpse how the script works, by translating it into java or scala. The inccode.com translator delivers following java code:
public class script extends CRoutineProcess implements IInProcess
{
VarArray arrF1 = new VarArray();
VarArray arrF2 = new VarArray();
VarBox call ()
{
// !/usr/bin/perl -w
if (!(BoxSystem.ProgramArguments.scalar().isGT(1)))
{
BoxSystem.die(BoxString.is(VarString.is("Usage: ").join(BoxSystem.foundArgument.get(0
).toString()).join(" <file1> <file2>\n")
)
);
}
BoxSystem.InputRecordSeparator.empty();
arrF1.setValue(BoxConsole.readLine().split(BoxPattern.is("(?=(?:SERIAL NUMBER:\\s+\\d+))")));
arrF2.setValue(BoxConsole.readLine().split(BoxPattern.is("(?=(?:SERIAL NUMBER:\\s+\\d+))")));
if ((arrF1.length().isNE(arrF2.length())))
{
BoxSystem.die("Error: file1 has $#f1 serials, file2 has $#f2\n");
}
for (
VarBox varG : VarRange.is(0,arrF1.length()))
{
BoxSystem.print((arrF2.get(varG).like(BoxPattern.is("RESULT:\\s+PASS"))) ? arrF2.get(varG) : arrF1.get(varG)
);
}
return STDERR.print("$#f1 serials found\n");
}
}