http://qs321.pair.com?node_id=1214759

wjw has asked for the wisdom of the Perl Monks concerning the following question:

I am working on a RPi<->Arduino project and noticed that my Perl script boosts my load average to 127. The rough Perl code is below and runs just fine, as does the Arduino code. What I would like is to find a way to 'sleep' that Perl script for the 14 seconds between reads from the Arduino.

This is not hugely important right now, but might take on more importance as I add more projects to the RPi3. I have looked at sleep, delay, and several of the XXXX.Sleep.XXX modules on CPAN, but was wondering if someone with more experience with long running Perl scripts (mine have been exclusively run-once-and-done scripts) might have some advice.

My goal is to let the RPI run off and do other things while I wait for the next Arduino message, and thus reducing system resource usage during that (currently 15 second) wait. Any input/experience appreciated.

#!/usr/bin/perl -w use Modern::Perl; use Device::SerialPort::Arduino; use DBI; #use Proc::Daemon; use DateTime; use JSON; #use Data::Dumper; my $dbfile = "/home/wjw/weather_data"; my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile" ,"",""); my ($key,$val, %rx, $q, $cnt, %last, %hash, $sth, $char_cnt, $rec_cnt, + $char, $timeout, $buffer, $timestamp, $json); #################################### # Set up the serial port my $dev = Device::SerialPort->new("/dev/ttyUSB0") || warn "Can't open +/dev/ttyUSB0 $!"; my $debug = 0; #set to 1 if debug print statements +are to be displayed my $profile = 0; # set to '1' when running NYTProfile. + Limits run length... $dev->baudrate(115200); # you may change this value $dev->databits(8); # but not this and the two following $dev->parity("none"); $dev->stopbits(1); $dev->read_char_time( 0 ); # don't wait for each character $dev->read_const_time( 1000 ); # 1 second per unfulfilled "read" call #################################### while (1) { #Proc::Daemon::Init; #my $continue = 1; #$SIG{TERM} = sub { $continue = 0 }; #while ($continue) { # Poll to see if any data is coming in my $char = $dev->lookfor(); $cnt++; if ($char) { # if ($debug == 1) { # say "Raw input is -> $char"; # } $rec_cnt ++; next if $rec_cnt == 1; # The first line incoming tends to b +e two lines combined, skip it. $timestamp = uts_to_iso(time()); my $line = $char; chomp($line); if ($debug == 1) { say $line; } $json = decode_json($line); # print Dumper($json); if ( (exists($json->{'bbl'})) and (not exists($json->{'ra'}))) + { $q = "insert into weather_data values (?, ?, ?, ?, ?, ?, ? +, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"; my $sth = $dbh->prepare($q); $sth->execute(undef, $timestamp, dt('date'), dt('time'), $ +json->{'wd'}, $json->{'wv'}, $json->{'tF'}, $json->{'tC'}, $json->{'b +p'}, $json->{'rh'}, $json->{'li'}, $json->{'ov'}, $json->{'lux'}, $js +on->{'bbl'}, $json->{'irl'}, 'null', 'null' ); } elsif ( (exists($json->{'ra'})) and (exists($json->{'bbl'})) +) { $q = "insert into weather_data values (?, ?, ?, ?, ?, ?, ? +, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"; $sth = $dbh->prepare($q); $sth->execute(undef,$timestamp, dt('date'), dt('time'), $j +son->{'wd'}, $json->{'wv'}, $json->{'tF'}, $json->{'tC'}, $json->{'bp +'}, $json->{'rh'}, $json->{'li'}, $json->{'ov'}, $json->{'lux'}, $jso +n->{'bbl'}. $json->{'irl'}, $json->{'ra'}, $json->{'rr'} ); } elsif ( (exists($json->{'ra'})) and (not exists($json->{'bbl +'}))) { $q = "insert into weather_data values (?, ?, ?, ?, ?, ?, ? +, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"; $sth = $dbh->prepare($q); $sth->execute(undef,$timestamp, dt('date'), dt('time'), $j +son->{'wd'}, $json->{'wv'}, $json->{'tF'}, $json->{'tC'}, $json->{'bp +'}, $json->{'rh'}, $json->{'li'}, $json->{'ov'}, 'null', 'null', 'nul +l', $json->{'ra'}, $json->{'rr'} ); } elsif ( (not exists($json->{'ra'})) and (not exists($json->{ +'bbl'}))) { $q = "insert into weather_data values (?, ?, ?, ?, ?, ?, ? +, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"; $sth = $dbh->prepare($q); $sth->execute(undef,$timestamp, dt('date'), dt('time'), $j +son->{'wd'}, $json->{'wv'}, $json->{'tF'}, $json->{'tC'}, $json->{'bp +'}, $json->{'rh'}, $json->{'li'}, $json->{'ov'}, 'null', 'null', 'nul +l', 'null', 'null' ); } sleep(1); } } ################################ sub uts_to_iso { my $uts = shift; my $date = DateTime->from_epoch(epoch => $uts, time_zone => 'Ameri +ca/Chicago'); return $date->ymd().'T'.$date->hms().'Z'; } ################################ sub sayq { my $qs = shift @_; if (length($qs) > 0) { say $qs; } } ################################# sub dt { my $request = shift(@_); my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localti +me(); if ($request =~ /date/) { $year = $year + 1900; return "$year" . "-" . "$mon" . "-" . "$mday"; } if ($request =~ /time/) { return "$hour" . ":" . "$min" . ":" . "$sec"; } }

...the majority is always wrong, and always the last to know about it...

A solution is nothing more than a clearly stated problem...