How to remove an error regarding increment of a while loop - perl

I am using the following Perl script to write out a shell script:
#!/usr/bin/perl -w
$incr=0.1;
$dist=5.1;
my $filename = 'job-1.sh';
open (my $BATCHFILE, '>', "$filename");
while ($dist <= 15) {
print $BATCHFILE
"
YOYO -O -i min_mdin.$dist
";
$dist += $incr;
}
close ($BATCHFILE);
The job-1.sh file should contain the following lines:
YOYO -O -i min_mdin.5.1
YOYO -O -i min_mdin.5.2
……
YOYO -O -i min_mdin.15
However, some files are printed as follows:
YOYO -O -i min_mdin.6.49999999999999
YOYO -O -i min_mdin.6.59999999999999
This problem occurs only when the increment is 0.1. An increment of 0.2 or 0.25 do not give this error.

Here's what's happening:
https://floating-point-gui.de
As a quick fix try something like this:
#!/usr/bin/perl -w
$incr=1;
$dist=51;
while ($dist <= 150)
{
print $dist/10 . "\n";
$dist += $incr;
}
Or this:
#!/usr/bin/perl -w
$incr = 0.1;
$dist = 5.1;
while ($dist <= 15)
{
print sprintf("%.2f",$dist) . "\n";
$dist = $dist + $incr;
}

Related

Perl: is there a way to programmaticly set file test operators? (i.e. -X)

I often do complex file/directory/symlink tests, and am writing a subroutine to do so.
for example, instead of
if (-x $file)
write
my $test = '-x';
if ($x $file)
and I can vary $x to be -f -r -e or whatever.
I have read the file testing documentation thoroughly, https://perldoc.perl.org/functions/-X
and there doesn't appear to be any trick so that this can be done.
I've read File::Find https://perldoc.perl.org/File::Find but I don't want to write a separate subroutine every time I do a search, which would make the code very ugly and long.
Is there anything or any trick that I've missed?
Here is another approach using a dispatch table:
my $file = 'test.txt';
my %ftest = (
'-x' => sub {-x $_[0]},
'-f' => sub {-f $_[0]}
);
my $test = '-x';
if ($ftest{$test}->($file)) {
say "Executable";
}
else {
say "Not executable";
}
You could use eval:
#!/usr/bin/perl
use strict;
use warnings;
my #tests=qw(r w x o R W X O e z s f d l p S b c t u g k T B M A C);
for my $file (#ARGV) {
for my $test (#tests) {
print "-$test $file ";
my $rv = eval "-${test} \$file";
$rv = 'undef' unless defined $rv;
print "$rv\n";
}
}
Running this script on itself may give this output:
$ ./perltest.pl perltest.pl
-r perltest.pl 1
-w perltest.pl 1
-x perltest.pl 1
-o perltest.pl 1
-R perltest.pl 1
-W perltest.pl 1
-X perltest.pl 1
-O perltest.pl 1
-e perltest.pl 1
-z perltest.pl
-s perltest.pl 316
-f perltest.pl 1
-d perltest.pl
-l perltest.pl
-p perltest.pl
-S perltest.pl
-b perltest.pl
-c perltest.pl
-t perltest.pl undef
-u perltest.pl
-g perltest.pl
-k perltest.pl
-T perltest.pl 1
-B perltest.pl
-M perltest.pl 1.15740740740741e-05
-A perltest.pl 0
-C perltest.pl 1.15740740740741e-05
[ This is an improvement on Ted Lyngmo's solution and Håkon Hægland's solution. ]
You can use eval EXPR to generate code to perform the tests.
Of note, one can take care to avoid perform an expensive stat call for every test.
#!/usr/bin/perl
use strict;
use warnings;
use feature qw( say );
my #tests = split '', 'rwxoRWXOezsfdpSbctugkTBMACl';
my ($qfn) = #ARGV;
or die("Usage\n");
stat($qfn)
or die("Can't stat \"$qfn\": $!\n");
for my $test (#tests) {
my $rv = eval("-$test " . ( $test eq 'l' ? '$qfn' : '_' ));
say " -$test: ", $rv // "[undef]" || 0;
}
If multiple files need to be processed, the number of calls to the expensive eval can be reduced by using it to create a sub.
#!/usr/bin/perl
use strict;
use warnings;
use feature qw( say );
my #tests = split '', 'rwxoRWXOezsfdpSbctugkTBMACl';
my %tests =
map { $_ => eval("sub { -$_ shift }") }
#tests;
for my $qfn (#ARGV) {
stat($qfn)
or warn("Can't stat \"$qfn\": $!\n"), next;
say "$qfn:";
for my $test (#tests) {
my $rv = $tests{$test}->( $test eq 'l' ? $qfn : *_ );
say " -$test: ", $rv // "[undef]" || 0;
}
}

Can't print the inital number in perl

