#!/usr/bin/env perl
use warnings;
use 5.014;
use Term::Cap;
use POSIX;
my $termios = new POSIX::Termios;
$termios->getattr;
my $ospeed = $termios->getospeed;
my $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
$terminal->Trequire("ku"); # move cursor up
my $UP = $terminal->Tputs("ku");
my $t = 500;
while ($t > 0) {
printf "Hour: %d \n", $t/3600;
printf "Minute: %d \n", ($t/60)%60;
printf "Second: %d \n", $t%60;
print $UP,$UP,$UP;
sleep 5;
$t -= 5;
}
When I try this (found here: How can I update values on the screen without clearing it in Perl?) I get this output:
Hour: 0
Minute: 8
Second: 20
AAAHour: 0
Minute: 8
Second: 15
AAAHour: 0
Minute: 8
Second: 10
AAAHour: 0
Minute: 8
Second: 5
Does this mean, that key-up doesn't work with my terminal?
You've misunderstood the ku capability. That's the character sequence generated when the user presses the up arrow key on the terminal. To actually move the cursor up on the screen, you print the up capability. (Also, it's best to avoid the indirect object syntax, although that had nothing to do with your problem.)
Here's a corrected version:
#!/usr/bin/env perl
use warnings;
use 5.014;
use Term::Cap;
use POSIX;
my $termios = POSIX::Termios->new;
$termios->getattr;
my $ospeed = $termios->getospeed;
my $terminal = Term::Cap->Tgetent({ TERM => undef, OSPEED => $ospeed });
$terminal->Trequire("up"); # move cursor up
my $UP = $terminal->Tputs("up");
my $t = 500;
while ($t > 0) {
printf "Hour: %d \n", $t/3600;
printf "Minute: %d \n", ($t/60)%60;
printf "Second: %d \n", $t%60;
print $UP,$UP,$UP;
sleep 5;
$t -= 5;
}
You may find the Termcap manual helpful. It explains what all the capabilities mean.
Related
trying to run the following code:
$combs = combinations(\#set,$k);
while (my $c = $combs->next)
{
$nrc=1;
}
Gives me "out of memory!" when I hit Ctrl+C (because its taking too long and it should not) if I pass a set from, for example, (0..450) and numbers to combine ($k) of 6. This issue does not occur with, lets say, a set of 0..45 and $k=6.
Note that the while loop seems to do nothing, in the original script it printed out the combination and incremented a counter that will hold the total number of combinations. But since I was not sure what the problem was, I decided to eliminate that.
I've read the Algorithm:Combinatorics on CPAN and it states that memory usage is minimal, so I don't know what's happening.
I am using Strawberry Perl 32bit on a Windows 10 machine.
Thanks.
--------------------- COMPLETE CODE
#!/usr/bin/perl
use List::MoreUtils "uniq";
use Algorithm::Combinatorics "combinations";
my $argc = $#ARGV+1;
my #set;
if ($argc == 0)
{
print STDERR "Valor minimo de rango: "; # range min
my $minrange = int <STDIN>;
print STDERR "Valor maximo de rango: "; #range max
my $maxrange = int <STDIN>;
#set = uniq sort { $a <=> $b }($minrange...$maxrange);
}
elsif ($argc == 1)
{
open(SETFROMFILE,"<$ARGV[0]") or die "No se puedo abrir el fichero, $!";
chomp(#set = <SETFROMFILE>);
close(SETFROMFILE);
#set = uniq sort { $a <=> $b } #set;
}
else
{
print STDERR "Uso: $0 [file]\n";
exit;
}
my $nrc = 0;
print STDERR "\n";
print STDERR "Numeros a combinar: "; # get subset
my $k = <STDIN>;
if ($k == 0) { exit; }
$combs = combinations(\#set,$k);
print STDERR "\n";
while (my $c = $combs->next)
{
print join(";",#$c) . "\n";
$nrc++;
}
print STDERR "\n";
print STDERR "numero total de combinaciones: $nrc\n";
It works for me.
use strict;
use warnings;
use Algorithm::Combinatorics qw( combinations );
sub show_mem { system('ps', '--no-heading', '-o', 'rss', $$); }
my #set = (0..450);
my $k = 6;
my $count = 0;
#show_mem();
my $combs = combinations(\#set, $k);
#show_mem();
while (my $c = $combs->next) {
++$count;
if (($count % 100_000) == 0) {
print("$count\n");
#show_mem();
}
}
Output:
784
784
100000
776
200000
784
300000
788
400000
776
500000
780
600000
784
700000
768
800000
784
900000
784
1000000
776
...
Of course, it will take forever to go through all C(451, 6) = 11,303,769,578,640 combinations! (We're talking about 251 days on my machine[1].)
(Note that 11,303,769,578,640 is too large for a 32-bit integer. Fortunately, Perl will switching to using a double-precision floating-point number, and those are large enough to hold that all numbers up to and including that one.)
By the way, if you just need the number of combinations, you can use
my $count = 1; $count *= ( #set - $_ + 1 ) / $_ for 1..$k;
How I timed it:
use Algorithm::Combinatorics qw( combinations );
use Time::HiRes qw( time );
my #set = (0..450);
my $k = 6;
my $count = 0;
my $combs = combinations(\#set, $k);
my $s = time;
while (my $c = $combs->next) {
++$count;
last if $count == 1_000_000;
}
my $e = time;
print($e-$s, "\n");
There are 11.1 trillion combinations of six items out of 450. I'm not surprised it ran out of memory!
I have a date in the future, from which I have to subtract 3 months at a time until the current date is reached.
The reached date after subtracting the months must be closest to the current date, but has to be in the future.
The day of the month is always the 23rd
i.e.:
future date = 2015/01/23
current date = 2014/06/05
result = 2014/07/23
I'm running Solaris, so don't have access to GNU date.
I tried to do this in Perl, but unfortunately I can only use the Time::Local module:
#!/bin/ksh
m_date="2019/05/23"
m_year=$(echo $m_date|cut -d/ -f1)
m_month=$(echo $m_date|cut -d/ -f2)
m_day=$(echo $m_date|cut -d/ -f3)
export m_year m_month m_day
perl -MTime::Local -le '
$time = timelocal(localtime);
$i = 3;
while (timelocal(0, 0, 0, $ENV{'m_day'}, $ENV{'m_month'} - $i, $ENV{'m_year'}) > $time) {
print scalar(localtime(timelocal(0, 0, 0, $ENV{'m_day'}, $ENV{'m_month'} - $i, $ENV{'m_year'})));
$i += 3;
}
'
This only works for months within one year. Is there any other way I can do this?
It is simple enough to just split the date strings and do the arithmetic on the fields.
use strict;
use warnings;
use 5.010;
my $future = '2015/01/23';
my $current = do {
my #current = localtime;
$current[3] += 1;
$current[5] += 1900;
sprintf '%04d/%02d/%02d', #current[5,4,3];
};
my $result;
for (my $test = $future; $test gt $current; ) {
$result = $test;
my #test = split /\//, $test;
if (($test[1] -= 3) < 1) {
--$test[0];
$test[1] += 12;
}
$test = sprintf '%04d/%02d/%02d', #test;
}
say $result;
output
2014/07/23
Alternatively you could just do the division to calculate how many whole quarters to subtract, like this
use strict;
use warnings;
use 5.010;
my $future = '2015/01/23';
my #current = (localtime)[5,4,3];
$current[1] += 1;
$current[0] += 1900;
my #future = split /\//, $future;
my $months = ($future[0] - $current[0]) * 12 + $future[1] - $current[1];
$months -= 1 if $current[2] >= 23;
my #result = #current;
$result[2] = 23;
$result[1] += $months % 3;
$result[0] += int(($result[1] - 1) / 12);
$result[1] = ($result[1] - 1) % 12 + 1;
my $result = sprintf '%04d/%02d/%02d', #result;
say $result;
The output is identical to that of the previous code
This is your script changed so it should work across multiple years,
perl -MTime::Local -le'
sub nextm {
$ENV{m_year}--, $ENV{m_month} +=12 if ($ENV{m_month} -= 3) <1;
timelocal(0, 0, 0, $ENV{m_day}, $ENV{m_month}, $ENV{m_year});
}
my $time = timelocal(localtime);
while ((my $c=nextm()) > $time) {
print scalar localtime($c);
}
'
Try something like:
#!/usr/bin/perl -w
# just convert the real date that you have to epoch
my $torig = 1558569600;
my $tnow = time;
# 3 months in seconds to use the epoch everywhere
my $estep = 3 * 30 * 24 * 3600;
while(($torig - $estep) > $tnow){
$torig -= $estep;
}
print $torig,"\n";
print scalar localtime($torig),"\n";
The only problem here is that a months is an approximation, if you need the very same day but minus 3 months, you could use DateCalc
I ended up scripting it all in KSH instead of perl, thanks to Borodin's logic.
#!/bin/ksh
set -A c_date $(date '+%Y %m %d')
IFS=/ d="2019/05/23"
set -A m_date $d
[[ ${c_date[2]} -gt ${m_date[2]} ]] && ((c_date[1]+=1))
c_date[2]=${m_date[2]}
c_date[1]=$(( (((${m_date[0]} - ${c_date[0]}) * 12) + (${m_date[1]} - ${c_date[1]})) % 3 + ${c_date[1]} ))
if [[ ${c_date[1]} -gt 12 ]] ; then
((c_date[0]+=1))
((c_date[1]-=12))
fi
echo ${c_date[#]}
I was wondering if there is a simple way in Perl to ensure that a date string corresponds to a valid date.
For example, 2012 02 30 is incorrect because it doesn't exist.
The DateTime module will validate dates when creating a new object.
$ perl -we 'use DateTime; my $dt;
eval { $dt = DateTime->new(
year => 2012,
month => 2,
day => 30);
}; print "Error: $#" if $#;'
Error: Invalid day of month (day = 30 - month = 2 - year = 2012) at -e line 1
It also works dynamically on a given DateTime object:
$dt->set(day => 30);
Something like this using Class::Date should work
perl testit.pl
Range check on date or time failed
use Class::Date;
my $d=Class::Date->new('2021-02-30');
unless ( $d->error ) {
print "good date\n";
} else {
print $d->errstr(). "\n";
}
exit;
Check here:
http://www.perlmonks.org/?node_id=564594
I believe you'll get the answers you seek from the wise monks.
You can do this through the use of POSIX mktime, but apparently only if you have a flexible-enough implementation of mktime.
What I do is plug the numbers in and then use local time to get them back and if I get the same day value back, it's a valid number. So, given your string:
my ( $y, $m, $d ) = split ' ', $date_string;
die "$date_string is not a valid date!"
unless ( $d == ( localtime mktime( 0, 0, 0, $d, $m - 1, $y - 1900 ))[3] )
;
See, in the versions of mktime that I'm used to, mktime( 0, 0, 0, 30, 1, 112 ) would make '2012-03-01' and 30 != 1
You can also use Time::Local:
#!/usr/bin/env perl
use strict; use warnings;
use Carp qw( croak );
use Time::Local qw( timegm );
my #to_check = ('1927 06 18', '2012 02 30');
for my $date ( #to_check ) {
printf "'%s' is %s\n", $date, check_date($date) ? 'valid' : 'invalid';
}
sub check_date {
my ($date) = #_;
my ($year, $month, $mday) = split ' ', $date;
my $ret;
eval {
$ret = timegm(0, 0, 0, $mday, $month - 1, $year - 1900);
};
return $ret && $ret;
}
May be this will help too:
use Time::Piece; #in perl CORE distro since 5.10
use 5.010;
say Time::Piece->strptime("2011-02-29","%Y-%m-%d")->strftime("%Y-%m-%d");
#2011-03-01
say Time::Piece->strptime("2012-02-29","%Y-%m-%d")->strftime("%Y-%m-%d");
#2012-02-29
In Bash, seq 5 5 20 produces 5 10 15 20.
In Perl, 1..5 produces 1 2 3 4 5; does it support step?
How do I produce a range with step in Perl?
perldoc -f map is one way:
use warnings;
use strict;
use Data::Dumper;
my #ns = map { 5 * $_ } 1 .. 4;
print Dumper(\#ns);
__END__
$VAR1 = [
5,
10,
15,
20
];
See also: perldoc perlop
The range operator in Perl doesn't support steps. You could use a for loop instead:
for (my $i = 5; $i <= 20; $i += 5) {
print "$i\n";
}
The List::Gen range function does this:
use strict;
use warnings;
use feature 'say';
use List::Gen;
my $range = range 5, 20, 5;
say for #$range; # 5
# 10
# 15
# 20
say while <$range>; # TIMT1WTDI
$range->say; # TAMT2WTDI, v.0.974
say $range->str; # TAMT3WTDI, v.0.974
my $by_fives = <5 .. 20 by 5>;
say while <$by_fives>; #TAMT4WTDI
<5 .. * by 5>->say( 4 ); #TAMT5WTDI
Not as good as toolic's answer:
use warnings;
use strict;
my #ns;
for my $n (1..4) {
push(#ns, $n*5);
}
I wrote Acme::Range::Module a while back as a gag module - hence the Acme:: namespace - but it does do what you want and has tests and is supported. Here's the example code:
use Acme::Globule qw( Range );
foreach (<10..1>) {
print "$_... ";
}
print "Lift-off!\n";
# put down that crack pipe...
sub my_keys(\%) {
my #hash = %{ $_[0] };
return #hash[ glob("0,2..$#hash") ];
}
sub my_values(\%) {
my #hash = %{ $_[0] };
return #hash[ glob("1,3..$#hash") ];
}
Here is an easy solution that utilizes map and the built-in range operator:
sub range {
my ($start, $end, $step) = #_;
$step ||= 1;
return map { $_ * $step } ($start / $step .. $end / $step);
}
Notice the key point here is the map {} block. We simply divide the end
by the given step (works for negative and positive) then map each value
to the multiple of the given step.
Like the map solution :)
Here it is used to look for files starting with even numbers in a range 116 to 648:
perl -e 'foreach (map { 2 * $_ } (116/2) .. (648/2)) { system("ls -l $_*"); } '
Perl is just wonderful for some jobs and making funny one-liners :)
I was trying to determine a good way to calculate a previous date based on how many weeks I would want to go back. Today is 7/19/2011, so if I wanted to go back 5 weeks what would be the best way to determine what that date would be?
DateTime::Duration is your friend there:
use strict;
use warnings;
use 5.010;
use DateTime;
my $now = DateTime->now(time_zone => 'local');
my $five_weeks = DateTime::Duration->new(weeks => 5);
my $five_weeks_ago = $now - $five_weeks;
say "Five weeks ago now it was $five_weeks_ago";
Notice that it lets you specify the duration in the units of the problem.
Perl has this marvelous thing called regexes that can solve almost any problem.
use strict;
use warnings;
my $date = shift || '7/19/2011';
my $days_ago = shift || 7*5;
$date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)\z##{[sprintf"%.2d",$1]}/#{[sprintf"%.2d",$2]}/$3/$days_ago#;
until ( $date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)/0\z##{[$1+0]}/#{[$2+0]}/$3# ) {
$date =~ s#([0-9]+)/([0-9]+)/([0-9]+)/([0-9]+)##{[$2==1?sprintf"%.2d",$1-1||12:$1]}/#{[sprintf"%.2d",$2-1||31]}/#{[$1==1 && $2==1?$3-1:$3]}/#{[$4-1]}#;
$date =~ s#([0-9]+)\z##{[$1+1]}# unless $date =~ m#^(?:0[1-9]|1[012])/(?:0[1-9]|1[0-9]|2[0-8]|(?<!0[2469]/|11/)31|(?<!02/)30|(?<!02/(?=...(?:..(?:[02468][1235679]|[13579][01345789])|(?:[02468][1235679]|[13579][01345789])00)))29)/#;
}
print $date, "\n";
(Please don't do it this way.)
I like Date::Calc
use strict;
use warnings;
use Date::Calc qw/Add_Delta_Days Today/;
my $offset_weeks = -5;
my $offset_days = $offset_weeks * 7;
# Year, Month, Day
my #delta_date = Add_Delta_Days(
Today( [ localtime ] ),
$offset_days
);
printf "%2d/%2d/%4d\n", #delta_date[1,2,0];
It is designed to catch common gotchas such as leap year.
Best or easiest? I have always found strftime's date normalization to be handy for this sort of thing:
#!/usr/bin/perl
use strict;
use warnings;
use POSIX qw/strftime/;
my #date = localtime;
print strftime "today is %Y-%m-%d\n", #date;
$date[3] -= 5 * 7;
print strftime "five weeks ago was %Y-%m-%d\n", #date;
Which solution is best depends partly on what you want to do with the date when you are done. Here is a benchmark with implementations of various methods:
#!/usr/bin/perl
use strict;
use warnings;
use Benchmark;
use Date::Manip qw/UnixDate/;
use Date::Simple qw/today/;
use Date::Calc qw/Add_Delta_Days Today/;
use DateTime;
use POSIX qw/strftime/;
use Class::Date;
my %subs = (
cd => sub {
(Class::Date::now - [0, 0, 5 * 7])->strftime("%Y-%m-%d");
},
dc => sub {
sprintf "%d-%02s-%02d", Add_Delta_Days Today, -5 * 7;
},
dm => sub {
UnixDate("5 weeks ago", "%Y-%m-%d");
},
ds => sub {
(today() - 5 * 7)->strftime("%Y-%m-%d");
},
dt => sub {
my $now = DateTime->from_epoch(epoch => time, time_zone => "local");
my $five_weeks = DateTime::Duration->new(weeks => 5);
($now - $five_weeks)->ymd('-');
},
p => sub {
my #date = localtime;
$date[3] -= 5 * 7;
strftime "%Y-%m-%d", #date;
},
y => sub {
my ($d, $m, $y) = (localtime)[3..5];
my $date = join "/", $m+1, $d, $y+1900;
my $days_ago = 7*5;
$date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)\z##{[sprintf"%.2d",$1]}/#{[sprintf"%.2d",$2]}/$3/$days_ago#;
until ( $date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)/0\z##{[$1+0]}/#{[$2+0]}/$3# ) {
$date =~ s#([0-9]+)/([0-9]+)/([0-9]+)/([0-9]+)##{[$2==1?sprintf"%.2d",$1-1||12:$1]}/#{[sprintf"%.2d",$2-1||31]}/#{[$1==1 && $2==1?$3-1:$3]}/#{[$4-1]}#;
$date =~ s#([0-9]+)\z##{[$1+1]}# unless $date =~ m#^(?:0[1-9]|1[012])/(?:0[1-9]|1[0-9]|2[0-8]|(?<!0[2469]/|11/)31|(?<!02/)30|(?<!02/(?=...(?:..(?:[02468][1235679]|[13579][01345789])|(?:[02468][1235679]|[13579][01345789])00)))29)/#;
}
return $date;
},
);
print "$_: ", $subs{$_}(), "\n" for keys %subs;
Benchmark::cmpthese -1, \%subs;
And here are the results. The strftime method seems to be the fastest, but it is also has the least features.
y: 6/14/2011
dm: 2011-06-14
p: 2011-06-14
dc: 2011-06-14
cd: 2011-06-14
dt: 2011-06-15
ds: 2011-06-14
Rate dt dm y ds cd dc p
dt 1345/s -- -5% -28% -77% -82% -96% -98%
dm 1408/s 5% -- -24% -75% -81% -96% -98%
y 1862/s 38% 32% -- -68% -75% -95% -97%
ds 5743/s 327% 308% 208% -- -24% -84% -90%
cd 7529/s 460% 435% 304% 31% -- -78% -87%
dc 34909/s 2495% 2378% 1775% 508% 364% -- -39%
p 56775/s 4121% 3931% 2949% 889% 654% 63% --
Better than a benchmark is a test of how they handle DST (this test would have caught the error in the assumption about what DateTime->now returns).
#!/usr/bin/perl
use strict;
use warnings;
use Time::Mock;
use Date::Manip qw/UnixDate/;
use Date::Simple qw/today/;
use Date::Calc qw/Add_Delta_Days Today/;
use DateTime;
use POSIX qw/strftime mktime/;
use Class::Date;
sub target {
my #date = localtime;
$date[3] -= 5 * 7;
strftime "%Y-%m-%d", #date;
}
my %subs = (
cd => sub {
(Class::Date::now - [0, 0, 5 * 7])->strftime("%Y-%m-%d");
},
dc => sub { sprintf "%d-%02s-%02d", Add_Delta_Days Today, -5 * 7;
},
dm => sub {
UnixDate("5 weeks ago", "%Y-%m-%d");
},
ds => sub {
(today() - 5 * 7)->strftime("%Y-%m-%d");
},
dt => sub {
my $now = DateTime->from_epoch( epoch => time, time_zone => 'local' );
my $five_weeks = DateTime::Duration->new(weeks => 5);
($now - $five_weeks)->ymd('-');
},
y => sub {
my ($d, $m, $y) = (localtime)[3..5];
my $date = join "/", $m+1, $d, $y+1900;
my $days_ago = 7*5;
$date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)\z##{[sprintf"%.2d",$1]}/#{[sprintf"%.2d",$2]}/$3/$days_ago#;
until ( $date =~ s#^([0-9]+)/([0-9]+)/([0-9]+)/0\z##{[$1+0]}/#{[$2+0]}/$3# ) {
$date =~ s#([0-9]+)/([0-9]+)/([0-9]+)/([0-9]+)##{[$2==1?sprintf"%.2d",$1-1||12:$1]}/#{[sprintf"%.2d",$2-1||31]}/#{[$1==1 && $2==1?$3-1:$3]}/#{[$4-1]}#;
$date =~ s#([0-9]+)\z##{[$1+1]}# unless $date =~ m#^(?:0[1-9]|1[012])/(?:0[1-9]|1[0-9]|2[0-8]|(?<!0[2469]/|11/)31|(?<!02/)30|(?<!02/(?=...(?:..(?:[02468][1235679]|[13579][01345789])|(?:[02468][1235679]|[13579][01345789])00)))29)/#;
}
return join "-", map { sprintf "%02d", $_ }
(split "/", $date)[2,0,1];
},
);
my $time = mktime 0, 0, 0, 13, 2, 111; #2011-03-13 00:00:00, DST in US
for my $offset (map { $_ * 60 * 60 } 1 .. 24) {
print strftime "%Y-%m-%d %H:%M:%S\n", (localtime $time + $offset);
Time::Mock->set($time + $offset);
my $target = target;
for my $sub (sort keys %subs) {
my $result = $subs{$sub}();
if ($result ne $target) {
print "$sub disagrees: ",
"time $time target $target result $result\n";
}
}
}
Using Time::Piece:
use Time::Piece;
use Time::Seconds qw(ONE_DAY);
my $weeks_back = 5;
my $date_str = '7/19/2011';
my $dt = Time::Piece->strptime($date_str, '%m/%d/%Y');
# Avoid DST issues
$dt -= ONE_DAY() * ( 7 * $weeks_back - 0.5 )
my $past_str = $dt->strftime('%m/%d/%Y');
print "$past_str\n";
Too much code for such a simple question! All you need is two simple lines:
my $five_weeks_ago = time - (5*7)*24*60*60;
print scalar localtime($five_weeks_ago), "\n";
My solution is accurate for both DST and leap years.
Here is the way to get the date of 5 weeks back:
$ uname
HP-UX
$ date
Wed Nov 11 09:42:05 CST 2015
$ perl -e 'my ($d,$m,$y) = (localtime(time-60*60*24*(5*7)))[3,4,5]; printf("%d/%d/%d\n", $m+1, $d, $y+1900);'
10/7/2015
say POSIX::strftime(
'%m/%d/%Y' # format string -> mm/dd/YYYY
, 0 # no seconds
, 0 # no minutes
, 0 # no hours
, 19 - ( 5 * 7 ) # current day - numweeks * 7
, 7 - 1 # month - 1
, 2011 - 1900 # YYYY year - 1900
);
Yes, the day comes out to be 19 - 35 = -16, and yes it works.
If date is available as unix timestamp, it can be done with simple arithmetic:
use POSIX qw/strftime/;
say strftime('%Y-%m-%d', localtime(time - 5 * 7 * 86400));