Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask

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.

New Questions
Resque worker reserve() finds no jobs
1 direct reply — Read more / Contribute
by 1nickt
on Nov 14, 2018 at 08:32

    Update: The issue turned out to be a failure in mocking, not a problem per se with Resque. I am mocking Redis (the back end) with Test::Mock::Redis, but somehow Resque is using an unmocked Redis instance for the pop() call (well, the lpop() call on Redis) even though it is using the mocked instance for all the other calls including the peek(). I think the cause is something to do with Moo/Moose inheritance and load order, ie my mocking is happening too late. Odd since I don;t believe I am instantiating the Resque object until after Redis is mocked, but anyhow I am ~ 23.75 hours over the don't-be-stuck-for-more-than-15-minutes rule, so I gave up and now am popping the job off the queue by accessing low-level Redis calls. If I ever figure it out I'll post back here.

    Hi all, any Resque users out there? I am using Resque at $work for a job queue and it's mostly working as expected. But I've run into a problem when trying to manually pop a job and process it. The documented way to do that is to use the worker object's reserve() method to get the job, and then process it with work_tick(). But it's not working: no jobs are found. This is really odd since the queue has jobs. I hacked the source for Resque::Worker::reserve() as follows:

    sub reserve { my $self = shift; my $count = 0; warn "RESERVING"; for my $queue ( @{$self->queues} ) { warn "QUEUE $queue"; use Data::Dumper; warn "JOBS " . Dumper [ map { $_->{payload} } $self->resque->p +eek($queue) ]; if ( my $job = $self->resque->pop($queue) ) { warn "JOB $job"; return $job; } warn "NO JOBS!!!"; return if ++$count == @{$self->queues}; } }
    ... and it outputs the jobs from peek() as expected, but does not find any jobs with pop()!
    RESERVING at /.../.perlbrew/libs/perl-5.26.1@dev/lib/perl5/Resque/Work line 175. QUEUE account_provisioning at /.../.perlbrew/libs/perl-5.26.1@dev/lib/ +perl5/Resque/ line 177. JOBS $VAR1 = [ { 'args' => [ ... ], 'start_time' => 1542202068, 'class' => ..., } ]; NO JOBS!!! at /.../.perlbrew/libs/perl-5.26.1@dev/lib/perl5/Resque/Wor line 184.

    Any clues will be gratefully received. Thanks!

    The way forward always starts with a minimal test.
