Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

The Monastery Gates

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

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

poll ideas quest 2020
Starts at: Jan 01, 2020 at 00:00
Ends at: Dec 31, 2020 at 23:59
Current Status: Active
5 replies by pollsters
    First, read How do I create a Poll?. Then suggest your poll here. Complete ideas are more likely to be used.

    Note that links may be used in choices but not in the title.

Where is documenation for defining servers for use by Rex?
3 direct replies — Read more / Contribute
by nysus
on Apr 07, 2020 at 17:24

    I'm having trouble locating documentation that explains how to set up servers for use in Rex scripts. Can someone please point me in the right direction? Thanks.

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest Vicar";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Override new in Moose for flyweight objects
2 direct replies — Read more / Contribute
by Aaronrp
on Apr 07, 2020 at 14:15

    I've found the module MooseX::Role::Flyweight a useful one for keeping a cache of objects, but I've never been happy with the way it requires you to use Class->instance(y => 'x') instead of Class->new(y => 'x') to get the new object. What if I change my mind about caching, or want to debug the code without the cache? Then I have to find all the calls in all my code and change them. What if I miss one, and call new from outside the class? So much for the cache.

    I came up with this alternative approach, which seems to work. It overrides Moose's new method but still inlines the constructor.

    package TestNew 0.001; use Moose; has thingy => ( required => 1, is => 'ro', ); my %obj_cache; override 'new' => sub { my ( $class, @args ) = @_; my $params = $class->BUILDARGS(@args); # from Moose::Object my $thingy = $params->{thingy}; my $cachekey = $thingy; if ( exists $obj_cache{$cachekey} ) { return $obj_cache{$cachekey}; } return $obj_cache{$thingy} = $class->_new( thingy => $thingy ); }; *Moose::Object::_new = \&Moose::Object::new; __PACKAGE__->meta->make_immutable( constructor_name => '_new' ); 1;

    Other than the unfortunate need to mess around inside the Moose::Object namespace, I don't see any huge downsides, but I must admit I don't really know what I'm looking at when I poke around inside Class::MOP::Class and was wondering if others had thoughts.


Parsing Emacs Lisp sexpr?
3 direct replies — Read more / Contribute
by perlancar
on Apr 07, 2020 at 13:41
    Wondering if there's something on CPAN or elsewhere which can parse the contents of into a reasonable Perl representation? I think Data::SExpression chokes on bracket character and that module seems to be pretty much what CPAN has to offer for something relating to parsing S-expression. I guess whipping up a new parser is not hard...
Connecting to remove server with Rex using .pem file
1 direct reply — Read more / Contribute
by nysus
on Apr 07, 2020 at 10:25

    I'm stumped trying to figure out how to use Rex to log into a remote server. The server provides me with a .pem file. I have successfully used this file to log in manually using ssh -i PEM_FILE_NAME blah@

    I tried converting it to public key with ssh-keygen -y -f PEM_FILE_NAME > public.key and have the following in my RexFile:

    Rex::connect( server => '', user => 'my_user_name', public_key => '/home/my_user_name/public.key', );

    But this isn't working. Not sure what else to try. Thanks.

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate Priest Vicar";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Lost in compressed encodings
4 direct replies — Read more / Contribute
by Skeeve
on Apr 06, 2020 at 04:22

    This is a follow up of my Lost in encodings question.

    Thanks to the answers given there I was able to solve that issue, but now I'm clueless again as I now need to read in compressed (gzip) UTF-8 files and I do not know how to convince perl to read them as UTF-8.

    My code for opening the files is:

    open my $in, '<:utf8', $filename or die "Can't read $filename: $!\ +n"; if ($filename=~/\.gz$/) { $in= new IO::Uncompress::Gunzip $in, { AutoClose => 1 }; }

    When reading uncompressed data, it works fine as I could verify with the help given in my previous thread. I did so by setting the debugger to UTF-8. When reading uncompressed data the Umlaut "ü" is correctly displayed as "ü". When reading the same data from a compressed file the "ü" is displayed as "ü".

    I have no idea how to make perl consider the compressed data as UTF-8?

Regex to Array lookup question
4 direct replies — Read more / Contribute
by johnfl68
on Apr 05, 2020 at 17:23


    Looking for a suggestion of a better way to do this, instead of doing about 30 regex's in a row.

    I have NWS API data for icons that references their long list of a wide array of icons with extra data that I do not need.,20/tsra_sct,40?size=me +dium,30/tsra_hi,30?size +=medium,30/rain_showers? +size=medium",

    All I really need is the modifier (tsra, rain, sleet, bkn, skc, few, ovc, etc). I don't really need anything else. Because the format somewhat changes with each response, it's a bit hard to regex down to just the modifier, as some times there are 2, and no established list of all the possibilities. At this point I figure possibly use just the first modifier listed. I am going to try and regex it down to just the modifier and see how that works, but I am afraid they will through a wrench in the works at some point that will trip up that regex.

    Instead of doing a separate regex for each modifier, is there a way to use an array with a single regex to do a look up table to get the new icon reference? Or another way to see if any modifier is anywhere in the string, then return referenced new icon name?

    { 'skc' => "clear-day", 'few' => "partly-cloudy-day", 'sct' => "partly-cloudy-day", 'bkn' => "cloudy", 'wind' => "wind" }

    Any suggestions would be appreciated. Once pointed in the right direction, usually I can figure the rest out. I just can't think of a better way to do this. Too many things on my mind as well, like many others right now. Thanks you!

Niche programming
5 direct replies — Read more / Contribute
by maurocavendish
on Apr 05, 2020 at 11:31

    Hi, fellow monks!

    I'm a returning Perl programmer, stuck in a vortex of bad management and poor quality code at my regular job in modern IT sweatshops in Italy.

    At the start of my career, I worked few years doing software/hardware monitoring in Perl, and I loved it. I am a self-taught 42-years-old programmer, with no CS/maths education. I'd like to take some time to explore my possibilities in my spare time, for fun and growth. A lot of the sexier technologies are out of my reach, because I cannot afford years of mentally and financially taxing college level studies. Also, I have a very practical mindset, more keen on simple, concise solutions to well-defined problems. I'm thinking on the lines of things like Domain Specific Languages, APIs, focused libraries.

    Could you provide some insights into niche but deep domains I can tackle with Perl, without having to resort to learn advanced college stuff or crazy architectural patterns? I'm aware I can do couple Web projects, but it would feel like being at work again, and I've also become weary of Web Development/CRUD apps/Scrum gimmicks/you name it. I'd love to find concrete domains that I can tackle with a somewhat scripting mindset for my leisure and enrichment in the next couple years. I hope I make sense, and I wait to be enlightened by your comments!
COVID-19 data analytics, cryptography, and some things you should know
5 direct replies — Read more / Contribute
by tachyon-II
on Apr 04, 2020 at 21:15

    Hi All,

    It's been a decade or so but my love of Perl continues.

    The background of the Why? for this question can be found at which I recommend you read, particularly if you take any medication. It might just save your life.

    The data collection tool to which it applies can be found at We are gathering this data because the US, Chinese and Canadian CDC's are not and when the Italians partially gathered this medication data it showed 73% of all COVID-19 deaths occurred in the ~3% of people taking two specific classes of medication. The Turkish data release a few days later found similarly - 68.8% of deaths occurred in this really small group.

    The problem to be solved is the safe, deidentified release of IP addresses and Browser strings to fulfil the requirements of HIPAA, GDPR and CCPA. We simply do not gather any other PII (personally identifiable information) so it is impossible for this to leak. Age range, sex, disease severity and outcome and medications are the other data points.

    These 2 identifiers will assist researchers in assessing if the crowdsourced data we are gathering is "gamed" or "believable". We have taken steps to make automated submission difficult, but as we hackers know, virtually nothing is impossible if you really put your mind to it...

    So the task to hand is to convert an IP and Browser String into a cryptographically secure hash that can not be reversed or revealed with a rainbow table. IP addresses and Browser strings both exist in a small finite search space.

    Given this data will be released publicly and is timestamped it is trivial for an attacker to correlate a known IP address and Browser string to these hashes. Given the secret packing data I don't believe this would allow any quantity of computational power to elucidate the packing data and thus create a lookup table, but if that is incorrect I would be good to know now and fix it before our impending first data release.

    While I am expert in the field of medicine my knowledge of crypto and how you attack it is less. SHA3 was chosen for its resistance to length extension attacks and the packing data size to give enough random data for the resultant hash to spread evenly across that space. Maybe that's good enough, maybe it can/should/must be done better.

    Here is a draft version of those hashing functions. Expert commentary appreciated, particularly from cryptographers.

    #!/usr/bin/env perl package SHA3; use strict; use warnings; use Digest::SHA3 qw(sha3_256_hex); use Digest::MD5 qw(md5_hex); use Socket qw( inet_pton AF_INET AF_INET6 ); my @packing = qw( fa13a941b76466850c2558d9ae5d969f e71ab0d8bb54c75b37ad23a449050121 6736564ec6bc9bbc8ba42df565317443 c3e088a5cf247ec0df971c5cb9ee6eec 6cf20d548878cdd82b8f207192f58c80 660a311b8d75d5fb28c73f7e2ec5d25e 377f92899b81ad7c5e1d08b81ccc8904 8e1f27dee8ae3374ae5c462adf37bba5 ccd558ff6b9de48ca22023ead2dbd7a2 ff228ef28ae8544155323180ba070d1b ); print SHA3::sha3_ip(''), "\n"; print SHA3::sha3_ip(''), "\n"; print SHA3::sha3_ip('2001:0db8:0000:0000:0000:8a2e:0370:7334'), "\n"; print SHA3::sha3_ip('2001:0db8:0000:0000:0000:8a2e:0370:7335'), "\n"; print SHA3::sha3_bs('Mozilla'), "\n"; print SHA3::sha3_bs('Win32'), "\n"; =head 2 sha3_ip { Expects a dot quad or an IPv6 address and returns a SHA3_256_hex string or null string for invalid input =cut sub sha3_ip { my $ip = shift; my $pack_format; if ( $ip =~ m/^\d+\.\d+\.\d+\.\d+$/ ) { my $bytes = pack("H32 a4 H32", $packing[0], inet_pton( AF_INET +, $ip ), $packing[7]); my $hash = sha3_256_hex($bytes); return $hash; } elsif ( $ip =~ /^([0-9a-f]{0,4}:){0,7}([0-9a-f]{0,4})$/i ) { my $bytes = pack("H32 a16 H32", $packing[0], inet_pton( AF_INE +T6, $ip ), $packing[7]); my $hash = sha3_256_hex($bytes); return $hash; } warn "Invalid IP:$ip\n"; return ''; } =head 2 sha3_bs { Expects a browser string and returns a SHA3_256_hex string or a null string for invalid input =cut sub sha3_bs { my $bs = shift; unless (length $bs > 4 ) { warn "Insufficient data in browser string $bs"; return ''; } my $bytes = pack("H32 H32 H32", $packing[1], md5_hex($bs), $packin +g[8]); my $hash = sha3_256_hex($bytes); return $hash; }
pre-texted <STDIN>
5 direct replies — Read more / Contribute
by ShainEdge
on Apr 04, 2020 at 06:18
    I'm trying to make a simple perl based notebook (for my own learning experience). Other then Adding new notes, and Deleting them, I would like to edit current notes.

    Is there a way to insert a note text into the <STDIN> block, as if the person had typed it in, so that it can be edited before (entering) the new edit of the note?

    So, for example:
    The note "grocery list" already has "milk, butter, bread and eggs" stored.

    Choosing the "E)dit note" and selecting the "grocery list" would print out the stored text in an editable format so that the user can make a change such as move to add ", peanut butter" after "bread" then enter the new text as the edited note.

    It might be easier in Perl/Tk, but I was wondering if there is a solution in a command line version.
AnyEvent tcp_server not working
2 direct replies — Read more / Contribute
by navalned
on Apr 03, 2020 at 17:34
    I have the following code that I believe should function as an echo server.
    #!/usr/bin/env perl use strict ; use warnings ; use AnyEvent ; use AnyEvent::Handle ; use AnyEvent::Socket ; my $main = AnyEvent->condvar(); tcp_server undef, undef, sub { my ($fh, $host, $port) = @_; my $handle; $handle = AnyEvent::Handle->new( fh => $fh, on_error => sub { my ($hdl, $fatal, $msg) = @_; AE::log error => $msg; $hdl->destroy(); }, on_eof => sub { my ($hdl) = @_; $hdl->destroy(); }, on_read => sub { my ($hdl) = @_; $hdl->push_read(line => sub { my ($hdl, $line) = @_; if ($line =~ m/quit/i) { $hdl->push_write("goodbye\n"); $hdl->destroy(); } $hdl->push_write($line); }); } ); $handle->push_write("Hello $host:$port\n"); }, sub { my ($fh, $thishost, $thisport) = @_; print STDERR "$thishost:$thisport\n"; }; $main->recv();
    However, when I netcat into the server. I see the greeting and the server immediately closes the connection. I'm probably missing something simple, but not sure what. Thanks!
DateTime issues
2 direct replies — Read more / Contribute
by htmanning
on Apr 03, 2020 at 16:49
    Monks, I'm using the following to check for things happening one year from now and one week from now.
    use DateTime::Duration (); my $one_year_from_now = $now->add( years=>1 ); if ($reservation_date > $one_year_from_now) { do something } and then use DateTime::Duration (); my $one_week_from_now = $now->add( weeks=>1 ); if ($reservation_date > $one_week_from_now) { do something }
    If the one year from now routine happens before the one week from now routine, it cancels out the one week from now routine. It is as if it is resetting NOW and I don't understand why.
Perl/Tk and exit(0)
4 direct replies — Read more / Contribute
by saw55
on Apr 02, 2020 at 18:55

    I have a several hundred line Perl/Tk program with a subroutine (timedDialog) that opens a window with a message such as “starting backup”, “creating tar file”, “finished”, etc. and then the window closes after a few seconds. This all works fine, but when I try to use this sub to display an “exiting” message after the user hits a cancel button the script exits before the message displays. This seems to be because of the “exit(0)” statement immediately following it—I tried putting “sleep 5” in between, but that didn’t help.

    The following demonstrates my problem. If the exit statement in sub checkDays is commented out the message is displayed, if it is uncommented you never see the message. Can someone please tell me what I am doing wrong?

    #!/usr/bin/perl ###################################################################### +## use strict; use warnings; use Tk; my $mw = MainWindow -> new; my $timedDialogTitle = ''; my $timedDialogText = ''; my $svBtn = undef; #Option window SAVE button. &setupGUI; $mw->deiconify(); $mw->raise(); MainLoop; exit(0); ################################################ ################################################ sub setupGUI{ $timedDialogTitle = "STARTING BACKUP"; $timedDialogText = "Backing up files..."; $svBtn = $mw->Button( -text => "SAVE", -command => sub {&checkDays +; &timedDialog($timedDialogTitle, $timedDialogText, 5_000);}); $svBtn->grid(-row => 9, -column => 2, -sticky => 'e'); $mw->bind('<KeyPress-Return>' => sub {&checkDays; &timedDialog($ti +medDialogTitle, $timedDialogText, 5_000);}); $mw-> withdraw(); } ##################################### sub checkDays { &timedDialog("Exiting", "O.K., no backup will be made, + then....Exiting", 5_000); exit(0); } ##################################### sub timedDialog { my $subwindow = MainWindow->new; $subwindow->geometry("490x150+400+400"); $subwindow->title($_[0]); my $label = $subwindow->Label(-text => $_[1]); $label->pack; $subwindow->after($_[2], sub {$subwindow->destroy;}); } #####################################
Optimizing with Caching vs. Parallelizing (MCE::Map)
5 direct replies — Read more / Contribute
by 1nickt
on Apr 05, 2020 at 11:17

    Mon cher ami Laurent_R recently blogged about his solution to the "extra credit" problem in the Perl Weekly Challenge #54. He showed a solution using memoizing, or caching, to reduce the number of repeated calculations made by a program.

    I wondered about the strategy. Obviously calculating the sequences for numbers up to 1,000,000 without some optimization would be painfully or maybe unworkably slow. But the task looks computation-intensive, so I wanted to see whether more cycles would be more beneficial than caching.

    Here is the solution presented by Laurent:

    This runs on my system pretty quickly:

    real 0m22.596s user 0m21.530s sys 0m1.045s

    Next I ran the following version using mce_map_s from MCE::Map. mce_map_s is an implementation of the parallelized map functionality provided by MCE::Map, optimized for sequences. Each worker is handed only the beginning and end of the chunk of the sequence it will process, and workers communicate amongst themselves to keep track of the overall task. When using mce_map_s, pass only the beginning and end of the sequence to process (also, optionally, the step interval and format).

    use strict; use warnings; use feature 'say'; use Data::Dumper; use MCE::Map; my @output = mce_map_s { my $input = $_; my $n = $input; my @result = $input; while ( $n != 1 ) { $n = $n % 2 ? 3 * $n + 1 : $n / 2; push @result, $n; } return [ $input, scalar @result ]; } 1, 1000000; MCE::Map->finish; @output = sort { $b->[1] <=> $a->[1] } @output; say sprintf('%s : length %s', $_->[0], $_->[1]) for @output[0..19];

    This program, with no caching, runs on my system about five times faster (I have a total of 12 cores):

    real 0m4.322s user 0m27.992s sys 0m0.170s

    Notably, reducing the number of workers to just two still ran the program in less than half the time than Laurent's single-process memoized version. Even running with one process, with no cache, was faster. This is no doubt due to the fact MCE uses chunking by default. Even with one worker the list of one million numbers was split by MCE into chunks of 8,000.

    Next, I implemented Laurent's cache strategy, but using MCE::Shared::Hash. I wasn't really surprised that the program then ran much slower than either previous version. The reason, of course, is that this task pretty much only makes use of the CPU, so while throwing more cycles at it it a huge boost, sharing data among the workers - precisely because the task is almost 100% CPU-bound - only slows them down. Modern CPUs are very fast at crunching numbers.

    I was curious about how busy the cache was in this case, so I wrapped the calls to assign to and read from the hash in Laurent's program in a sub so I could count them. The wrappers look like:

    my %cache; my $sets = my $gets = 0; sub cache_has { $gets++; exists $cache{$_[0]} } sub cache_set { $sets++; $cache{$_[0]} = $_[1] } sub cache_get { $gets++; $cache{$_[0]} }

    The result:

    Sets: 659,948 Gets: 16,261,635
    That's a lot of back and forth.

    So the moral of the story is that while caching is often useful when you are going to make the same calculations over and over, sometimes the cost of the caching exceeds the cost of just making the calculations repeatedly.

    Hope this is of interest!

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 perusing the Monastery: (3)
As of 2020-04-09 04:06 GMT
Find Nodes?
    Voting Booth?
    The most amusing oxymoron is:

    Results (47 votes). Check out past polls.