How to create a waiting ellipsis in a Perl program? - perl

The following code is not working as it seems it should be:
print "Processing your listing";
sleep($n);
print ".";
sleep($n);
print ".";
sleep($n);
print ".\n\n";
Trying to get something where there is a ., then another ., then another ., and then Process complete!

By default Perl buffers your output. To get stuff like this to work you need to disable it.
Use
$| = 1
or, rather better
STDOUT->autoflush
at the start of your program.

I'm actually going to suggest against doing this manually. There are fantastic CPAN modules which provide the feature you actually want, a progress bar. For example there are:
ProgressBar::Stack
Text::ProgressBar::Bar
Term::ProgressBar
Here's the example from ProgressBar::Stack:
use ProgressBar::Stack;
init_progress;
sleep(1);
update_progress 20;
sleep(2);
update_progress 60;
sleep(2);
update_progress 100;
print "\n";
init_progress(message => "Calculating");
my $sum = 0;
for_progress {
$sum+=$_;
sleep(1);
} 0..10;
print "\nSum = $sum\n";

Related

Updating multiple lines of perl output on terminal

I am trying to update the progress of my Perl script on the terminal. The output looks something like this
Progress: ||||||||| [46%]
The progress keeps on getting updated until it reaches 100%. This is being done by printing "\r" after updating the progress. I wish to update multiple lines at the same time, how can it be done? The expectation is something like this
Progress: ||||||||| [46%]
Run-time: 100sec
After some progress(and or time) I wish to update it like this
Progress: |||||||||| [50%]
Run-time: 150sec
I tried printing "\r" two times to go to the previous line. But it didn't work.
I found similar questions (here and here), but they were answered for Python using modules. Mine is a Perl script, and I am not preferring to use external modules.
Term::ANSIScreen provides terminal control using ANSI escape sequences:
use Term::ANSIScreen qw!savepos loadpos!;
print savepos();
for my $i (1..10) {
print '|' x $i, "\n";
print "Step: $i\n";
sleep 1;
print loadpos();
}
or
use Term::ANSIScreen qw!up!;
for my $i (1..10) {
print '|' x $i, "\n";
print "Step: $i\n";
sleep 1;
print up(2);
}
These constants can be used instead of the module:
my $savepos = "\e[s";
my $loadpos = "\e[u";
my $up2 = "\e[2A";
ANSI escape codes

print doesn't work while iterations are going inside foreach loop