DynaLoader can't resolve multiple Linux shared objects
2 direct replies — Read more / Contribute
by boleary
on Nov 14, 2018 at 08:29

    I have created a module built with SWIG. references 2 other shared objects and which I am including in the auto/LicenseInterface directory.

    I cannot get it to load properly for my end application where I am trying to use ActiveState PerlApp to distribute the code as a pre-packaged Linux .exe file (but it works fine in Windows)

    use strict; use warnings; push @INC,"lib"; require LicenseInterface; print "LicenseInterface got loaded\n";

    Here is the lib directory structure |--lib\ | |--auto\ |--LicenseInterface\ | (added this to try to influence @dl_resolv +e_using) | | |

    Here is the ldd report for the shared objects (without LD_LIBRARY_PATH set)

    [boleary@new-host testLib]$ ldd auto/LicenseInterface/LicenseInterface => (0x00f36000) => not found ****This is the .so that dynaload +er can't resolve*** => not found ###BUT THIS ONE gets resolved!!! => /usr/lib/ (0x00508000) => /lib/ (0x00331000) => /lib/ (0x00ac4000) /lib/ (0x002c3000) => /lib/ (0x00ed9000) [boleary@new-host testLib]$ ldd auto/LicenseInterface/libLicIntfcLib.s +o => (0x0025c000) => not found ****This is the other .so that dynaload +er can't resolve*** => /usr/lib/ (0x00682000) => /lib/ (0x00ce7000) => /lib/ (0x00d40000) /lib/ (0x002c3000) => /lib/ (0x00143000)

    When I use or require, the DynaLoader bootstrap code cannot resolve the (and the (I set PERL_DL_DEBUG to 1 before running to get more info) loaded (/opt/ActivePerl-5.18/site/lib /opt/ActivePerl-5. +18/lib . lib, /lib /usr/lib /usr/local/lib) DynaLoader::bootstrap for LicenseInterface (auto/LicenseInterface/Lice Can't load './auto/LicenseInterface/' for module Li +censeInterface: cannot open shared object file: No + such file or directory at /opt/ActivePerl-5.18/lib/ lin +e 191.

    I can easily fix the problem if I add the hard path: "auto/LicenseInterface" to the LD_LIBRARY_PATH in the env I am running perl from

    export LD_LIBRARY_PATH=./auto/LicenseInterface [boleary@new-host testLib]$ perl loaded (/opt/ActivePerl-5.18/site/lib /opt/ActivePerl-5. +18/lib . lib, /lib /usr/lib /usr/local/lib ./auto/LicenseInterface) DynaLoader::bootstrap for LicenseInterface (auto/LicenseInterface/Lice LicenseInterface got loaded

    The trouble with this is that I am using perlapp from ActiveState to try and build and distribute a working .exe file, and I do not have any control over LD_LIBRARY_PATH in that case (and I know that perlApp is no longer supported)

    On a windows system, (where I started this adventure) DynaLoader has no trouble resolving the referenced sharedObjects with LicenseInterface.dll, libLicIntfcLib.dll and llibmgr11.dll and the perlApp .exe file works perectly

    I tried a couple of tricks.. Firt I tried to the ./auto/LicenseInterface to the LD_LIBRARY_PATH inside

    BEGIN { $ENV{LD_LIBRARY_PATH}.="./auto/LicenseInterface"; } use strict; use warnings; push @INC,"lib"; require LicenseInterface; print "LicenseInterface got loaded\n"; exit
    perl loaded (/opt/ActivePerl-5.18/site/lib /opt/ActivePerl-5. +18/lib . lib, /lib /usr/lib /usr/local/lib ./auto/LicenseInterface) DynaLoader::bootstrap for LicenseInterface (auto/LicenseInterface/Lice Can't load './auto/LicenseInterface/' for module Li +censeInterface: cannot open shared object file: No + such file or directory at /opt/ActivePerl-5.18/lib/ lin +e 191. at lib/ line 11. Compilation failed in require at line 8.

    Here you can see that it added ./auto/LicenseInterface to the search path and that status line starting with " loaded (" looks identical to the passing case above, but It still won't load it

    Then I tried adding a file in the ./auto/LicenseInterface directory

    push @dl_resolve_using=dl_findfile( qw( ./auto/LicenseInterface/ ./auto/LicenseInterface/ ) );
    perl loaded (/opt/ActivePerl-5.18/site/lib /opt/ActivePerl-5. +18/lib . lib, /lib /usr/lib /usr/local/lib ./auto/LicenseInterface) DynaLoader::bootstrap for LicenseInterface (auto/LicenseInterface/Lice BS: ./auto/LicenseInterface/ (linux, dl_dlopen.xs) dl_findfile(./auto/LicenseInterface/ ./auto/LicenseIn +terface/ dl_findfile found: ./auto/LicenseInterface/ ./auto/Li +censeInterface/ Can't load './auto/LicenseInterface/' for module Li +censeInterface: cannot open shared object file: No + such file or directory at /opt/ActivePerl-5.18/lib/ lin +e 191. at lib/ line 11. Compilation failed in require at line 8.

    You can see that it actually found the other shared objects, but it still couldn't use them

    It seems that DynaLoader cannot take advantage of the fact that I set LD_LIBRARY_PATH, so when it does its magic it must be limited to using the environment variables from the shell that started it. It is interesting to me that it can resolve the

    Does anyone have any ideas? Are there any known linux modules that are provided with multiple .so files that have worked around this before?

    I can try to create one .so, with the other 2 .so libraries statically linked, but I am having trouble because I don't have total control over the llibmgr11 source.

chr() function
2 direct replies — Read more / Contribute
by catfish1116
on Nov 13, 2018 at 16:51

    I'm trying to figure out the chr() function, and have written a few lines of code:

    #!/usr/bin/perl use v5.12; use warnings; $alpha = chr(65); say "This is what Alpha looks like $alpha". "\n";

    And I'm getting this error

    Global symbol "$alpha" requires explicit package name at ./Page_34 li +ne 5. Global symbol "$alpha" requires explicit package name at ./Page_34 lin +e 6.

    What package is it looking for? TIA catfish

Translate curl to LWP
2 direct replies — Read more / Contribute
by Anonymous Monk
on Nov 13, 2018 at 09:04

    Can you help me translate this Curl command to LWP::UserAgent syntax?

    curl -X POST \ -u "apikey:xxx" \ --header "Content-Type: audio/flac" \ --data-binary @{path_to_file}audio-file.flac \ " +"

    The following doesn't work (obviously, as I do not know - as you can see - how to formulate a similar request with LWP

    my $url=" +ecognize"; my $apikey="xxx"; open($fh, "<", "audio-file.flac") or die "Can't read file: $!"; my $audio = do { local $/; <$fh> }; close($fh); $ua = LWP::UserAgent->new(); $response = $ua->post( $url, apikey => $apikey, Content_Type => 'audio/flac', Content => $audio );
Unable to make shallow copy of Moo hash ref attribute
2 direct replies — Read more / Contribute
by nysus
on Nov 13, 2018 at 00:45

    This is driving me nuts:

    has 'tree' => ( is => 'ro', isa => sub { {} }, default => sub { { '/' => { children => {} } } } + ); has 'clean_tree' => ( is => 'rw', lazy => 1, predicate => 1, ); sub BUILD { my $s = shift; $s->app->add_hook (Dancer2::Core::Hook->new ( name => 'before_template', code => sub { ... if (!$s->has_clean_tree) { my %tree = %{$s->tree}; # Attempting to make shallow copy he +re. $s->clean_tree(\%tree); } # set active my $tree = $s->clean_tree->{'/'}; foreach my $segment (@segments) { $tree->{children}{$segment}{active} = 1; $tree = $tree->{children}{$segment}; } ... } )); }

    $s->clean_tree is reflecting $s->tree despite trying to make a shallow copy of $s->tree first..

    $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

Perl Mapping (GIS)
4 direct replies — Read more / Contribute
by johnfl68
on Nov 12, 2018 at 22:53


    I looked around, but did not really see any posts of this nature here, so I don't know if anyone here can help. But it doesn't hurt to ask.

    I'm looking for a Perl based mapping (GIS) solution. I need to merge a base map (Natural Earth), and overlay map, and some vector shape files. Nothing too difficult, but may be some different map projections in the merge.

    I see Mapserver, but that doesn't look to be too Perl friendly. Same goes for TillMill. Are there any other Linux (Ubuntu 18.04 server) and Perl friendly options out there that I haven't found yet?

    If anyone has any suggestions, please let me know.

    Thank you as always!

Lincoln Stein's *Networking Programming with Perl* source code
2 direct replies — Read more / Contribute
by ibm1620
on Nov 12, 2018 at 16:47
    This great book, (c) 2001, came with source code that was available at Sadly, the website doesn't seem to be around anymore. Does anyone know where the source code might have moved? Google is providing no leads...
Screenshot with Perl
2 direct replies — Read more / Contribute
by Perlchaoui
on Nov 12, 2018 at 04:39

    Hello Monastery !

    I would like to get an answer if possible on the below topic. I have to test several url's and i would like to do some screnshot for each of them, once the website is available.

    I can do a screnshot using this code. It's working fine.

    my $filename = "screenshot.png"; $driver->capture_screenshot($filename);

    But as the screenshot action is part of a loop ,when doing that, each screenshot is overriding the previous one because of the same path.

    I searched and i did the following change but this is not working. I can load my script but i recover no screnshot

    my $path = "C:/Users/user1/Documents/TESTPERL"; $driver->capture_screenshot("$path/Website-$url.png");

    The output in CMD is here:

    C:\Users\user1\Documents\TESTPERL>perl Processing binmode() on closed filehandle $fh at C:/Strawberry/perl/site/lib/Sele +nium/Remote/ line 1014. print() on closed filehandle $fh at C:/Strawberry/perl/site/lib/Seleni +um/Remote/ line 1015. Processing binmode() on closed filehandle $fh at C:/Strawberry/perl/site/lib/Sele +nium/Remote/ line 1014. print() on closed filehandle $fh at C:/Strawberry/perl/site/lib/Seleni +um/Remote/ line 1015. Processing binmode() on closed filehandle $fh at C:/Strawberry/perl/site/lib/Sele +nium/Remote/ line 1014. print() on closed filehandle $fh at C:/Strawberry/perl/site/lib/Seleni +um/Remote/ line 1015.
    And here the main code:
    #!/usr/bin/perl use strict; use warnings; use Test::More; #use Test::Time; use Selenium::Remote::Driver; use Selenium::Remote::WebElement; use Selenium::Remote::WDKeys; use Spreadsheet::Read; use Text::CSV_XS; my $driver = Selenium::Remote::Driver->new( 'remote_server_addr' => 'localhost', 'browser_name' => 'chrome', 'port' => '4444', ); my $excel = ReadData("TEST.csv"); my $row = 1; my $url = $excel->[1]{'A'.$row}; while ($url){ # do something with url process($url); ++$row; $url = $excel->[1]{'A'.$row}; } sub process { my ($url) = @_; print "Processing $url\n"; $driver->get($url); $driver->maximize_window(); $driver->pause(2000); #my $filename = "screenshot.png"; #$driver->capture_screenshot($filename); my $path = "C:/Users/user1/Documents/TESTPERL"; $driver->capture_screenshot("$path/Website-$url.png"); $driver->pause(2000); }

    I already put this in a post but it was a remark part of another topic.

    Can someone help on this ?

    Many thanks

Multiple CPAN distributions under the same git repository?
2 direct replies — Read more / Contribute
by Dallaylaen
on Nov 12, 2018 at 01:54

    Hello dear esteemed monks,

    Suppose I have several similar and small modules (actually plugins for another module) and I'm looking for a way to keep them in git.

    The plugins are not expected to be changed often. When they are, however, many of them may require an almost identical change (e.g. the main module adds a new feature or fixes a bug).

    So what are the ways to achieve it?

    • (1) Just make a repository per module. Pros: it's simple. Cons: lots of jumping through hoops in a mass update situation.
    • (2) Make a package named My::Module::Plugins and bundle them all. Pros: it's simple. Cons: I want my users to be able to pick which dependencies they need.
    • (3)Have several directories in one repository. Pros: Can modify and build them at once. No need to keep an eye on many repos. Cons: it's complicated. The directory structure itself needs maintenance.

    What are the examples on CPAN? So far I've been able to peek at Map::Tube::* which uses the first approach. But maybe there are others? What do they use?

    Thank you.

grep surprise
5 direct replies — Read more / Contribute
by morgon
on Nov 11, 2018 at 16:30

    I usually just grep through arrays, but recently I was not looking for an array-element, but for the index of an array-element, so I tried this:

    use strict; my @array=(1,2); my $i1 = grep { $array[$_] == 1 } (0..$#array); my $i2 = grep { $array[$_] == 2 } (0..$#array); my $i3 = grep { $array[$_] == 3 } (0..$#array); print "<$i1> <$i2> <i3>\n";
    I would have expected an output of "<0> <1> <>" (as the index where the value is 1 is 0, the index where the value is 2 is 1 and there is no index with a value of 3), but instead I get "<1> <1> <0>".

    Why is that?

'my' inside /(?{...})/ doesn't refresh a hash variable in 5.14
1 direct reply — Read more / Contribute
by rsFalse
on Nov 11, 2018 at 11:33

    I was playing with '/(?{ ... })/' and have found different 'my' behaviour inside eval-block, in 5.18 vs 5.14.
    In the code below, I am playing with the task: "To find 2 numbers (from 0 to 2), which can not be the same, their sum is equal to 2, and the second one is bigger than first one".
    use warnings; use strict; $\ = $/; my $A = 2; my $_0to2 = join '', 0 .. 2; $_ = join '=', ( $_0to2 ) x 2; print "\$_:[$_]"; print /^ \d*(\d)\d* = \d*(\d)\d* (?(?{ my %h; map $h{ $_ } ++, $1, $2; 2 == keys %h }) | (* +FAIL) ) (?(?{ $1 < $2 }) | (*FAIL) ) (?(?{ my $sum = $1 + $2; $sum == $A }) | (*FAIL) ) $/x ? "MATCHED: \$1:[$1], \$2:[$2]" : "NOT_MATCHED" ;
    Here I used conditionals "(?(condition)yes-pattern|no-pattern)" (perlre).

    5.14.4 OUTPUT:
    $_:[012=012] NOT_MATCHED
    5.18.2 OUTPUT:
    $_:[012=012] MATCHED: $1:[0], $2:[2]
    I haven't understand where is the different behaviour, because I haven't received any warnings by 'use warnings;'.
    I found the difference when inserted 'print 0 + keys %h;' inside eval-block with hash (code line below). It printed many '3' (5.14) vs not more than '2' (5.18). It seems that 'my %h;' haven't refreshed a hash. I guess it was known behaviour. When have it changed?
    (?(?{ my %h; map $h{ $_ } ++, $1, $2; print 0 + keys %h; 2 == keys %h +}) | (*FAIL) )
    Upd.2:Have swapped versions to correct
Splitting program into modules
7 direct replies — Read more / Contribute
by lis128
on Nov 10, 2018 at 17:14
    Dear Monks,

    at my job i am last one who understands and worships spiritual Perl power.
    Because of that i was sent to dungeon full of hash pounds and dollar signs, named, to alter it's way of working.

    I was given 14k lines of wise, full of vaild and even preety, but not self-documenting Perl code. sub definitions are mixed with "main" code and sub calls, database routine is ending just to call curl on the main "thread" and after which there's another sub defined.
    Obviously it's not helping to understand what, or how, this code is relly doing, so i decided to split it into functional packages

    So, as i did not found any more elegant way to include "reusable" code, i decided to group subs accessing database into, these interacting with API for data input ended in and so on, leaving main to just call predeclared subs and decide either to INSERT them into databse or print.

    Main package had been shrinked into circa 300 lines and i've gained much visibility. When i wanted to proceed to unit tests and documenting every sub functionality (like: this function CONSUMES scalar with URL, PRODUCES array with "img scr" tags) i found that my packaging solution might not be wisest thing done there.
    Of course i didn't foreseen that namespaces can be an issue here, and they were

    main calls custom wrapper to eventually create instance of DBI object and holds its ref in $main::sql.
    sub sql_connect embedded into (Databae::sql_connect to be precise) tries to call "connect" method on $sql, but's methods albo uses some $sql methods
    and there's alot of shared variables like this.
    Before my modularization attempt everything worked, now i am forced to replace all "my"s into "our"s definitions in main in order to grant access to these variables by modules.

    also changing all $variable in modules to $main::variable syntax and constanlty growing out @EXPORT = qw (...); gave me that strage feeling like trying to leave dungeon leads me to catacombs.

    what am i missing here? How do properly split this code into logical chunks of separate files, but keeping namespace "main"?

    ANY ideas will be appreciated.
    my main goal is to document code, understand it's flow and based on that create another functionality

New Cool Uses for Perl
curl2lwp - convert Curl command line arguments to LWP / Mechanize Perl code
1 direct reply — Read more / Contribute
by Corion
on Nov 14, 2018 at 13:07

    After inspiration by Your Mother and some slight hacking, I'm very proud to announce HTTP::Request::FromCurl, together with its companion online site at The module and included curl2lwp program allow you to easily convert curl command lines to Perl code that uses LWP::UserAgent resp. WWW::Mechanize.

    Some code: -X GET -A xpcurl/1.0

    outputs the following code:

    my $ua = WWW::Mechanize->new(); my $r = HTTP::Request->new( 'GET' => '', [ 'Accept' => '*/*', 'Host' => '', 'User-Agent' => 'curl/1.0', ], ); my $res = $ua->request( $r, );

    The online version creates a bit more code, as the output there is likely not consumed by advanced Perl programmers.

    The module parses a subset of the valid curl command lines and generates equivalent code for LWP::UserAgent for it. Support for other HTTP user agents (Mojo::UserAgent, AnyEvent::HTTP, HTTP::Future) is not yet implemented but I welcome contributions there.

    The app driving the online interface is not yet released onto CPAN, but as it is mostly HTML scaffolding and some Javascript, it should be released fairly soon.

Google API Browser
No replies — Read more | Post response
by localshop
on Nov 12, 2018 at 09:42

    As I continue my pilgrimage to becoming passably proficient with Mojo and Google Cloud Services I have been tinkering away with WebService::GoogleAPI::Client and as a working example I was reasonably happy with the ease with which I could produce a basic Google API Explorer that presents the method and parameters of all the Google Discoverable API Endpoints. This is proving a handy starting point to constructing working examples accessing the APIS.

    I plan to extend this to firstly include required scopes, then provide OpenAPI YAML and perhaps ultimately replicate many of the features of Google's API Explorer.

    You can see the Mojo Application running as a Hypnotoad socket served application under CPANEL/WHM hosted environment at

    Today I'm working on the Google Drive API Example available in the Github Repo as a demo of an alternative approach to using a dedicated CPAN module such as the just released Net::Google::Drive

    If anybody has any interesting use cases requiring access to Google Cloud Services let me know. I'm trying to add a new example every few days.

New Obfuscated Code
die if lie! fun with Win32
1 direct reply — Read more / Contribute
by Discipulus
on Nov 12, 2018 at 05:27
    Hello nuns and monks!

    I'm not an obfusctor, but as Win32 is obfuscated per se i present you this little lie/truth game

    use Win32; exit unless @}; $ms = \&Win32::GetSystemMet +rics if $^O; END{ exit if @};while(<DATA>) { s/\s//g ; push @} , jo +in '', map {chr (($^O =~ s/\D+//r)+$_)}( $_ =~ /\d{2}/g ) } seek DA +TA, 0, 0; ; $s.=$_ for<DATA>;die if !eval $s; system('cls'); print $ +^O,' ', map {uc $_} substr($} [4], 0, 1 ), substr ($}[0] , 7 , 1), sub +str( $}[5] ,4,1), substr ($}[8],1,1), $/;} map{die 'lie!' unless($$_[1 +]->($$_[2] )?6:7 )== Win32::MsgBox($}[$$_ [0]] . "?", 4, $0); }[0, $ms +,75], [1, $ms, 91], [2, $ms, 23],[3,$ms, 0x2004], [4,$ms, 67],[5, $ms +,0x2003]; map { print $}[$$_[0]]. "?\n"; <STDIN> eq $$_[1] ( $$_[2] ). +"\n" or die'lie!'}[6,$ms,80],[7,$ms,0], [8,$ms,1]; eval '#!perl' unle +ss $^O; __DATA__ 777 9 8 5 8 36 9 00 7265 830 08 669 82 847 36 765 760 08 7726 +96 976 77 79 858 36 90 0726 5830072798 27390 7978 84 65 76 00 8772 69 +69 76 7 7 7 98583 69 0 0 66 8 58 4847 97 8830 0658 26900 83 876 58080 + 6968 73 8 30 08 4 726 90 080 670 073 78 006 8 79 67 756 96 80 077 796 + 869 74 85 8 3 84006 67 9798 4007378 007 065 7376 1383 6570 69 007779 +6869 89 798 500 808 5840 08 0670 079 78 0 08 37 6 6 58 4 69 0 07 779 6 +869 72798 70077 65788 9007 77 97873 84798283 0068790089798 500726 58 +669 87726584078 3008472690087736884 720079700070738 28384008367 826969 +78 8772658407830084726900726973717 284007970007073 8283840083678269697 +8


    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.
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 scrutinizing the Monastery: (5)
As of 2018-11-15 07:00 GMT
Find Nodes?
    Voting Booth?
    My code is most likely broken because:

    Results (181 votes). Check out past polls.