Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
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
Bulk check for successful compilation
1 direct reply — Read more / Contribute
by davebaker
on Jul 02, 2022 at 17:16

    Just a note to say how much fun it was for me to try the Test::Compile::Internal module, which zips through every Perl module and script in my cgi-bin directory and its subdirectories, making sure each such file successfully compiles.

    This lets me feel more at ease about there not being any lurking problems that have arisen due to my having renamed or deleted some custom module, and that scripts or modules I'm still developing haven't "use"d a module and its specified subroutines (whether custom or in my Perl libraries) in a way that misspelled the module name or the subroutine name, or that tries to import a subroutine that doesn't actually exist in the "use"d module (such as a subroutine I meant to add to a "use"d custom module but never got around to adding).

    #!/opt/perl524 use strict; use warnings; use Test::Compile::Internal; my $test = Test::Compile::Internal->new(); $test->all_files_ok( '/www/cgi-bin' ); $test->done_testing();
Mite: an OO compiler for Perl
No replies — Read more | Post response
by tobyink
on Jul 02, 2022 at 13:34

    This article has also been posted on blogs.perl.org here.

    Moose is great, but it does introduce a slight performance hit to your code. In the more than 15 years since it was first released, hardware improvements have made this less of a problem than it once was. Even so, if performance is a concern for your project, Moose might not be what you want. It also has a fairly big collection of non-core dependencies.

    Moo is a lighter weight version, minus with meta-object protocol, but supporting nearly all of Moose's other features. It loads faster, sometimes runs faster, and has fewer dependencies. (And most of the dependencies it does have are just modules which used to be part of Moo but were split out into separate distributions.)

    But what if you could have fast Moose-like object-oriented code without the dependencies?

    In 2013, Michael Schwern started work on Mite to do just that. It was abandoned in 2014, but I've taken it over and expanded the feature set to roughly equivalent to Moo.

    Mite is an object-oriented programming compiler for Perl. It allows you to write familiar Moose-like object-oriented code, then compile that into plain Perl with zero non-core dependencies. Your compiled code does not even have a dependency on Mite itself!

    How do I use Mite?

    Here's how you could start a project with Mite or port an existing Moose/Moo project.

       cd Your-Project/
       mite init 'Your::Project'
       mite compile

    After you've run those commands, Mite will create a module called Your::Project::Mite. This module is your project's own little gateway to Mite. This module is called the shim.

    Now let's write a test case:

       # t/unit/Your-Project-Widget.t
       use Test2::V0
          -target => 'Your::Project::Widget';
       
       can_ok( $CLASS, 'new' );
       
       my $object = $CLASS->new( name => 'Quux' );
       isa_ok( $object, $CLASS );
       
       subtest 'Method `name`' => sub {
          can_ok( $object, 'name' );
          is( $object->name, 'Quux', 'expected value' );
          
          my $e = dies {
             $object->name( 'XYZ' );
          };
          isnt( $exception, undef, 'read-only attribute' );
       };
       
       subtest 'Method `upper_case_name`' => sub {
          can_ok( $object, 'upper_case_name' );
          is( $object->upper_case_name, 'QUUX', 'expected value' );
       };
       
       done_testing;

    And a class to implement the functionality:

       # lib/Your/Project/Widget.pm
       package Your::Project::Widget;
       use Your::Project::Mite;
       
       has name => (
          is     => 'ro',
          isa    => 'Str',
       );
       
       sub upper_case_name {
          my $self = shift;
          return uc( $self->name );
       }
       
       1;

    Run mite compile again then run the test case. It should pass.

    How does Mite work?

    It's important to understand what Mite is doing behind the scenes.

    When you ran mite compile, Mite created a file called lib/Your/Project/Widget.pm.mite.pm. (Yes, a triple file extension!) This file contains your class's new method. It contains the code for the accessor.

    That file does not contain the code for upper_case_name which is still in the original lib/Your/Project/Widget.pm.

    When Perl loads Your::Project::Widget, it will see this line and load the shim:

       use Your::Project::Mite;

    The shim just loads lib/Your/Project/Widget.pm.mite.pm, exports a has function that does (almost) nothing, and then gets out of the way. This gives Perl a working class.

    What features does Mite support?

    Most of what Moo supports is supported by Mite. In particular:

    extends @superclasses

    Mite classes within your project can inherit from other Mite classes within your project, but not from non-Mite classes, and not from Mite classes from a different project.

    with @roles

    As of version 0.002000, Mite also supports roles. If you want your package to be a role instead of a class, just do:

       package Your::Project::Nameable;
       use Your::Project::Mite -role;
       has name => (
          is => 'ro',
          isa => 'Str',
       );
       1;

    As with extends, a limitation is that you can only use Mite roles from within your own project, not non-Mite roles, nor Mite roles from a different project.

    (A future development might add support for Role::Tiny roles though.)

    has $attrname => %spec

    Attributes are obviously one of the main features people look for in a Perl object-oriented programming framework and Mite supports nearly all of Moose's features for defining attributes.

    This includes is => 'ro', is => 'rw', is => 'bare', is => 'rwp' (like Moo), and is => 'lazy' (like Moo); required and init_arg for attribute initialization; reader, writer, accessor, predicate, clearer, and trigger; lazy, default, and builder; weak_ref; isa and coerce for type constraints, including support for any type constraints in Types::Standard, Types::Common::Numeric, and Types::Common::String; and delegation using handles. It also supports an option which Moose doesn't provide: alias for aliasing attributes.

    Mite builds in the functionality of MooseX::StrictConstructor, dying with an appropriate error message if you pass your class's constructor any parameters it wasn't expecting.

    BUILDARGS, BUILD, and DEMOLISH

    Methods you can define to control the life cycle of objects.

    before $method => sub { ... }
    after $method => sub { ... }
    around $method => sub { ... }

    Mite classes and roles can define method modifiers.

    As long as your needs aren't super-sophisticated (introspection using the MOP, runtime application of roles, etc), Mite probably has the features you need for even medium to large projects.

    Mite itself uses Mite!

    Be honest, what are the drawbacks?

    This code still doesn't have a lot of testing "in the wild". Moose and Moo have proven track records.

    You need to remember to mite compile your code after making changes before running your test suite or packaging up a release. This can be annoyingly easy to forget to do. (Though Mite does also include extensions for ExtUtils::MakeMaker and Module::Build to help integrate that into your workflow.)

    The Mite compiler's scope of only looking at the files within your own project limits the ability to create roles which can be composed by third-parties, or classes which can easily be extended by third-parties. If you want that, Moose or Moo are a better option.

    Okay, I'm interested

    If you've read this and you're thinking about porting a Moose or Moo project to Mite, feel free to @-mention tobyink on Github in issue tickets, pull requests, etc if you need any help.

    If there are features which you think Mite is missing which you'd need to port your project to Mite, file bugs with the Mite issue tracker.