My Perl code is not executed from the initial number.
#!/usr/bin/perl -w
print "SrepAring inpCKut filYes\n";
$incr=0.25;
$dist=3.0;
$inti=3.0;
my $filename = 'job-1.sh';
open (my $BATCHFILE, '>', "$filename");
while ($dist < 15) {
$dist += $incr;
$inti = $dist - 0.25;
print $BATCHFILE
"
YOYO -O -i min_mdin.$dist -o min_mdout.$dist -p TATA -c prod.rst.$inti -r min.rst.$dist
"
}
close ($BATCHFILE);
YOYO -O -i min_mdin.3 -o min_mdout.3 -p TATA -c prod.rst.2.75 -r min.rst.3
YOYO -O -i min_mdin.3.25 -o min_mdout.3.25 -p TATA -c prod.rst.3 -r min.rst.3.25
YOYO -O -i min_mdin.3.5 -o min_mdout.3.5 -p TATA -c prod.rst.3.25 -r min.rst.3.5
If you want to print the value before it changes, put the print before the assignment.
while ($dist < 15) {
print $BATCHFILE "\nYOYO -O -i min_mdin.$dist -o min_mdout.$dist -p TATA -c prod.rst.$inti -r min.rst.$dist\n";
$dist += $incr;
$inti = $dist - 0.25;
}

cannot get the folder last modified time

I want to get the folder last modified date and time through perl. My code is:
my #dirs = grep { -d } glob "$SOME_DIR/*";
foreach my $dir (#dirs)
{
print($dir);
print((stat $dir)[9]); #line got problem with
}
But it just printed nothing but the sub foders under $SOME_DIR. I am SURE the $SOME_DIR path exists since the print($dir) works. Would anyone know what cant get the last modified time of a directory? Thanks!
For me, with $SOME_DIR = ".";, I got the output:
./c-vs-c++1369283477./computist-1.dSYM1381934424./computist-2.dSYM1381934897./ll3.dSYM1381816690./syncio.dSYM1381984813./xs.dSYM1381986208
This mildy revised code:
#!/usr/bin/env perl
use strict;
use warnings;
my $SOME_DIR = ".";
my #dirs = grep { -d } glob "$SOME_DIR/*";
foreach my $dir (#dirs)
{
printf "%-20s - %d\n", $dir, (stat $dir)[9];
}
gave the output:
./c-vs-c++ - 1369283477
./computist-1.dSYM - 1381934424
./computist-2.dSYM - 1381934897
./ll3.dSYM - 1381816690
./syncio.dSYM - 1381984813
./xs.dSYM - 1381986208
You need to demonstrate what is in your $SOME_DIR. For example, you might use:
system "ls -l $SOME_DIR";
to show what you should be seeing.
try this:-
#!/usr/bin/perl
#1=`ls -ltr abcdpathtodir | grep ^d | awk '{\$1=\$2=\$3=\$4=\$5=""; print \$0}'`;
foreach $i (#1)
{
print " ---$i\n";
}
or other way:-
#m=`ls -ltr dir | grep ^d | awk '{print \$6,\$7,\$8,\$9}'`;
foreach $i (#m)
{
print "$i\n";
}

How to get response from "ping -c 1 example.com"?

In BASH can I ping a server like so
for i in $MY_SERVER_LIST; do
if ping -c 1 $i > /dev/null 2>&1; then
# $i is alive
fi
done
and I would like to do the same in Perl, but how do I get the response from
my $response = `ping -c 1 google.com > /dev/null 2>&1`
Question
How do I do the same in Perl, but without using any packages like Net::Ping?
You are interested in the exitcode of ping not the output; forget about the $response and examine the exitcode in $?.
I'd use Net::Ping !
use Net::Ping;
$p = Net::Ping->new();
print "$host is alive.\n" if $p->ping($host);
$p->close();
$p = Net::Ping->new("icmp");
$p->bind($my_addr); # Specify source interface of pings
foreach $host (#host_array)
{
print "$host is ";
print "NOT " unless $p->ping($host, 2);
print "reachable.\n";
sleep(1);
}
$p->close();
http://perldoc.perl.org/Net/Ping.html

How to write a Perl script to convert file to all upper case?

How can I write a Perl script to convert a text file to all upper case letters?
perl -ne "print uc" < input.txt
The -n wraps your command line script (which is supplied by -e) in a while loop. A uc returns the ALL-UPPERCASE version of the default variable $_, and what print does, well, you know it yourself. ;-)
The -p is just like -n, but it does a print in addition. Again, acting on the default variable $_.
To store that in a script file:
#!perl -n
print uc;
Call it like this:
perl uc.pl < in.txt > out.txt
$ perl -pe '$_= uc($_)' input.txt > output.txt
perl -pe '$_ = uc($_)' input.txt > output.txt
But then you don't even need Perl if you're using Linux (or *nix). Some other ways are:
awk:
awk '{ print toupper($0) }' input.txt >output.txt
tr:
tr '[:lower:]' '[:upper:]' < input.txt > output.txt
$ perl -Tpe " $_ = uc; " --
$ perl -MO=Deparse -Tpe " $_ = uc; " -- a s d f
LINE: while (defined($_ = <ARGV>)) {
$_ = uc $_;
}
continue {
die "-p destination: $!\n" unless print $_;
}
-e syntax OK
$ cat myprogram.pl
#!/usr/bin/perl -T --
LINE: while (defined($_ = <ARGV>)) {
$_ = uc $_;
}
continue {
die "-p destination: $!\n" unless print $_;
}