Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

I gave a talk recently at the German Perl Workshop in Erlangen (video here, in German). In that talk, among other things, I spoke about how I built a data logger for a sensor, and was doing everything with Mojolicious - reading the serial port, logging the data, and providing a user interface. Since it may be a little bit until I can publish the design of the data logger, I've put together a stripped-down example in case it's useful to someone. The key pieces here are:

It's a relatively long piece of code, but it's entirely self-contained. If you have any questions or suggestions, please feel free to let me know!

#!/usr/bin/env perl use 5.028; use Mojolicious::Lite -signatures; use Mojo::IOLoop::Stream::Role::LineBuffer; use Mojo::SQLite; use Mojo::JSON qw/encode_json/; use Mojo::Util qw/dumper/; use Fcntl qw/:DEFAULT/; use IO::Termios (); # NOTICE: This script is designed to work in a single-threaded, # single-process server only! (morbo or Mojolicious::Command::daemon) # disable template cache in development mode (e.g. under morbo): app->renderer->cache->max_keys(0) if app->mode eq 'development'; helper sql => sub { state $sql = Mojo::SQLite->new(':memory:') }; app->sql->migrations->from_string(<<'END_MIGRATIONS')->migrate; -- 1 up CREATE TABLE DataLog ( Timestamp DATETIME, Source TEXT, ValueA TEXT, ValueB TEXT ); -- 1 down DROP TABLE IF EXISTS DataLog; END_MIGRATIONS my %serports = ( # this is essentially the configuration for the ports '/tmp/fakepty1' => sub { sysopen my $fh, '/tmp/fakepty1', O_RDONLY or die "sysopen /tmp/fakepty1: $!"; my $hnd = IO::Termios->new($fh) or die "IO::Termios->new: $!"; $hnd->set_mode('19200,8,n,1'); #use IO::Stty; # if needed #IO::Stty::stty($hnd, qw/ cs8 -parenb raw -echo /); return $hnd; }, '/tmp/fakepty2' => sub { sysopen my $fh, '/tmp/fakepty2', O_RDONLY or die "sysopen /tmp/fakepty2: $!"; my $hnd = IO::Termios->new($fh) or die "IO::Termios->new: $!"; $hnd->set_mode('19200,8,n,1'); return $hnd; }, ); my $retry_interval_s = 10; my $parse_re = qr{ ^ (?<Source> \w+ ) , (?<ValueA> \d+ ) , (?<ValueB> \d+ ) $ }msx; my $serial = Mojo::EventEmitter->new; # serial event dispatcher sub setup_streams { state %streams; for my $k (sort keys %serports) { next if $streams{$k}; my $handle = eval { $serports{$k}->() }; if (!$handle) { $serial->emit(error => "Stream $k Open: $@"); Mojo::IOLoop->timer($retry_interval_s => \&setup_streams); next; } $streams{$k} = Mojo::IOLoop::Stream->new($handle) ->with_roles('+LineBuffer')->watch_lines; $streams{$k}->on(read_line => sub ($strm, $line, $sep) { if ( $line =~ $parse_re ) { my %rec = ( %+, Timestamp => time ); app->sql->db->insert('DataLog', \%rec); $serial->emit(data => \%rec); } else { $serial->emit(error => "Stream $k: failed to parse ".dumper($line)) } }); $streams{$k}->on(close => sub ($strm) { $serial->emit(error => "Stream $k Closed"); $streams{$k}->stop; delete $streams{$k}; Mojo::IOLoop->timer($retry_interval_s => \&setup_streams); }); $streams{$k}->on(error => sub ($strm, $err) { $serial->emit(error => "Stream $k Error: $err"); }); $streams{$k}->on(timeout => sub ($strm) { $serial->emit(error => "Stream $k Timeout"); # could possibly close & re-open stream here }); $streams{$k}->start; } } Mojo::IOLoop->next_tick(\&setup_streams); get '/' => sub ($c) { $c->render(template => 'index') } => 'index'; get '/q' => sub ($c) { $c->render(template => 'query') } => 'query'; get '/events' => sub ($c) { $c->inactivity_timeout(300); $c->res->headers->content_type('text/event-stream'); $c->write; my $cb_data = $serial->on(data => sub ($ser,$data) { my $json = encode_json($data) =~ s/\n//gr; $c->write("event: ser_data\ndata: $json\n\n"); } ); my $cb_err = $serial->on(error => sub ($ser,$err) { $err =~ s/\n//g; $c->write("event: ser_err\ndata: $err\n\n"); } ); $c->on(finish => sub ($c) { $serial->unsubscribe(data => $cb_data); $serial->unsubscribe(error => $cb_err); }); } => 'events'; app->start; __DATA__ @@ index.html.ep % layout 'main', title => 'Hello, World!'; <nav>[ <b>Live</b> | <%= link_to Query => 'query' %> ]</nav> <main> <div><table border="1"> <tr> <th>Source</th> <th>Timestamp</th> <th>ValueA</th> <th>ValueB</th> </tr> <tr> <th>Foo</th> <td id="Foo_time">-</td> <td id="Foo_vala">-</td> <td id="Foo_valb">-</td> </tr> <tr> <th>Bar</th> <td id="Bar_time">-</td> <td id="Bar_vala">-</td> <td id="Bar_valb">-</td> </tr> </table></div> </main> <script src="" integrity="sha256-CSXorXvZcTkaix6Yvo6HppcZGetbYMGWSFlBw8HfCJo=" crossorigin="anonymous"></script> <script> "use strict"; var events = new EventSource('<%= url_for 'events' %>'); events.addEventListener('ser_data', function (event) { var data = JSON.parse(; $('#'+data.Source+'_time').text(data.Timestamp); $('#'+data.Source+'_vala').text(data.ValueA); $('#'+data.Source+'_valb').text(data.ValueB); }, false); events.addEventListener('ser_err', function (event) { alert(; }, false); </script> @@ query.html.ep % layout 'main', title => 'Query'; <nav>[ <%= link_to Live => 'index' %> | <b><%= link_to Reload => 'query' %></b> ]</nav> <main><table border="1"> % my @fields = qw/ Timestamp Source ValueA ValueB /; <tr> % for my $f (@fields) { <th><%= $f %></th> % } </tr> %# NOTE: This database code doesn't normally belong in the view % my $results = sql->db->select('DataLog', % \@fields, undef, ['Timestamp','Source']); % while ( my $row = $results->hash ) { <tr> % for my $f (@fields) { <td><%= $row->{$f} %></td> % } </tr> % } </table></main> @@ layouts/main.html.ep <!DOCTYPE html> <html> <head><title><%= title %></title></head> <body> %= content </body> </html>

