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
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->$_();
}
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.
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.
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:-
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.
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
}
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.
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
}
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.
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.)
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.)
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.
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.
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"
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:
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.)