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...


In reply to Waiting for Device::Serialport by wjw

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.