I try to find a way to print a progressbar on the commandline while parsing logfiles. Get logfiles=> foreach file => foreach line {do}.
The idea: I want to print a part of the progressbar in every "foreach file" loop. Meaing: print the whole bar if you just parse 1 file. print half of the bar for every file when u parse 2 files and so on. You find the specific code at the bottom.
The problem: The output (print "*") is printed after ALL foreach iteration are done - not in between. Details are in the Code.
Does someone have an idea how to print inside a foreach? Or can tell me the problem? I don't get it :(.
my #logfiles=glob($logpath);
print "<------------------>\n";
$vari=20/(scalar #logfiles);
foreach my $logfile (#logfiles){
open(LOGFILEhandle, $logfile);
#lines = <LOGFILEhandle>;
print "*" x $vari; #won't work, only after loop. Even a "print "*";" doesn't work
foreach my $line (#lines){
#print "*"; works "in between". print "*" x $vari; does not.
if ($line=~/xyz/){
......
......
}
close(LOGFILEhandle);
}
}
I would like to suggest Term::ProgressBar module to avoid reinventing the wheel.
#!/usr/bin/perl
use strict;
use warnings;
use Term::ProgressBar;
my #files = qw (file1 file2 file3 file4);
my $progress = Term::ProgressBar->new(scalar #files);
for (0..#files) {
$| = 1;
sleep(1); #introducing sleep for demo purpose otherwise bar will fill up quickly
#open the file, do some operations and when you are done
#update the bar
$progress->update($_);
}
You are suffering from buffering. The output is buffered until a certain amount is reached or you print a newline. To change this behaviour simply add
$| = 1 ;
at the top of your file. This will turn on autoflush for STDOUT.
There is more than one way to do it and a little bit longer and less cryptic is Borodins suggestion:
STDOUT->autoflush();

Making an IRC bot - how can I let people !eval perl/javascript code?

I'm working on a bot in Perl (based on POE) and so far so good, but I can't figure out how can I add a !js or !perl command to evaluate respective code and return one line of output to be printed into the channel. I found App::EvalServer but I don't get how to use it.
Thanks for any help!
The App::EvalServer module comes with a binary to run as a standalone application. You do not put it in your program but rather run it on it's own. It opens a port where you can hand it code as a json string. This does not sound like a good idea to me either.
There is another module you might want to look at called Safe. I suggest you read through the complete documentation as well as the one to Opcode (linked in the doc) before you do anything with this. YOU CAN DO SERIOUS DAMAGE IF YOU EVALUATE ARBITRARY CODE! Never forget that.
UPDATE:
Here's an example of how to capture the output of print or say from your evaled code. You can use open with a variable to make printed output always go to that variable. If you switch back afterwards you can work with the captured output in your var. This is called an in-memory file.
use strict; use warnings;
use feature 'say';
use Safe;
# Put our STDOUT into a variable
my $printBuffer;
open(my $buffer, '>', \$printBuffer);
# Everything we say and print will go into $printBuffer until we change it back
my $stdout = select($buffer);
# Create a new Safe
my $compartment = new Safe;
$compartment->permit(qw(print)); # for testing
# This is where the external code comes in:
my $external_code = qq~print "Hello World!\n"~;
# Execute the code
my $ret = $compartment->reval($external_code, 1);
# Go back to STDOUT
select($stdout);
printf "The return value of the reval is: %d\n", $ret;
say "The reval's output is:";
say $printBuffer;
# Now you can do whatever you want with your output
$printBuffer =~ s/World/Earth/;
say "After I change it:";
say $printBuffer;
Disclaimer: Use this code at your own risk!
Update 2: After a lengthy discussion in chat, here's what we came up with. It implements a kind of timeout to stop the execution if the reval is taking to long, e.g. because of an infinite loop.
#!/usr/bin/perl
use warnings;
use strict;
use Safe;
use Benchmark qw(:hireswallclock);
my ($t0, $t1); # Benchmark
my $timedOut = 0;
my $userError = 0;
my $printBuffer;
open (my $buffer, '>', \$printBuffer);
my $stdout = select($buffer);
my $cpmt = new Safe;
$cpmt->permit_only(qw(:default :base_io sleep));
eval
{
local $SIG{'ALRM'} = sub { $timedOut = 1; die "alarm\n"};
$t0 = Benchmark->new;
alarm 2;
$cpmt->reval('print "bla\n"; die "In the user-code!";');
# $cpmt->reval('print "bla\n"; sleep 50;');
alarm 0;
$t1 = Benchmark->new;
if ($#)
{
$userError = "The user-code died! $#\n";
}
};
select($stdout);
if ($timedOut)
{
print "Timeout!\n";
my $td = timediff($t1, $t0);
print timestr($td), "\n";
print $printBuffer;
}
else
{
print "There was no timeout...\n";
if ($userError)
{
print "There was an error with your code!\n";
print $userError;
print "But here's your output anyway:\n";
print $printBuffer;
}
else
{
print $printBuffer;
}
}
Take a look at perl eval(), you can pass it variables/strings and it will evaluate it as if it's perl code. Likewise in javascript, there's also an eval() function that performs similarly.
However, DO NOT EVALUATE ARBITRARY CODE in either perl or javascript unless you can run it in a completely closed environment (and even then, it's still a bad idea). Lot's of people spend lots of time preventing just this from happening. So that's how you'd do it, but you don't want to do it, really at all.

Update command line output

My program (which happens to be in Perl, though I don't think this question is Perl-specific) outputs status messages at one point in the program of the form Progress: x/yy where x and yy are a number, like: Progress: 4/38.
I'd like to "overwrite" the previous output when a new status message is printed so I don't fill the screen with status messages. So far, I've tried this:
my $progressString = "Progress\t$counter / " . $total . "\n";
print $progressString;
#do lots of processing, update $counter
my $i = 0;
while ($i < length($progressString)) {
print "\b";
++$i;
}
The backspace character won't print if I include a newline in $progressString. If I leave out the newline, however, the output buffer is never flushed and nothing prints.
What's a good solution for this?
Use autoflush with STDOUT:
local $| = 1; # Or use IO::Handle; STDOUT->autoflush;
print 'Progress: ';
my $progressString;
while ...
{
# remove prev progress
print "\b" x length($progressString) if defined $progressString;
# do lots of processing, update $counter
$progressString = "$counter / $total"; # No more newline
print $progressString; # Will print, because auto-flush is on
# end of processing
}
print "\n"; # Don't forget the trailing newline
Say
$| = 1
somewhere early in your program to turn autoflushing on for the output buffer.
Also consider using "\r" to move the cursor back to the beginning of the line, rather than trying to explicitly count how many spaces you need to move back.
Like you said, don't print out a newline while your progress counter is running or else you will print out your progress on a separate line instead of overwriting the old line.
I know it's not quite what you asked for, but possibly better. I happened on this same problem and so rather than deal with it too much went to using Term::ProgressBar which looks nice too.
You can also use the ANSI escape codes to directly control the cursor. Or you can use Term::ReadKey to do the same thing.
I had to tackle something similar to this today.
If you don't mind reprinting the entire line, you could do something like this:
print "\n";
while (...) {
print "\rProgress: $counter / $total";
# do processing work here
$counter++;
}
print "\n";
The "\r" character is a carriage return-- it brings the cursor back to the beginning of the line. That way, anything you print out overwrites the previous progress notification's text.

Simple Perl Script: Two questions

I have a small program:
#!/user/bin/perl
use strict;
system ("clear");
my($option, $path);
do
{
print "\tEnter the number of your chosen option:\n";
print "\n";
print "\tOption\t\tCommand\n";
print "\t======\t\t=======\n";
print "\t1\t\tDate\n";
print "\t2\t\tDirectory Listing\n";
print "\t3\t\tCalendar\n";
print "\t4\t\tVi Editor\n";
print "\t5\t\tCalculator\n";
print "\t6\t\tExit\n\n";
chomp($option=<STDIN>);
SWITCH:
{
($option =="1") and do
{
system(date);
last;
};
($option =="2") and do
{
print "Enter the path:"; ############################
chomp($path=<STDIN>); #This is giving me an error#
system(ls $path); ############################
last;
};
($option =="3") and do
{
system(cal);
last;
};
($option =="4") and do
{
system(vi);
last;
};
($option =="5") and do
{
system(bc);
last;
};
}
}while ($option!=6);
print "Goodbye!\n";
sleep 2;
First question: Can anyone help me how to write the proper command to create a directory listing in case 2.
Second Question: Why do I get a loop if I use
$date = `date`;
print "$date";
instead of
system(date);
You should be able to solve a lot of your problems by remembering to put quotes around literal arguments to system():
system("date");
system("ls $path");
and the same for most other places you call system() (your first call to system("clear") is correct).
It is a quirk of Perl that calling something like system(cal) works at all, because the unquoted cal is treated as a "bareword" by Perl, which happens to be roughly equivalent to a string when passed to a function such as system(). Relying on this behaviour would be terribly bad practice, and so you should always quote literal strings.
You could read the path like:
chomp($path=<STDIN>);
system("ls $path");
Not sure why you'd get the loop for $date =date;print "$date";. But I don't think there's a date function unless you're using a package for it. You can show a time like:
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
$year += 1900;
$mon += 1;
printf "%04d-%02d-%02d %02d:%02d:%02d",
$year, $mday, $mon,
$hour, $min, $sec;
On most unix systems perl resides in /usr/bin, without the e in user, so you might consider double-checking the first line of your script.
Your immediate problems were caused by quoting issues and the lack of use warnings in your script.
It's also worth noting that menu-driven scripts like yours are ideal candidates for dispatch tables. A dispatch table is a technique for defining actions as data. The actions are Perl subroutines. The data is usually a set of key-value pairs that end up getting stored in a hash.
The keys to the hash are the choices made by the user (menu items 1-6 in your case).
The values in the hash are called code references. There are two ways to set up these code references: (1) Directly in the dispatch table, using anonymous subroutines; or (2) using the &\foo syntax, which would create a reference to a subroutine named foo.
The handy thing about this approach is that your menu() method can be reused -- simply with a different dispatch table and a different usage message.
This example is so small that the benefit of reuse might not seem compelling, but the general technique of having data -- in the form of a dispatch table -- control program behavior is powerful in many contexts.
# Always use both of these.
use strict;
use warnings;
sub dispatch_table {
return
1 => sub { system 'date' },
2 => \&ls_path,
3 => sub { system 'cal' },
4 => sub { system 'vi' },
5 => sub { system 'bc' },
6 => sub { print "Goodbye!\n"; sleep 2 },
;
}
sub ls_path {
print "\nEnter the path: ";
chomp(my $path=<STDIN>);
# Note quoting. To be super robust, you would
# need to escape apostrophes in the path.
system "ls '$path'";
}
sub usage_message {
return "Choose wisely:
Option Command
====== =======
1 Date
2 Directory Listing
3 Calendar
4 Vi Editor
5 Calculator
6 Exit
";
}
sub menu {
system 'clear';
my %dt = dispatch_table();
my $option;
print usage_message();
while (1){
print "> ";
chomp($option = <STDIN>);
last if exists $dt{$option};
}
$dt{$option}->();
}
menu();
I can not reproduce your loop with:
$date =date;print "$date";
I doubt that is exactly how you coded it since I get a compile error
with use strict;. If you can show a reduced code example which still illustrates the problem, we could help debug it further.
If you are trying to capture the output of an external command into a variable, you could use backticks or qx:
my $date = qx(date);
print "$date";
On a side note, whenever I see a series of print statements, I think here-doc:
print <<"EOF";
Enter the number of your chosen option:
Option Command
====== =======
1 Date
2 Directory Listing
etc...
EOF
A little easier to read and maintain, no?
Finally, it is also a good idea to use warnings;.
The first couple of suggests I have are, first like others have already suggested, use warnings is strongly encouraged. Older Perl interpreters may require you use the older form #!/usr/bin/perl -w as the first line of your Perl script. Second, there is a Switch module available, to make the switch statement look less ugly. I've also shown usage of subroutines to clean up the appearance of the program.
I've attached a alternative version of your script with some potential suggestions. Note it uses a slightly different alternative for switch. If available, I'd recommend using the Switch module. It includes a different way of printing the time, and of course fixes your problem with the system calls.
I hope that helps.
#!/usr/bin/perl
use strict;
use warnings; # otherwise /usr/bin/perl -w in first line
sub menu() {
print <<EOM;
Enter the number of your chosen option:
Option Command
====== =======
1 Date
2 Directory Listing
3 Calendar
4 Vi Editor
5 Calculator
6 Exit
EOM
}
sub showtime() {
my $time = localtime;
print $time,"\n";
}
sub listdir() {
my $path;
print "Enter the path: ";
chomp($path = <STDIN>);
system("ls $path");
print "\n";
}
system("clear");
my $option;
do {
menu();
chomp($option = <STDIN>);
# SWITCH:
for ($option) {
/1/ and do {
showtime();
};
/2/ and do {
listdir();
};
/3/ and do {
system("cal");
};
/4/ and do {
system("vi");
};
/5/ and do {
system("bc");
};
last;
}
} while ($option != 6);
print "Goodbye!\n";
sleep 2;