This is the script to provide the fake serial ports using socat:

#!/usr/bin/env perl use warnings; use strict; use Data::Dump; use IPC::Run qw/ start /; print STDERR "Starting...\n"; my @procs = ( { n=>'Foo', c=>['socat','pty,rawer,link=/tmp/fakepty1','-'], v=>sub { "Foo,".(time-$^T).",".int(rand(100))."\n" } }, { n=>'Bar', c=>['socat','pty,rawer,link=/tmp/fakepty2','-'], v=>sub { "Bar,".(time-$^T).",".int(rand(100))."\n" } }, ); for my $p (@procs) { $p->{i} = \(my $i=''); $p->{o} = \(my $o=''); $p->{p} = start $p->{c}, $p->{i}, $p->{o}; } print STDERR "Running...\n"; my $run = 1; local $SIG{INT} = sub { print STDERR "Caught SIGINT\n"; $run = 0 }; while ($run) { for my $p (@procs) { sleep 1; ${$p->{i}} .= $p->{v}->(); $p->{p}->pump; if ( length ${$p->{o}} ) { dd $p->{n}, ${$p->{o}}; ${$p->{o}} = ''; } } } $_->{p}->signal('INT') for @procs; $_->{p}->finish for @procs; print STDERR "Done.\n";

To run this code, first start the second script (e.g. perl, and then the first, e.g. via morbo, and then visit the URL shown in the console. (Note this won't work on Windows.)

In reply to Logging Serial Ports with Mojolicious by haukex

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, 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, 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.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (2)
    As of 2020-07-03 22:42 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found