COMET DANCER - scafolding for Dancer2
No replies — Read more | Post response
by AlexP
on Jun 19, 2022 at 06:33

    After several months of development, I would like to present COMET DANCER - scaffolding for your Dancer2 apps.

    You could find all code, screenshots and description here -> github/comet-dancer.

    Preface

    Dancer is minimalist, and if you are developing a small app or simple api it's very convenient to use. But if you try to create a bigger app you will encounter a lack of documentation and any examples.

    What is Comet Dancer

    You could think about it like a foundation for web-app. It provides you with a ready environment for application development. You just clone it and get a complete set of tools.

    How to start

    Visit the link above and go through the easy installation process.

    Do you need contributors?

    Yes. If you are interested in Perl and Dancer - you are welcome!

pl Perl One-Liner Magic Wand: looking for feedback
3 direct replies — Read more / Contribute
by Daniel Pfeiffer
on Jun 03, 2022 at 16:58

    One of my favourite Cool Uses for Perl have always been one-liners. But already decades ago I found them still too cumbersome. So, I rolled a wrapper, a better perl -E. When Corona went viral, I decided to publish it, after a major clean up. But I never advertised, beyond meta::cpan and Sourceforge.

    The base idea is a small script I can take to any server where I need to get stuff done. It's self-contained, as many data center hosts are firewalled off from the internet. It supports old Perls: With SuSE SLES 11 and 5.10 out of the way, it's now on 5.16, which comes with Red Hat RHEL 7.

    In hindsight, the added options are powerful, but the way I intertwined them into -n handling is ugly & limiting. Thus, I'm rewriting the wrapping code for pl 1.0. From that comes a small but rich template mechanism (interpolation or sprintf meh.) That's just one of many goodies it contains, like the mighty multi-file key-based diff. There are a bunch of examples, many original:

    https://perl1liner.sourceforge.io

    May the veggie-burger menu guide you!

