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
}
...
Related
Been away from Perl awhile and would like to modify a script I wrote as an art project long ago. The original script uses Term::ReadKey to allow the user to type arbitrary text into a Mac/Linux terminal. As they type, the text creates various floaty patterns in the terminal. I want to adapt the script so, instead of reading keys as they're input, it can read from text files written periodically by another process. But it would need to read in characters in some controllable way (not all at once) so as to (roughly) emulate human typing.
What I've tried:
Term::ReadKey's man page says it can read from a filehandle instead of STDIN - but for some reason, I could not get this to work, with either a standard file or a FIFO. I also tried reading in text from a file using "open" and putting the characters into an array. But iterating through the array got complicated because of the need to add delays between characters without pausing the rest of the script. ( I can envision this as a potential solution, but I'm not sure how best to design it to allow time delays to be controllable without the script becoming unwieldy.)
Wondering if there's a relatively simple way to approach this - assuming it's feasible at all?
Here's the "meat" of the existing script (have removed various subroutines that add additional effects based on various keypresses.)
#!/usr/bin/perl
use Time::HiRes(usleep);
use Term::ReadKey;
$|=1;
$starttime = time;
$startphrase = ' ';
$startsleepval = 3000;
$phrase = $startphrase;
$sleepval = $startsleepval;
$dosleep = 1;
$SIG{'INT'}=\&quitsub;
$SIG{'QUIT'}=\&quitsub;
# One Ctrl-C clears text and resets program. # Three Ctrl-C's to quit.
sub quitsub {print color 'reset' if ($dosleep); $phrase = $startphrase; $sleepval=$startsleepval; $SIG{'INT'}=\&secondhit;}
sub secondhit { $SIG{'INT'}=\&outtahere; }
sub outtahere {print color 'reset'; sleep 1; print "\n\n\t\t\t\n\n"; exit(0);}
while (1) {
print "$phrase ";
if ($dosleep) {
usleep ($sleepval);
}
ReadMode 3;
##### Here is where it reads from the terminal. Can characters be read from a file in a similar sequential fashion? #####
$key = ReadKey(-1);
$now = time;
if ((defined($key)) and ($now > $starttime + 5)) {
$phrase = $phrase.$key;
$SIG{'INT'}=\&quitsub;
}
# user can also create interesting effects with spacebar, tab and arrow keys.
ReadMode 0; # this may appear redundant, but has a subtle visual effect. At least that's what I commented in the original 2003 script.
}
# end main loop
The problem here is that your script can try to read from the file all you want, but if the process that actually writes to the file flushes all at once, you're going to get everything together.
Also, a few things:
if you really want to use ReadKey, you should probably use ReadMode 5 if you don't know the CR or CR/LF use of your file.
also check Term::ReadKey and you'll see that you probably want something like ReadKey 0, $file
it's probably best if you drop Term::ReadKey completely and use File::Tail instead, looping over the added characters one at a time
Your final code is most likely going to be something that goes through an array of characters, just as you've already tried to do.
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-
I am using Cygwin Perl on Windows XP.
I have this code that will run a third party program.
sub main {
print("Start Running\n");
#return = run_exe($execApp, $parm1, $parm2);
my $returncode = pop #return;
if ($returncode == 0) {
print("Success\n");
}
else {
print("Error\n");
}
}
sub run_exe {
my ($exe, #parm) = #_;
my (#output, #return_output);
#output = system($exe, #parm);
foreach (#output) {
next if !/\S/; # white space line
s/^(\s*)//g; # trim from the front for $_
s/(\s*)$//g; # trim from the end for $_
push (#return_output, $_);
}
push (#return_output, $?>>8);
#output = ();
return (#return_output);
}
This would print if Success:
Start Running
Return Code: 0
Success
What I want is not to print the output from running run_exe subroutine (i.e Return Code: 0):
Start Running
Success
How could I achieve this? Please help me, I have search in Google but I found nothing.
You have used system in your program, which lets the program you are running print to STDOUT and returns the exit status of the program (a number).
So what you have at present makes no sense, as #output will contain just a single number and you cannot parse it as output from the program you are running.
What you probably need is backticks
`$exe #parm`
or, more clearly,
qx{$exe #parm}
which will return the output from the program, as you seem to be expecting, and avoid it being printed to STDOUT.
Note that you may need to pay attention to the contents of $exe and #parm, as the resulting string must be valid at the command line, and the fields may need quoting or escaping appropriately.
Update
Looking again at your code again it seems that you may be expecting the exit status from system. But putting it an array, looping over the array, and extracting non-blank elements is very convoluted! The result is the same value as $? that you add to the returned array.
To divert the output of a program you need to run it from the command shell instead of directly, so to send the output to the Windows nul device your code would look like
system('cmd /C', $exe, #parm, '>nul');
return $? >> 8;
In fact you may as well drop the subroutine and change the lines
#return = run_exe($execApp,$parm1,$parm2);
my $returncode = pop #return;
to
system('cmd /C', $execApp, $parm1, $parm2, '>nul');
my $returncode = $? >> 8;
I just ran into the same issue today and remembered I'd found the solution many, many brain cells ago (about 4 year's worth of brain cells ago). After spending a good while searching my old code, I found the solution. Here it is. Simply put your system call inside back-ticks, and append "2>&1". Here's an example.
my $results=nslookup -type=ns stackoverflow.com 2>&1;
The results of your system call are assigned to $results, and not printed. I can't remember exactly why or how that is, but it is.
This is important to me because quite often I'm running a script in my PERL editor, and if I allow a lot of printing (i.e., if the above command is repeated thousands of times) it will use a lot of system memory, and eventually all the system memory.
I know this is an old topic, but hopefully it well be of value to the next poor, unfortunate soul maniacally googling for a solution to the problem, as I was tonight.
I have a Perl script which reads three files and writes new files after reading each one of them. Everything is one thread.
In this script, I open and work with three text files and store the contents in a hash. The files are large (close to 3 MB).
I am using a loop to go through each of the files (open -> read -> Do some action (hash table) -> close)
I am noticing that the whenever I am scanning through the first file, the Perl terminal window in my Cygwin shell gets stuck. The moment I hit the enter key I can see the script process the rest of the files without any issues.
It's very odd as there is no read from STDIN in my script. Moreover, the same logic applies to all the three files as everything is in the same loop.
Has anyone here faced a similar issue? Does this usually happen when dealing with large files or big hashes?
I can't post the script here, but there is not much in it to post anyway.
Could this just be a problem in my Cygwin shell?
If this problem does not go away, how can I circumvent it? Like providing the enter input when the script is in progress? More importantly, how can I debug such a problem?
sub read_set
{
#lines_in_set = ();
push #lines_in_set , $_[0];
while (<INPUT_FILE>)
{ $line = $_;
chomp($line);
if ($line=~ /ENDNEWTYPE/i or $line =~ /ENDSYNTYPE/ or eof())
{
push #lines_in_set , $line;
last;
}
else
{
push #lines_in_set , $line;
}
}
return #lines_in_set;
}
--------> I think i found the problem :- or eof() call was ensuring that the script would be stuck !! Somehow happening only at the first time. I have no idea why though
The eof() call is the problem. See perldoc -f eof.
eof with empty parentheses refers to the pseudo file accessed via while (<>), which consists of either all the files named in #ARGV, or to STDIN if there are none.
And in particular:
Note that this function actually reads a character and then "ungetc"s it, so isn't useful in an interactive context.
But your loop reads from another handle, one called INPUT_FILE.
It would make more sense to call eof(INPUT_FILE). But even that probably isn't necessary; your outer loop will terminate when it reaches the end of INPUT_FILE.
Some more suggestions, not related to the symptoms you're seeing:
Add
use strict;
use warnings;
near the top of your script, and correct any error messages this produces (perl -cw script-name does a compile-only check). You'll need to declare your variables using my (perldoc -f my). And use consistent indentation; I recommend the same style you'll find in most Perl documentation.
The following snippet of code is used to find the PID of a user's terminal, by using ptree and grabbing the third PID from the results it returns. All terminal PID's are stored in a hash with the user's login as the key.
## If process is a TEMINAL.
## The command ptree is used to get the terminal's process ID.
## The user can then use this ID to peek the user's terminal.
if ($PID =~ /(\w+)\s+(\d+) .+basic/) {
$user = $1;
if (open(PTREE, "ptree $2 |")) {
while ($PTREE = <PTREE>) {
if ($PTREE =~ /(\d+)\s+-pksh-ksh/) {
$terminals{$user} = $terminals{$user} . " $1";
last;
}
next;
}
close(PTREE);
}
next;
}
Below is a sample ptree execution:
ares./home_atenas/lmcgra> ptree 29064
485 /usr/lib/inet/inetd start
23054 /usr/sbin/in.telnetd
23131 -pksh-ksh
26107 -ksh
29058 -ksh
29064 /usr/ob/bin/basic s=61440 pgm=/usr/local/etc/logon -q -nr trans
412 sybsrvr
I'd like to know if there is a better way to code this. This is the part of the script that takes longest to run.
Note: this code, along with other snippets, are inside a loop and are executed a couple of times.
I think the main problem is that this code is in a loop. You don't need to run ptree and parse the results more than once! You need to figure out a way to run ptree once and put it into a data structure that you can use later. Probably be some kind of simple hash will suffice. You may even be able to just keep around your %terminals hash and keep reusing it.
Some nitpicks...
Both of your "next" statements seem
unnecessary to me... you should be
able to just remove them.
Replace
$terminals{$user} = $terminals{$user} . " $1";
with:
$terminals{$user} .= " $1";
Replace the bareword PTREE which you
are using as a filehandle with
$ptreeF or some such... using
barewords became unnecessary for
filehandles about 10 years ago :)
I don't know why your $PID variable
is all caps... it could be confusing
to readers of your code because it
looks like there is something
special about that variable, and
there isn't.
I think you'll get the best performance improvement by avoiding the overhead of repeatedly executing an external command (ptree, in this case). I'd look for a CPAN module that provides a direct interface to the data structures that ptree is reading. Check the Linux:: namespace, maybe? (I'm not sure if ptree is setuid; that may complicate things.)
The above advice aside, some additional style and robustness notes based on the posted snippet only (forgive me if the larger code invalidates them):
I'd start by using strict, at the very least. Lexical filehandles would also be a good idea.
You appear to be silently ignoring the case when you cannot open() the ptree command. That could happen for many reasons, some of which I can't imagine you wanting to ignore, such as…
You're not using the full path to the ptree command, but rather assuming it's in your path—and that the one in your path is the right one.
How many users are on the system? Can you invert this? List all -pksh-ksh processes in the system along with their EUIDs, and build the map from that - that might be only one execution of ps/ptree.
I was thinking of using ps to get the parents pid, but I would need to loop this to get the great-grandparent's pid. That's the one I need. Thanks. – lamcro
Sorry, there are many users and each can have up to three terminals open. The whole script is used to find those terminals that are using a file. I use fuser to find the processes that use a file. Then use ptree to find the terminal's pid. – lamcro
If you have (or can get) a list of PIDs using a file, and just need all of the grand-parents of that PID, there's an easier way, for sure.
#!perl
use warnings;
use strict;
#***** these PIDs are gotten with fuser or some other method *****
my($fpids) = [27538, 31812, 27541];
#***** get all processes, assuming linux PS *****
my($cmd) = "ps -ef";
open(PS, "$cmd |") || die qq([ERROR] Cannot open pipe from "$cmd" - $!\n);
my($processlist) = {};
while (<PS>) {
chomp;
my($user, $pid, $ppid, $rest) = split(/ +/, $_, 4);
$processlist->{$pid} = $ppid;
}
close PS;
#***** lookup grandparent *****
foreach my $fpid (#$fpids) {
my($parent) = $processlist->{$fpid} || 0;
my($grandparent) = $processlist->{$parent} || 0;
if ($grandparent) {
#----- do something here with grandparent's pid -----
print "PID:GRANDPID - $fpid:$grandparent\n";
}
else {
#----- some error condition -----
print "ERROR - Cannot determine GrandPID: $fpid ($parent)\n";
}
}
Which for me produces:
ERROR - Cannot determine GrandPID: 27538 (1)
PID:GRANDPID - 31812:2804
PID:GRANDPID - 27541:27538
Have you considered using 'who -u' to tell you which process is the login shell for a given tty instead of using ptree? This would simplify your search - irrespective of the other changes you should also make.
I just did some trivial timings here based on your script (calling "cat ptree.txt" instead of ptree itself) and confirmed my thoughts that all of your time is spent creating new sub-processes and running ptree itself. Unless you can factor away the need to call ptree (maybe there's a way to open up the connection once and reuse it, like with nslookup), you won't see any real gains.