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

Cool Uses for Perl

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

This section is the place to post your general code offerings -- everything from one-liners to full-blown frameworks and apps.

CUFP's
A dice roller system with Marpa::R2
1 direct reply — Read more / Contribute
by Discipulus
on Jan 16, 2021 at 09:49
    Hello folks!

    I recently asked for your wisdom in First steps with Marpa::R2 and BNF and I got nice answers. I'm playing with dice in these days as you can see in the post is rand random enough to simulate dice rolls?. The module I finally crafted as toy project is Games::Dice::Roller (with its gitlab repository).

    But I had a sudden desire to reimplement the whole in Marpa::R2 and evolvig duelafn's example and following precious GrandFather's suggestions I ended with the following working code.

    I left in it a lot of debug messages in case someone comes here to look for Marpa::R2 examples.

    It actually mimicry the beahaviour of my Games::Dice::Roller for input received (it still does not accept multistring arguments like 3d6 4d4+1 12 kh as the module does) and it outputs in the same way 3 elements: the result, a descriptive string and the internal datastructure.

    The following code is different from Games::Dice::Roller because it has less constraints in received inputs: for example it accepts something like 6d4r1kh3+3 and computes also a correct result, but messing the description. My mudule would reject an input like this.

    Possible inputs given as argument of the program:

    3d6 # simplest one 3d6+3 # with a result modifier 3d8r1 # reroll and discard any 1 3d8rlt3 # reroll and discard any lesser than 3 3d8rgt6 # reroll and discard any greater than 6 3d8rgt6+2 # reroll and discard any greater than 6 and add +2 to the f +inal result 4d6x1 # explode (a new roll is done) each 1 rolled 4d6xlt3 # explode lesser than 3 4d6xgt4 # explode greater than 4 4d12kh3 # keep highest 3 rolls 4d12kl3 # keep lowest 3 rolls 4d12dh3 # drop highest 3 rolls 4d12dl3 # drop lowest 3 rolls 4d20kh3+7 # keep hishets 3 rolls then add 7

    Alea iacta est!

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Dynamically generate setter/getter methods
1 direct reply — Read more / Contribute
by stevieb
on Dec 20, 2020 at 04:03

    This isn't really a cool use for Perl, but more of a cool use of Perl.

    I was making some updates to my Hook::Output::Tiny software, in which I have a couple of subs that do the exact same thing, but the names are different. One thing I like to do in cases such as this is auto generate the subs dynamically.

    For example... you've got a module that has subs one(), two(), three() etc, and they all do the same thing... accept an optional value to stash into the object (setter), and return the value (getter). Each sub has the same (or perhaps different) default values. I always use the old-fashioned Perl way of writing OO code, so that would look like this:

    sub one { my ($self, $value) = @_; $self->{one} = $value if defined $value; return $self->{one} // 1; } sub two { my ($self, $value) = @_; $self->{two} = $value if defined $value; return $self->{two} // 2; } # and so on...

    That gets tedious and frustrating, and is prone to mistypes and other mistakes. What I often do in cases such as this, is auto generate these types of subs within a BEGIN block dynamically, using the magical no strict 'refs';, which allows us to muck with the symbol table directly and do very dangerous stuff in ways that one shouldn't normally do. Here's an example module:

    package Dynamic; use warnings; use strict; BEGIN { my %sub_info = ( one => 1, two => 2, three => 3, four => 4, five => 5, ); no strict 'refs'; for (keys %sub_info) { my $sub_name = $_; # Take a copy of the key, which is the sub +name *$_ = sub { my ($self, $value) = @_; $self->{$sub_name} = $value if defined $value; return $self->{$sub_name} // $sub_info{$sub_name}; }; } } sub new { return bless {}, $_[0]; } 1; __END__

    First, we set things up near the top of the file so it's easily visible within a BEGIN block to ensure the code is compiled first. Here's what's happening:

    • %sub_info is a hash that contains each sub name as the key, and the default value we'll return if the user doesn't change it
    • We disable strict's reference checking with no strict 'refs' so that we can perform super-dangerous stuff, like using a string as a symbol reference
    • Iterate over the hash and copy the key name into a separate variable
    • Set the current key name as the name of the new subroutine by prepending an asterisk to signify a symbol table entry, and assign it a new anonymous sub
    • Just like any other method, we put the code in exactly as we would if we were manually writing it out. Note the use of $sub_name instead of using just $_. This is because we've clobbered $_ by assigning a sub to it. This is why we made a copy of it above
    • Done! Looks just like any other setter/getter, but instead of typing out five subs that look near identical, we've only typed it out once, and let Perl write them for us in a loop

    Here's a script that puts the new module into action. Note that both the module and script are in the same directory for this demonstration:

    use warnings; use strict; use feature 'say'; use lib '.'; use Dynamic; my $dyn = Dynamic->new; say "Manual calls"; say $dyn->one; say $dyn->two; # Or even say "Stringified calls"; for (qw(one two three four five)) { if ($_ eq 'three') { # Update the value of the 'three' method $dyn->three(99); } printf "sub $_: %d\n", $dyn->$_(); }

    Output:

    spek@scelia ~/repos/scripts/perl/dynamically_auto_generate_subs $ perl + dyn.pl Manual calls 1 2 Stringified calls sub one: 1 sub two: 2 sub three: 99 sub four: 4 sub five: 5

    In closing, if you're only doing a couple of subs, it probably isn't worth the hassle, but when you are doing several, it makes things very simple, especially if you need to add new ones in the future. You simply have to enter a new record into the hash.

    Here's the code section that I just wrote that inspired me to write this post. It's from my Hook::Output::Tiny distribution. I am dynamically creating four methods... stdout() and stderr() which effectively do the same thing but act on different things, and their helper counterparts _stdout() and _stderr():

    BEGIN { # Auto generate the stdout() and stderr() methods, and their priva +te # helper counterparts no strict 'refs'; for ('stdout', 'stderr') { my $sub_name = $_; # Public *$_ = sub { my ($self) = @_; if (! wantarray) { warn "Calling $sub_name() in non-list context is depre +cated!\n"; } return defined $self->{$sub_name}{data} ? split /\n/, $self->{$sub_name}{data} : @{[ () ]}; # Empty list }; # Private my $private_sub_name = "_$sub_name"; *$private_sub_name = sub { my ($self) = @_; my $HANDLE = uc $sub_name; open $self->{$sub_name}{handle}, ">&$HANDLE" or die "can't hook " . uc $sub_name . ": $!"; close $HANDLE; open $HANDLE, '>>', \$self->{$sub_name}{data} or die $!; }; } }
    Disclaimer: I'm not joking about hacking at the symbol table directly in ways perl doesn't normally allow being dangerous. It's very easy to clobber stuff far away in your code when you do these things.
Link push/digital signage server+client
No replies — Read more | Post response
by Corion
on Nov 27, 2020 at 09:32

    Sometimes I want to display the same HTML page on multiple devices. Think photo album or something else.

    Sometimes I want to "push" an URL, and then pick it up from a single device.

    This server does both:

    The /set URL is where you can enter the URL, and where you also can find a bookmarklet to send whatever current page to the server.

    The /iframe URL will be used by any client for the digital signage.

    The / URL will directly redirect to the target URL. I use that when I'm watching a stream on one device but want to continue to watch it on another device.

    The repository is at https://github.com/Corion/App-linkshare

    use Mojolicious::Lite '-signatures'; use Mojo::JSON 'encode_json'; our $VERSION = '0.01'; our $url; get '/' => sub($c) { return $c->redirect_to($url); }; get '/set' => sub( $c ) { if( my $url = $c->param('url')) { $url = $c->param('url'); warn "Set URL to <$url>"; notify_clients({ src => $url }); }; $c->stash( url => $url ); $c->render( template => 'set'); }; post '/set' => sub($c) { $url = $c->param('url'); $c->stash( url => $url ); warn "Set URL to <$url>"; notify_clients({ src => $url }); }; get '/iframe' => sub( $c ) { $c->stash( url => $url ); $c->render( template => 'iframe'); }; my %clients; my $id = 0; websocket '/cnc' => sub( $c ) { $clients{ $id++ } = $c; $c->on( message => sub( $c, $msg ) { # we don't handle clients talking to us }); }; sub notify_clients( $msg ) { my $str = encode_json( $msg ); for my $id (keys %clients) { eval { $clients{ $id }->send($str); }; if( $@ ) { delete $clients{ $id }; }; }; } app->start; __DATA__ @@ set.html.ep <html> <body> <form method="POST" url="/set"> <label for="url">Enter URL to share:</label> <input id="url" type="text" name="url" placeholder="http://example.com +" value="<%= $url %>" /> <input type="submit"/> </form> <a href="javascript:void(new Image().src='<%= $c->url_for('/set')->to_ +abs %>?url='+encodeURIComponent(document.location))">Bookmarklet for +setting a link to the current page</a> </body> </html> @@ iframe.html.ep <!DOCTYPE html> <html> <head> <!-- just in case the ws breaks down --> <meta http-equiv="refresh" content="300; URL=<%= $c->url_for('/iframe' +) %>"> <title>URL receiver</title> <script> let ws_uri = "<%= $c->url_for('/cnc')->to_abs() =~ s!^http!ws!r %>"; window.uplink = new WebSocket(ws_uri); window.uplink.onmessage = (event) => { let target = document.getElementById('iframe'); console.log(event.data); let msg = JSON.parse(event.data); try { target.src = msg.src; } catch(e) { console.log(e); }; }; </script> </head> <body style="margin:0px; padding:0px;"> <iframe id="iframe" style="width: 100%; height: 100%; position: absolu +te; border: none;" frameborder="0" allowfullscreen allow='autoplay' s +rc="<%= $url %>"/> </body> </html>
Routines to help place widgets using Tk "grid" GM
1 direct reply — Read more / Contribute
by johngg
on Oct 20, 2020 at 06:51

    When using the "grid" geometry manager in a Tk application to place a number of, say, buttons it can be a little confusing when the number of widgets is not an exact multiple of the number of rows or columns constraining the layout. I came up with a small module that calculates the "x" and "y" for each widget, returning a ref to an AoA of widget positions. Here is the module:-

    Here is a test script that demonstrates its use:-

    I'm posting this in the hope that someone might find it useful.

    Update: Corrected typo.

    Cheers,

    JohnGG

Solving a maths problem with Perl
2 direct replies — Read more / Contribute
by tobyink
on Sep 03, 2020 at 06:39

    Simple maths problem.

    an is defined as 1 + (1/n).

    Sn is defined as a1 + a2 + ... + an.

    So we're gonna calculate S15, and we're gonna use object-oriented programming because I'm me.

    use v5.16; package Local::App { use Zydeco; use List::Util 'sum'; class Calc { method a ( PositiveInt $n ) = 1 + (1/$n); method S ( PositiveInt $n ) = sum( map $self->a($_), 1 .. $n ) +; } } my $calc = Local::App->new_calc; say $calc->S(15);

    Or, using rational numbers:

    use v5.16; package Local::App { use Zydeco; use List::Util 'sum'; class Calc { method r ( $n ) = 1/$n; method a ( PositiveInt $n ) = 1 + $self->r($n); method S ( PositiveInt $n ) = sum( map $self->a($_), 1 .. $n ) +; class +Rational { use Math::BigRat; method r ( $n ) = Math::BigRat->new("1/$n"); } } } my $calc = Local::App->new_calc_rational; say $calc->S(15);
Raspberry PI si5351 Driver with HiPi
No replies — Read more | Post response
by jmlynesjr
on Aug 30, 2020 at 21:36

    Update: Per the original author(Jerry) a set of reserved bits in reg 183 should be set to 0x12 per a note in AN619 pg 61. Also added some comments.

    The Holy Grail

    After much gnashing of teeth, I have a working driver for the Adafruit Silicon Labs si5351 clock generator break out board. This board has three clock outputs that can generate a 8KHz to 160MHz square wave.

    A future upgrade will include code to optionally generate I(0 deg) and Q(90 deg) signals on CLK0 and CLK1 to support SDR processing by Quisk.

    James

    There's never enough time to do it right, but always enough time to do it over...

Raspberry Pi I2C Address Scanner with HiPi
No replies — Read more | Post response
by jmlynesjr
on Aug 29, 2020 at 22:20

    In browsing the HiPi::Device::I2C documentation I came across the scan_bus() function that loops through all of the possible I2C addresses and returns a list of active addresses.

    This script scans the I2C bus and prints the found addresses. This would have been very useful in debugging the OLED scripts!

    #! /usr/bin/perl # hipiI2Cscanner.pl - Scan the I2C Bus for active devices # using the HiPi Raspberry Pi Perl Library # Documentation at https://raspberry.znix.com/ # # James M. Lynes, Jr. - KE4MIQ # Created: June 28, 2020 # Last Modified: 08/28/2020 - Initial test version # 08/29/2020 - Change to printf to print address in Hex use strict; use warnings; use HiPi qw( :i2c ); use HiPi::Device::I2C; $SIG{INT} = \&trapcc; # Trap CTRL-C Signal my $dev = HiPi::Device::I2C->new(); # Create I2C Object my @attached = $dev->scan_bus(); # Scan I2C bus for # attached devices print "\nI2C Bus Scanner\n"; # List found devices print "===============\n"; foreach my $addr(@attached) { printf "Found address: %x\n", $addr; } print "Done...\n"; sub trapcc{ die "Terminated by CTRL-C Signal\n\n"; # Kill the script }

    James

    There's never enough time to do it right, but always enough time to do it over...

Raspberry Pi OLED Display with HiPi-Updating a Field
No replies — Read more | Post response
by jmlynesjr
on Aug 25, 2020 at 19:18

    This example shows how to use the HiPi invert_pen() call to first erase a field and to then rewrite it. The example draws an incrementing frequency value ##.###.### in a loop.

    The update rate looks like it will be acceptable to someone using a manual tuning knob.

    If these examples get boring, let me know.

    James

    There's never enough time to do it right, but always enough time to do it over...

Raspberry PI OLED Display with HiPi
2 direct replies — Read more / Contribute
by jmlynesjr
on Aug 23, 2020 at 10:58

    Below is an example of using the Adafruit 0.96" mono OLED display v2.1 on a Raspberry PI 3B+ with the HiPi distribution. Adafruit's newest version doesn't require a reset pin and includes the SparkFun qwiic I2C bus connectors.

    This example is based on the MonoOLED example from the distribution with several modifications. From the Adafruit library source code comments, it was determined that the 128x64 I2C version requires an I2C address of 0x3D rather than the default of 0x3C. Four update_display() calls were added to write the internal buffer to the display.

    After much searching, I found that Pololu is a good source of the RPi 20x2 connector shells. They also have pre-crimped jumpers and crimp pins. The jumpers and pins also fit into "Dupont" style shells.

    #! /usr/bin/perl # hipioled.pl - Test of 0.96" 128x64 Pixel OLED Display with I2C Inter +face, # using the HiPi Raspberry Pi Perl Library # https://raspberry.znix.com/ # # James M. Lynes, Jr. - KE4MIQ # Created: June 27, 2020 # Last Modified: 06/27/2020 - Initial test version # 08/22/2020 - Changed I2C address to 0x3D for 128x64 d +isplay # per comment in Adafruit library sour +ce # - Added update_display() calls 4 places # to copy buffer to the display # 08/23/2020 - Removed several unneeded statements # # Target: Raspberry Pi 3B+ with Adafruit 0.96" OLED BOB # # Notes: Code based on HiPi documentation example # from HiPi::Interface::MonoOLED # Adafruit 0.96" OLED BOB v2.1(must jumper I2C pads on +the # back side of the BOB). New version doesn't requir +e # the reset pin and has SparkFun qwiic I2C bus conn +ectors # # RPI J8 - GPIO Pin Definitions si5351 BOB Pin Definitions +(I2C) # ----------------------------- -------------------------- +----- # [RED] 3V3 (1) (2) 5V (1) CLK0 - SMA # [YEL] SDA/GPIO2 (3) (4) 5V (2) CLK1 - SMA # [BLU] SCL/GPIO3 (5) (6) GND (3) CLK2 - NC # GPIO4 (7) (8) GPIO14 (4) SCL - [BLU] # GND (9) (10) GPIO15 (5) SDA - [YEL] # PB1/GPIO17 (11) (12) GPIO18 (6) GND - [BLK] # PB2/GPIO27 (13) (14) GND [BLK] (7) VIN - [RED] # ENCA/GPIO22 (15) (16) GPIO23 # 3V3 (17) (18) GPIO24 # ENCB/GPIO10 (19) (20) GND 0.96" OLED Pin Definitions +(I2C) # RED/ GPIO9 (21) (22) GPIO25 -------------------------- +----- # YEL/GPIO11 (23) (24) GPIO8 (1) SDA - [YEL] # GND (25) (26) GPIO7 (2) SCL - [BLU] # *GPIO0 (27) (28) GPIO1* (3) DC/A0 - NC # GRN/ GPIO5 (29) (30) GND (4) RST - [YEL] +GPIO21 # GPIO6 (31) (32) GPIO12 (5) CS - NC # GPIO13 (33) (34) GND (6) 3V3 - NC # GPIO19 (35) (36) GPIO16 (7) Vin - [RED] # GPIO26 (37) (38) GPIO20 (8) GND - [BLK] # GND (39) (40) GPIO21 [YEL] # * GPIO0 & GPIO1 are reserved use strict; use warnings; use HiPi qw( :oled :rpi); use HiPi::Interface::MonoOLED; $SIG{INT} = \&trapcc; # Trap CTRL-C Signal my $oled = HiPi::Interface::MonoOLED->new( # Create OLED Object type => SSD1306_128_X_64_I2C, # Use I2C interface address => 0x3D, # Addr for 128x64 I2C +BOB reset_pin => 21, # GPIO21 # flipped => 1, # Flip screen top to b +ottom # skip_logo => 1, # Don't display splash + screen # skip_reset => 1, # Don't reset the disp +lay ); sleep(2); # Display splash for 2 + sec $oled->display_reset(); # Clear buffer/reset d +isplay my $dc = $oled->create_context; my($w, $h) = $dc->draw_text(0, 0, 'Raspberry Pi', 'Sans14'); my $cx = int(0.5 + $w/2); # Center text string my $cy = int(0.5 + $h/2); # Draw top line centered { my $x = int(0.5 + ($oled->cols - $w) / 2); my $y = 0; $oled->draw_context($x, $y, $dc->rotated_context(0, 0, 0)); $oled->display_update(); # Copy buffer to displ +ay } # Draw bottom line rotated through 180 about its center($cx & $cy) { my $x = int(0.5 + ($oled->cols - $w) / 2); my $y = $oled->rows - $h - 1; $oled->draw_context($x, $y, $dc->rotated_context(180, $cx, $cy)); $oled->display_update(); # Copy buffer to displ +ay } $dc->clear_context; ($w, $h) = $dc->draw_text(0, 0, 'Perl', 'Sans14'); # Perl right { my $x = $oled->cols - 1; my $y = int(0.5 + ($oled->rows - $w) / 2); $oled->draw_context($x, $y, $dc->rotated_context(90, 0, 0)); $oled->display_update(); # Copy buffer to displ +ay } # Perl left { my $x = 0; my $y = int(0.5 + ($w + $oled->rows) / 2); $oled->draw_context($x, $y, $dc->rotated_context(-90, 0, 0)); $oled->display_update(); # Copy buffer to displ +ay } sub trapcc{ die "Terminated by CTRL-C Signal\n\n"; # Kill the script }

    James

    There's never enough time to do it right, but always enough time to do it over...

Raspberry Pi GPIO with HiPi
No replies — Read more | Post response
by jmlynesjr
on Jun 16, 2020 at 20:37

    A few examples of using the HiPi Raspberry Pi GPIO Distribution

    The HiPi Distribution allows Perl to drive the GPIO pins on a Raspberry Pi. I2C, SPI, LCD, OLED and other devices are also supported. See https://raspberry.znix.com. If you have previously used RPi::WiringPi, the syntax is very similar and porting was easy.

    My test hardware is a prototype radio front panel with 3 LEDs, 2 Pushbuttons, and a rotary encoder. My testing was done on an RPi 3B+. HiPi also supports the RPi 4.

    I am working on a driver for the Adafruit si5351 oscillator breakout board and an integrated script to connect the front panel to the Quisk Software Defined Radio package via a localhost socket.

    hipiblink.pl - Blink a single LED - "Hello World"

    hipiiotest.pl - Blink 3 LEDs, Read 2 switches, Read an encoder

    hipirpidebounce.pl - Debounce 2 switches

    hipipolledencoder.pl - Read an encoder

    hipicpustats.pl - Display cpu%, Memory%, temperature

    hipiquiskinstallation.txt - Installation notes

    James

    There's never enough time to do it right, but always enough time to do it over...

The 15 Puzzle
5 direct replies — Read more / Contribute
by msh210
on Jun 09, 2020 at 19:48

    Hi, Monks.

    I'm no great shakes at writing Perl but someone threw down the "write the 15 Puzzle" gauntlet (elsewhere) so I decided to try my hand — and I managed to produce my first-ever Perl game (or puzzle). (Of course, the 15 Puzzle has been done before but I wrote my (much simpler) version without reference to that and, heck, I'm proud of it, so give a nonexpert a break. That said, any constructive feedback would be most welcome.)

Shrink Images and PDFs
3 direct replies — Read more / Contribute
by haukex
on May 02, 2020 at 04:53

    Here's a script I use all the time via the right-click menu in my file manager (Nautilus), it will shrink PDFs and images so they work better as email attachments (Update: to be a little more specific: files that are several MB or more are usually due to high-resolution images, so this script runs commands to reduce their resolution). It does require Path::Class, ImageMagick's convert, GhostScript's gs, and my modules IPC::Run3::Shell and Shell::Tools.

    (Also, not Perl related, but I use this pretty much every day: setting up a keyboard combination such as Ctrl+Shift+F for the shell command xsel -b | xsel -ib, which causes the current clipboard buffer to be converted to text-only, which has been incredibly useful when copying formatted text that I don't want to keep the formatting of. The shell command may need to be placed into a simple script file depending on whether you can configure keyboard shortcuts to run a shell command, or if they can only run a single executable.)

    My 3000th node! :-O

Applied MCE : Building a load-testing framework for PSGI apps with Plack::Test and MCE::Queue
No replies — Read more | Post response
by 1nickt
on Mar 30, 2020 at 10:49

    If you develop PSGI apps in Dancer2, Mojolicious, Plack or something else, you probably know that it's fairly easy to test all your routes and confirm that they function as expected. But what about the performance of your app under load? Will there be any bottlenecks? Can the database support the concurrent connections you plan to open? Do you have enough, or too many, workers serving requests? Etc.

    The following script shows how to build a load-testing framework for your PSGI app using Plack::Test for the scaffold and MCE::Flow and MCE::Queue to create the concurrent traffic. (The example includes a Dancer2 app to be exercised, but you can of course use your own app class from outside or inside the script, updating the test flow appropriately.)

    The demonstration simulates an API for managing account records that exposes three endpoints: / POST, / GET, / PUT. The workflow/account lifespan is typical: the caller first creates an account record via a POST call, which returns an id that must be used for future calls. The demonstration simulates the caller encountering the account record still with status 'pending' on the first GET call, and having to call again until it is activated. Finally, the caller deletes the account.

    The script is configured to create 1,000 accounts shared among 10 users. (Note that this is an example and includes no parameter checking, error handling, etc. For demonstration purposes only.) The example app creates an SQLite database on disk.

    How it works
    The script uses MCE::Flow to simulate the workflow, and MCE::Queue to manage the jobs. Two user subroutines are defined, one for the queue "producer" and one for the queue "consumers." The "producer" represents callers making the initial requests to create new accounts; these are placed onto the queue at small intervals. The "consumers" of the queue represent callers making subsequent requests to the app and reacting to the response, sometimes by making a new request. In that case a job for the new request is placed on the queue before the "consumer" finishes the current job.

    To tune the test, change the number of consumers, add more accounts to be created, or reduce/increase the sleeps representing work being performed and caller latency.

    To run the test
    Just copy the code, install the dependencies, and run. You may wish to tail the log file (by default at /tmp/test.log) to see what the app is doing. Afterwards you may wish to examine the populated database (by default at /tmp/test.sqlite), as it will be overwritten on the next run.



    script to load-test/profile a PSGI application


    Some sample output:


    The way forward always starts with a minimal test.
Statistics::Covid : module for fetching and storing covid19-related data for analysis
2 direct replies — Read more / Contribute
by bliako
on Mar 26, 2020 at 15:42

    Fellow Monks,

    I have just submitted to CPAN a very alpha release of a module which collects data from various online providers of Covid19-related statistics (e.g. number of confirmed cases etc.). For example, data provided by Johns Hopkins University (as an arcgis "dashboard") or the data provided by the UK government for data relating to the UK local authorities.

    All the providers I used (so far, John Hopkins University and the UK government) offer an API which provides JSON data. The scraper can be easily configured (that is subclassed) to set the url entry point to the API and how data should be converted to a Perl object. So, it is relatively easy to create more data fetchers which can all store to the same db.

    Fetched data is stored in an SQLite database (support for MySQL exists but remains untested and probably broken - but easily fixed) and there is a high-level interface (thank you DBIx::Class) for saving and retrieving this data. This makes it easy to save data points only if they are more "up-to-date" than what currently exists in database, for the same location and time point (using heuristics). Or, it allows to retrieve all data for a single location over time, or for a single time point/range over all or some locations.

    The CPAN module is Statistics::Covid. It is also hosted on github at https://github.com/hadjiprocopis/statistics-covid which additionally provides the data I have so far collected since a couple of weeks ago.

    If anyone has any comments or suggestions please leave me a message.

    If anyone wishes to contribute, e.g. data analysis or plots generation, under this or any other namespace, please let me know so that I link to that work. I am also starting to write my own analysis which will be under the namespace: Statistics::Covid::Analysis.

    Here is some code from the synopsis as a quick start:

    use Statistics::Covid; use Statistics::Covid::Datum; $covid = Statistics::Covid->new({ 'config-file' => 't/example-config.json', 'providers' => ['UK::BBC', 'UK::GOVUK', 'World::JHU'], 'save-to-file' => 1, 'save-to-db' => 1, 'debug' => 2, }) or die "Statistics::Covid->new() failed"; # fetch all the data available (posibly json), process it, # create Datum objects, store it in DB and return an array # of the Datum objects just fetched (and not what is already in D +B). my $newobjs = $covid->fetch_and_store(); print $_->toString() for (@$newobjs); print "Confirmed cases for ".$_->name() ." on ".$_->date() ." are: ".$_->confirmed() ."\n" for (@$newobjs); my $someObjs = $covid->select_datums_from_db({ 'conditions' => { belongsto=>'UK', name=>'Hackney' } }); print "Confirmed cases for ".$_->name() ." on ".$_->date() ." are: ".$_->confirmed() ."\n" for (@$someObjs); # or for a single place (this sub sorts results wrt publication ti +me) my $timelineObjs = $covid->select_datums_from_db_for_location('Hac +kney'); for my $anobj (@$timelineObjs){ print $anobj->toString()."\n"; } print "datum rows in DB: ".$covid->db_count_datums()."\n"

    Edit: thank yous to marto for advice on githubbing this module and to erix for pointing some errors in this page (John -> Johns)

    BW, bliako

Logging Serial Ports with Mojolicious
No replies — Read more | Post response
by haukex
on Mar 19, 2020 at 16:37

    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!

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


Add your CUFP
Title:
CUFP:
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?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others studying the Monastery: (3)
    As of 2021-01-28 07:22 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Notices?