PerlPowerTools as single Windows executable
1 direct reply — Read more / Contribute
by kaldor
on May 26, 2022 at 16:25

    For a long time, I've been looking for a solution to bring Mac, Windows and Linux behaviour closer. My use case : I work in a corporate Windows environment (where you don't want to install unecessary software), but still would like a friendly CLI (I'm not great at it).

    I use UnxUtils, BusyBox-w32 and other utils to have a bearable experience on Windows, but they don't provide the same features/options as you'll find on macOS or Linux. Then I heard about the PerlPowerTools and thought they'd be perfect for having the same behaviour across these platforms. Even though I somehow find them hard to use due to namespace conflict with system utilities.

    So, I've updated (my fork of) the PerlPowerTools to behave like BusyBox and bundle them (with PAR::Packer) as a single Windows executable.

    Result : You can call the tools similarly on all three platforms.

    bin/cat bin/perlpowertools cat packed/perlpowertools.exe cat packed/cat.exe

    The additional benefit is that I can complement my Windows toolbox with my own (Perl) scripts. For example, add ack! to perlpowertools.exe just by copying the singl e-file version to PerlPowerTools's bin directory and running the 'packer' script.

    Any feedback, beta-testing or else are welcomed.

    https://github.com/kal247/PerlPowerTools

Dynamic DNS for your GoDaddy domains
No replies — Read more | Post response
by stevieb
on May 17, 2022 at 14:26

    With its API, GoDaddy makes it easy to do dynamic DNS updates for your domain's hostnames. I made it easy to do with Perl with Net::DynDNS::GoDaddy (which uses my new Addr::MyIP to get your current external IP address). I'll give an example, then an example use of the distribution's packaged binary script.

    use Addr::MyIP; use Net::DynDNS::GoDaddy; my $hostname = 'home'; my $domain = 'example.com'; my $current_host_ip = host_ip_get($hostname, $domain); my $my_ip = myip(); if ($current_host_ip ne $my_ip) { host_ip_set($host, $domain, $my_ip); }

    Simple. The library requires a godaddy_api.json file in your home directory (MacOS, Unix or Windows, the software has 100% test coverage on all systems) that looks like this:

    { "api_key" : "api_key", "api_secret" : "api_secret" }

    Using the binary we'll install when you install the library, it will prompt you for this information on its initial run:

    > update-ip home example.com Please enter your GoDaddy API key and hit ENTER: ...api_key... Please enter your GoDaddy API secret and hit ENTER: ..api_secret... Updated record for 'home.example.com' from x.x.x.x to x.x.x.x

    ...after the initial run, it won't prompt anymore:

    > update-ip home example.com Not updating the 'home.example.com' record, IPs are the same

    You can specify the IP if you don't want to use your current public-facing one we automatically get for you:

    > update-ip home example.com 10.7.10.2

    The most useful use for me is to have multiple hostnames ('home', 'office', 'roaming' etc) and just run the program through cron:

    # Home storage server */15 * * * * update-ip home example.com >> /tmp/update-home_cron.log 2 +>&1

    My laptop:

    */15 * * * * update-ip roaming example.com >> /tmp/update-roaming_cron +.log 2>&1

    Usage:

    Usage: update-ip host domain.name [ip.addr]

    Have fun!

    -stevieb

IndexedFaceSet to 3D lines in two lines of PDL
1 direct reply — Read more / Contribute
by etj
on Apr 17, 2022 at 17:12
    I was digging through some bit-rotted PDL::Graphics::TriD stuff to finish/fix it, and looked at PDL::Graphics::TriD::Logo. It was intended to be used with the non-functional-right-now PDL VRML support, in particular VRML's IndexedFaceSet feature. It had 3D point coordinates, then triplets of indexes into those to describe triangles.

    Gripped - nay, seized - by a desire to see what the logo looked like, I needed to turn that into something the current TriD code can show me. I knew line3d could take a set of 4-point tuples to draw triangles if the 4th point was the same as the 1st. But how to turn points+indexes into that?

    I often say that in PDL, the "right" solution to problems involves slices and dimension-mangling. This was no exception!

    use PDL::Graphics::TriD; use PDL::Graphics::TriD::Logo; $p = $PDL::Graphics::TriD::Logo::POINTS; # dims: xyz, i $i = $PDL::Graphics::TriD::Logo::FACES; # dims: i1to3, ntriangles # 1: duplicate 0-th index onto end of each vector completing triangle $i = $i->append($i->slice('0')); # change to i1to3to1 # 2: flatten indices, slice points with those, restore 4-tuples shape $tri = $p->slice(':',$i->clump(-1))->splitdim(1,$i->dim(0)); line3d($tri); # visualise
    Coda: the logo is just "PDL" in a serif font, given "depth" as if in a stick of rock.

    I'm intending to update the VRML support to:

    1. generalise that plus the OpenGL support of each specific thing (lines, points, etc) to go via an intermediate description to make this easy;
    2. work at all;
    3. switch it to use X3D;
    4. use that to generate updated 3d demos for the PDL website.
    If anyone wants to help, please say so!
Running user-provided JavaScript code
2 direct replies — Read more / Contribute
by cavac
on Apr 11, 2022 at 11:31

    Sometimes you have to allow the end user to provide some (server side) program code, but you don't want them to allow system access. This could be anything, from custom formatting stuff, smart contracts, whatever. The solution is usually a sandbox. Now, Perl itself is a little to powerful and flexible to allow you to do that somewhat safely, but you can use something like the Duktape javascript engine.

    In our case, let's take a look at JavaScript::Duktape. One thing i wanted to implement is "simulated persistance", meaning the JavaScript would be coded as if it is kept in memory, yet the perl program can unload and load it whenever needed. For this, we will define a "memory" object, which the JavaScript can use to keep data in memory.

    Our Javascript program looks like this:

    function initMemory() { memory.counter = 0; } function incCounter(amount) { memory.counter = memory.counter + amount; } function printCounter() { log("Current count is " + memory.counter); }

    To test this, let's write a small test program that uses PageCamel::Helpers::JavaScript. Don't worry about the "PageCamel" part, it's just a helper function in my framework and i didn't have the time to pull it out into a standalone thing. It's pretty much self contained though, code included in this post. Because the PageCamel framework requires a ReportingHandler, for simplicity reasons out test program will just bring it's own.

    perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'
Making a reloadable module, allowing "live" edits
3 direct replies — Read more / Contribute
by pryrt
on Apr 09, 2022 at 18:44
    I was recently watching this youtube video on a simple PID controller implemented in Python (it was in a watchlist of math-related videos, though his PID was more math-adjacent than math-focused). But instead of focusing on the controller algorithm, I was intrigued by his demo environment, where he was able to update his python code live, and have the demo program automatically incorporate the changes immediately, without reloading the demo program.

    I followed his link to the repo for his demo, where he explains his reloadable.py module and how that portion works.

    "That should be doable in Perl," said I. "And I might even be able to do it." And indeed, after some effort, I could.

    He basically used a class variable to store the state of the module-under-development ("mod"), then used a loop in his demo program that every loop would check the timestamp on the mod's file, and if it was newer, he would store the state, then reload the mod and return a new instance of the mod object initialized to the stored state.

    In my example, which I will replicate in the spoiler, I did something similar, but I just stored the state in the instance of my reloadable object, and had the loop read the state from there and pass it as an option when creating the instance from the reloaded package. (My implementation isn't clean enough for CPAN or anything like that, but as toy, I thought it was a pretty cool usage of Perl, and is good enough for a proof-of-concept.)

    The funny thing is, a few days after I implemented it, as I was finishing up debug of something or other, where I was reloading my program quite frequently, I realized just as I was finishing up, "that would have been a perfect time to use Reloadoadable. DOH!".

    If this has piqued your interest, I would love to see, and learn from, how some of the other monks would implement this. You don't have to use the sine calculator as your example; I just thought it was a simple enough example for the proof of concept. If you wanted to do all the graphics to replicate his PID ship controller instead, by all means... ;-)

XPD - Do more with your PerlMonks XP
5 direct replies — Read more / Contribute
by cavac
on Apr 04, 2022 at 15:37

    As some of you know, i have been playing around with the PerlMonks API to create my own fake internet money. Basically, it's a way to play around with NFT without actually wasting money on that stuff.

    Presenting: XPD

    XPD is the Perlmonks XP Derivative. It's sort of fake monopoly money for PerlMonks. Currently, it supports sending XPD between registered accounts, creating NFT and selling them on the market for a fixed price.

    Edit: If you encounter a bug, post a reply to this post. I have fixed some bugs already, but there are probably more of them around.

    Here is the link: https://cav.ac

    FAQ:

    Is is real (crypto) currency?
    Nope. This is just a play thing for PerlMonks. Just as PM XP, it has no monetary value. But it's fun.

    Is it blockchain?
    Nope. Blockchains are slow and cumbersome. I use the age old model of central banking. E.g. it's a PostgreSQL database.

    Is it a crypto currency?
    Nope. I mean, i could add checksums and stuff, but what's the point? If you want to make sure i don't mess around, there is a public ledger will all transactions available. You could copy the data. It's currently a bit cumbersome, public API coming soon.

    How do i earn XPD. Mining? Proof of Work?
    Nope. XPD uses Proof of Monk.

    Proof of Monk?????
    XPD is linked to your account on PerlMonks. Be a nice person and help others on PM. This will earn you XP. And earned XP is added to your XPD account. Be naughty and loose XP, and XPD will be deducted.

    How do i register an account?
    Go to https://cav.ac/user/register. You will need a PM account with at least 500 XP, at least 30 posts and a XP-per-post average of at least 4. Fill in the form. Use a password you don't use anywhere else. If you have a password manager that can generate unique random passwords, use that. You username must match your PerlMonks username exactly, because that's how you earn XPD. For validation, you will also temporarily need to add a randomly generated text to your PM homenode.

    How often is generated XP added to my XPD account?
    It's currently set at 72 hour. But, on account creation all XP you already have is added to your XPD account within a minute or so.

    How long does it take to send XPD to another user?
    You select the username and amount, then click "Send". Then the backend checks if have the required funds in your account, does a database insert and it's done. Depending on the other workloads, takes a few seconds usually.

    How does NFT work?
    It's PNG files, 128x128 pixels. It costs 1 XPD to create one NFT.

    How long does it take to create an NFT?
    Similar to sending XPD to someone. You select the PNG file, fill in title and description and hit upload. Then the backend checks (asynchronously) if your file is valid and that you have the required 1 XPD in your account, does a database insert and it's done. Depending on the other workloads, takes a few seconds usually.

    Transaction fees?
    Huh? Why would i charge fees for doing a few database statements that take a few milliseconds. No, the only thing that "costs" a fee is NFT creation. Mostly because i want you lot not completely filling my ancient server with PNG files within the first 24 hours.

    API?
    Uhm, yes, coming soon. It's currently missing a few features, like the ability to not crash the server on every other call.

    Selling NFT via an auction?
    Not yet. The backend if half finished, should be online in a few days.

    Smart contracts? Scripting?
    That's in the late design phase. Pretty much anything you can do in the web interface, you will be able to do in the scripting engine. Plus some. You'll be able to buy and sell NFTs, send XPD to someone, bid on an auction, implement a piggy bank, run a Ponzi scheme(*), ...

    (*) It's not real money, XPD is a fun learning experience. If you know how to implement an automated Ponzi scheme, go for it.

    perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'
Shameless plug and QR japh
2 direct replies — Read more / Contribute
by bliako
on Mar 15, 2022 at 11:29

    My pride for Image::DecodeQR::WeChat I have just submitted on CPAN inspired
    this blitz-style QR japh. Lame as it may be, enjoy.

    Said module is my first to use XS and a significant milestone for
    me as I have managed finally to port OpenCV API into Perl.

    It's been adjusted for PM's rendering particularities and hopefully copy+pasting
    the text from the Download link will produce the correct output.
    Tested on a Linux unicode-enabled terminal. If there is no download link for below code
    then click on Download code below
    https://perlmonks.org/?node_id=11142119;displaytype=displaycode

    If anyone has suggestions on how to fix this monstrosity
    between code tags let me know
    (edit: pre tags shows the unicode but breaks other things).
    Apropos the QR-code below: ideally I would just use the black brick
    and a white space but unfortunately whatever i do the space gets shrinked
    i tried various unicode spaces but nothing worked, they all got shrinked
    below I am using a thin horizontal line as space which will most likely
    confuse the decoder.

    ██████████████▁▁▁▁▁▁██▁▁▁▁▁▁██████▁▁██████████████
    ██▁▁▁▁▁▁▁▁▁▁██▁▁██████▁▁▁▁▁▁▁▁████▁▁██▁▁▁▁▁▁▁▁▁▁██
    ██▁▁██████▁▁██▁▁██▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁██▁▁██████▁▁██
    ██▁▁██████▁▁██▁▁▁▁██▁▁▁▁██▁▁██▁▁▁▁▁▁██▁▁██████▁▁██
    ██▁▁██████▁▁██▁▁██████▁▁██▁▁██████▁▁██▁▁██████▁▁██
    ██▁▁▁▁▁▁▁▁▁▁██▁▁██▁▁██▁▁████████▁▁▁▁██▁▁▁▁▁▁▁▁▁▁██
    ██████████████▁▁██▁▁██▁▁██▁▁██▁▁██▁▁██████████████
    ▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁██▁▁████▁▁▁▁▁▁▁▁██▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁
    ████▁▁██▁▁▁▁████▁▁▁▁▁▁████████▁▁▁▁▁▁██████▁▁████▁▁
    ████▁▁██████▁▁██████▁▁██████▁▁▁▁██████▁▁▁▁██▁▁▁▁██
    ▁▁▁▁▁▁▁▁▁▁▁▁██████▁▁▁▁████████▁▁██▁▁▁▁████████████
    ▁▁▁▁▁▁▁▁██▁▁▁▁██████████████▁▁████▁▁▁▁▁▁██▁▁▁▁██▁▁
    ▁▁▁▁████▁▁████████▁▁████▁▁██▁▁▁▁████████▁▁██▁▁████
    ▁▁▁▁████████▁▁██▁▁██▁▁██▁▁▁▁▁▁▁▁▁▁██████▁▁▁▁██▁▁██
    ██▁▁██▁▁██▁▁██▁▁████▁▁██▁▁██▁▁▁▁██▁▁██████▁▁██▁▁██
    ▁▁██▁▁▁▁▁▁▁▁▁▁▁▁▁▁██████▁▁██████▁▁▁▁▁▁▁▁████▁▁████
    ████▁▁██▁▁████▁▁██▁▁██▁▁██▁▁▁▁▁▁██████████▁▁██▁▁▁▁
    ▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁▁██████▁▁██▁▁██▁▁██▁▁▁▁▁▁████▁▁▁▁▁▁
    ██████████████▁▁████▁▁████████▁▁██▁▁██▁▁██▁▁██████
    ██▁▁▁▁▁▁▁▁▁▁██▁▁▁▁████▁▁██▁▁██▁▁██▁▁▁▁▁▁██▁▁████▁▁
    ██▁▁██████▁▁██▁▁▁▁████▁▁██████▁▁██████████▁▁▁▁██▁▁
    ██▁▁██████▁▁██▁▁██▁▁▁▁██▁▁██▁▁██▁▁▁▁▁▁██████▁▁▁▁▁▁
    ██▁▁██████▁▁██▁▁▁▁▁▁▁▁▁▁████▁▁▁▁▁▁██▁▁▁▁████▁▁▁▁██
    ██▁▁▁▁▁▁▁▁▁▁██▁▁██▁▁▁▁██▁▁██▁▁████▁▁▁▁██▁▁▁▁▁▁▁▁▁▁
    ██████████████▁▁████▁▁▁▁▁▁██▁▁▁▁██▁▁▁▁██▁▁▁▁▁▁████

    here is the more readable japh (Above I am "shaping" perl script as a QR code):

    use Text::QRCode; use utf8; binmode(STDOUT, ':encoding(utf8)'); binmode(STDERR, ':encoding(utf8)'); my @a = map { [split//,$_] } split(" ", "anopheles cog, true archon of + junk"); print join "\n", map { y/* /\x{2588}\x{2591}/; $_ } map { join undef, map { $_.$_ } @$_ } @{Text::QRCode->new()->plo +t( join "", map { join("",@$_) =~ m([^^>>]*(.)(.)(.)[<<^^]?(oO(iouuuu))?) and join "", map { ($1+$3==4-$2) ? " " : (42%11-$2==$1+$3) ? uc : +lc } ($a[$2]->[$3]) } map { [m$[950618371>>!42!<<173861059]$g] } "45022250852010350010130232073310513122060312323150640053370 +0710353123331" =~ m$x?.y?.z?.[wrong]?$g )} ;

    bw, bliako

MCE::Channels 1.878 adds fast channel implementations
No replies — Read more | Post response
by marioroy
on Feb 21, 2022 at 08:02

    Greetings,

    MCE::Channels has been there for some time. But missing were fast implementations without involving serialization i.e. non-Unicode strings. For implementations that involve serialization, MCE::Channel uses Sereal::Encoder and Sereal::Decoder if available. Otherwise, defaults to Storable for handling serialization.

    How this came about is that someone wrote me and asked what does MCE provide for low-latency IPC communication. I replied nothing because involving serialization. So I took the existing implementations and removed the bits involving serialization, added Fast suffix to the name, and added corresponding test files.

    I have been wanting to compare them all. Folks are not likely to notice a difference between a second or two for a long running application.

    Below, channel implementations Threads and Mutex involve locking and serialization. ThreadsFast and MutexFast are similar but without serialization i.e. non-Unicode strings only. The Simple implementations lack locking supporting one worker on either end of the channel.

    Threads

    use strict; use warnings; use threads; use MCE::Channel; #my $chnl = MCE::Channel->new(impl => "ThreadsFast"); # 1.734s none #my $chnl = MCE::Channel->new(impl => "Threads"); # 2.247s Sereal # 3.232s Storab +le my $chnl = MCE::Channel->new(impl => "SimpleFast"); # 0.965s none #my $chnl = MCE::Channel->new(impl => "Simple"); # 1.940s Sereal # 3.305s Storab +le my $size = 1_000_000; my $thrd = threads->create(sub { my $ret; $ret = $chnl->recv() for 1..$size; }); $chnl->send("this is something $_") for 1..$size; $thrd->join();

    Child process

    use strict; use warnings; use MCE::Child; use MCE::Channel; #my $chnl = MCE::Channel->new(impl => "MutexFast"); # 3.552s none #my $chnl = MCE::Channel->new(impl => "Mutex"); # 4.025s Sereal # 4.815s Storab +le my $chnl = MCE::Channel->new(impl => "SimpleFast"); # 0.949s none #my $chnl = MCE::Channel->new(impl => "Simple"); # 1.644s Sereal # 3.286s Storab +le my $size = 1_000_000; my $proc = MCE::Child->create(sub { my $ret; $ret = $chnl->recv() for 1..$size; }); $chnl->send("this is something $_") for 1..$size; $proc->join();

    Pretty much everything in MCE involves serialization. That is numbers remain numbers and not converted to a string. Likewise, Unicode strings and data structures are preserved as well. The fast channel implementations fill a void when serialization is not required.

    Okay, this is nothing major. But I needed to let folks know.

Hex numbers (e.g. memory addresses) pseudonymising for comparable logging output
3 direct replies — Read more / Contribute
by etj
on Feb 18, 2022 at 07:23
    PDL has a debug mode which tells you in some detail what it's doing, including giving memory addresses (the joy of working in C). I'm currently tracking down the underlying cause of https://github.com/PDLPorters/pdl/issues/356, and have narrowed it down to a small repro case where a command-line switch makes it either croak, or not. Either mode produces several hundred lines of debug output. Diffing the two cases is useless because the addresses get randomised by https://en.wikipedia.org/wiki/Address_space_layout_randomization. If only there were a tool that could consistently pseudonymise those addresses so they get replaced by ADDR1 for the first one, etc, for easier diffing.

    Perl to the rescue!

    #!/usr/bin/env perl # address-pseudonymise [file] or read STDIN use strict; use warnings; my (%addr2number, $i); while (<>) { s:^==\d+==:==[PID]==:; # if you used valgrind, replace process ID s:0x([0-9a-f]+): '[ADDR'.($addr2number{$1} //= ++$i).']' :gie; print; }
A Word Game (Update 3)
6 direct replies — Read more / Contribute
by jwkrahn
on Feb 09, 2022 at 00:09

    Yes I play this game every day on the web. I just wanted to see if I could do it.

    There are probably still bugs!

    Tested with xterm on Debian.

    If this is a copyright violation please remove it.

    Update

    I think I've fixed the bugs pointed out by toolic. Let me know if you find any more.

    Update number 2

    I think that this now works correctly, but if you find any bugs please let me know. TIA

    Update number 3

    Thanks to toolic and wazoox for helping to find bugs. I hope that this fix is the last.     :)

    #!/usr/bin/perl use warnings; use strict; use Term::ANSIColor ':constants'; my $clear = `clear`; my $reset = RESET; my $white_on_red = BRIGHT_WHITE . ON_RED; my $white_on_green = BRIGHT_WHITE . ON_GREEN; my $white_on_yellow = BRIGHT_WHITE . ON_YELLOW; my $white_on_gray = BRIGHT_WHITE . ON_BRIGHT_BLACK; my $divider = " --- --- --- --- ---\n"; my $kb = <<KB; Q W E R T Y U I O P A S D F G H J K L Z X C V B N M KB my @lines = ( [ ( ' ' ) x 5 ], [ ( ' ' ) x 5 ], [ ( ' ' ) x 5 ], [ ( ' ' ) x 5 ], [ ( ' ' ) x 5 ], [ ( ' ' ) x 5 ], ); my $curr_line = 0; my %dict; { open my $FH, '<', '/usr/share/dict/words' or die "Cannot open '/us +r/share/dict/words' because: $!"; @dict{ map uc, grep /[aeiou]|.y./, map /^([a-z]{5})$/, <$FH> } = ( +); } my $curr_word = ( keys %dict )[ rand keys %dict ]; { local $| = 1; print $clear, " ${white_on_gray}Letter not used.$reset\n", " ${white_on_yellow}Letter is used.$reset\n", " ${white_on_green}Letter in correct place.$reset\n", " ${white_on_red}Not a valid word.$reset\n", "\n", map( { my $line = $_; $divider, ' ', map( " |$_|", @{ $lines[ +$line ] } ), "\n", $divider } 0 .. $#lines ), "\n\n", $kb, "\n"; if ( $curr_line == @lines ) { #print "\L$curr_word\n"; last; } print 'Enter five letter word: '; my ( $word ) = map uc, <STDIN> =~ /^([a-zA-Z]{5})/; my @letters = split //, $word; @letters == 5 or redo; # Not a valid five letter word unless ( exists $dict{ $word } ) { $lines[ $curr_line ] = [ map "$white_on_red $_ $reset", @lette +rs ]; redo; } # The correct answer if ( $word eq $curr_word ) { $lines[ $curr_line ] = [ map "$white_on_green $_ $reset", @let +ters ]; for my $letter ( @letters ) { $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_ +on_green $letter $reset/; } $curr_line = @lines; redo; } # Default; all letters to white on gray $lines[ $curr_line ] = [ map "$white_on_gray $_ $reset", @letters +]; for my $letter ( @letters ) { $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_on_g +ray $letter $reset/; } # Find exact matches my @found = ( 0 ) x 5; my $xor_word = $word ^ $curr_word; while ( $xor_word =~ /\0/g ) { $found[ $-[ 0 ] ] = 1; my $letter = $letters[ $-[ 0 ] ]; $lines[ $curr_line ][ $-[ 0 ] ] = "$white_on_green $letter $re +set"; $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_on_g +reen $letter $reset/; } my $curr_remains = join '', ( split //, $curr_word )[ grep !$found +[ $_ ], 0 .. $#found ]; # Find other correct letters for my $index ( 0 .. $#letters ) { next if $found[ $index ]; my $letter = $letters[ $index ]; if ( $curr_remains =~ s/$letter/ / ) { $lines[ $curr_line ][ $index ] = "$white_on_yellow $letter + $reset"; $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_ +on_yellow $letter $reset/; } } ++$curr_line; redo; }
Perl Tk Amateur Radio Contest Duplicate Contact Checker
1 direct reply — Read more / Contribute
by jmlynesjr
on Feb 03, 2022 at 20:48

    Yet another Perl Tk example

    I recently worked the Amateur Radio Winter Field Day Contest. In these contests, a station may only be worked for credit once per band (and mode if you want to get picky). This requires that some method of duplicate checking be used. As a low power station, 50 contacts over a weekend would be an accomplishment. I log on paper(and later enter the contacts into my Perl based logging program for upload to QRZ.COM and LoTW) so up to a page of contacts can be visually dupe checked. Over a page it gets tedious.

    So, after the contest, I thought about what I could do to be better prepared for the next contest.

    I have played with wxPerl in the past but I've never used Tk. So why not try building a Tk application? Posted below is the result. It's somewhat brut force, and I need to explore frames and -pack options in the future. Performance is good to at least 100 entries.

    (Aside: I am aware of using a hash for duplicate checking, but I decided to go a different route.)

    James

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


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":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (1)
As of 2022-07-07 04:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?