Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

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
Assigning a parsed date to a variable
4 direct replies — Read more / Contribute
by Anonymous Monk
on Mar 30, 2017 at 14:34
    Hi Monks!

    I am just trying to find a less code way to do this parsing using regular expressions.
    In the first one I am getting a "1", why it cant be done this way.
    It works on the second code, unless there is a more efficient way of doing it.

    #!/usr/bin/perl use strict; use warnings; my $adate = "2017-01-29 11:30:07.370"; # more direct way, but returning a "1". my $a_new_datetime = ( $adate =~ s/(\d{4})-(\d{2})-(\d{2})\s(\d{2}):(\ +d{2})(.*)/$2-$3-$1 $4:$5/ ); print "\n 1 - $a_new_datetime\n\n"; my $new_datetime = $adate; $new_datetime =~ s/(\d{4})-(\d{2})-(\d{2})\s(\d{2}):(\d{2})(.*)/$2-$3- +$1 $4:$5/; print " 2 - $new_datetime\n\n";

    Thanks for looking at it!
Stopped posting cookies
3 direct replies — Read more / Contribute
by tultalk
on Mar 30, 2017 at 07:58


    Up until tuesday this week this code in script was posting cookies to firefox.

    sub SetUserSessionCookie { my $printresult = ""; my ($sname,$sid) = @_; #use CGI qw/:standard/; #use CGI::Cookie; warn("In set cookie: '$sname' '$sid'"); my $sessioncookie = new CGI::Cookie(-name=>$sname,-value=>$sid,-ex +pires=>$session_cookie_timeout,-path=>'/',-domain=>$domain,-secure=>1 +); warn("session cookie: '$sessioncookie'"); $printresult = print header(-Cookie=>[$sessioncookie],-type=>"text +/html"); warn("printresult: '$printresult'"); }

    I had been testing program and the cookie was posted at least 100 time

    On Tuesday afternoon it quit posting cookies in FF

    It still posts cookies in Chrome and Blue Moon but will not work in Firefox

    I checked all settings in FF, deletec all cookies and cache several times, shut down and restarted FF and computer and finally reinstalled the latest version and did a search on internet thinking a FF upgrade is the culprit. No such luck.

    The warns show correct information. And: printresult: '1' at /home/jalamior/www/httpsdocs/cgi-bin/lib/perl/ line 687.

    Of course I assume 1 = true = success.

    Thanks and best regards

MongoDB and WriteConcern
1 direct reply — Read more / Contribute
by andal
on Mar 30, 2017 at 05:57

    Does anyone now how one correctly defines write concern when doing $collection->insert_one()? It seems that I should do something like

    $collection->insert_one({....}, { writeConcern => MongoDB::WriteConcern->new( { w => 'majority', j => 1, wtimeout => 10000, } } );
    That should be waiting till data is copied to majority of hosts in replica set, so it shall be slower, than default write concern. In practice though I get the same speed of writing as with w => 0 and j => 0. Plus replication looses data if I kill primary host. Do I miss something?

    I'm using mongodb 3.2.12 and module MongoDB version 1.6.1

Populating an array via a DBI call - simplified
2 direct replies — Read more / Contribute
by edimusrex
on Mar 29, 2017 at 14:05

    This post is more about trying to find a cleaner way to accomplish my task. I use DBI a lot but I am curious if there is a better way to populate and array with the returned value when only a single field is returned. Example ---

    SELECT `UserName` FROM Account a, asscAccountAccountGroup aaag, asscRoleAccountGroup arag, Role r WHERE a.Id = aaag.AccountId AND aaag.AccountGroupId = arag.AccountGroupId AND arag.RoleId = r.Id AND r.Name = 'ROLE_REVIEWER';

    I have always acomplished this by doing the following --

    my @regUsers; my $sth = $dbh->prepare("SELECT `UserName` FROM Account a, asscAccount +AccountGroup aaag, asscRoleAccountGroup arag, Role r WHERE a.Id = aaa +g.AccountId AND aaag.AccountGroupId = arag.AccountGroupId AND arag.Ro +leId = r.Id AND r.Name = 'ROLE_REVIEWER';") || die "Cannot prepare th +e query :$!"; $sth->execute() || die "Cannot execute the query :$!"; while ( my @userRows = $sth->fetchrow_array() ) { push @regUsers, @use +rRows; } print join("\n",@regUsers);
    Which always works as expected but I'd like to simplify that code if possibe.

    Doing the following seems to return a list of references but is close --

    my @users = $dbh->selectall_array("SELECT `UserName` FROM Account a, a +sscAccountAccountGroup aaag, asscRoleAccountGroup arag, Role r WHERE +a.Id = aaag.AccountId AND aaag.AccountGroupId = arag.AccountGroupId A +ND arag.RoleId = r.Id AND r.Name = 'ROLE_REVIEWER'"); print join("\n",@users);

    Thanks for the suggestions

Traversing a hash of hashes of hashes
4 direct replies — Read more / Contribute
by kcorj2244
on Mar 29, 2017 at 03:46

    This is far outside my level of comfort, and I'm facing a very interesting sitaution. Essentially, I'm dealing with a massive hash. I have access to the hash reference, and I want to traverse the hash and take out the names of the other hashes and their keys. I want to ignore values. Using Data::Dumper is unreadable due to size.

    Let me show an example. Note that this is all inside the main hash reference

    'flags' => { 'example' => 0, 'font_attributes' => { 'size' => -1, 'colors' => '' }, 'Redacted' => 0, 'Redacted' => [], 'font_changes' => { 'size' => -1, 'colors' => -1 }, 'Redacted' => 0, 'Redacted2' => -1, 'Redacted3' => -1, 'Redacted4' => 0 }, 'Domains' => {}, 'removed_results' => [], 'Words' => {}, 'other_results' => {}, 'recipient_list' => [ '' ], 'Clean' => { 'extra' => {} }, 'result' => 'pass', 'Lists' => { 'Body' => { 'RedactedWordList' => { 'words' => { 'word1' => '5', 'word2' => '1', }, 'words_found' => [], 'weight' => 0 } } }

    As you can tell, it just keeps going and going and going and going. I want to be able to print everything except the values. So $startingHash with hashes within it, and those hashes having hashes within them. I want to print the name of every "hash name" and every "key" in a readable format. I can't seem to wrap my brain around how I could do that. I'm tasked with documenting everything available within this mega hash, but I don't need the actual value obviously

Modperl2 + mpm_event + seemingly forgotten global vars
4 direct replies — Read more / Contribute
by spellila
on Mar 28, 2017 at 15:07

    Greeting everyone, i get stucked using modperl2 on apache 2.4 (mpm_event) and ubuntu (upgraded on daily base form ubuntu-repo). I try to keep some filehandles and datastructures simply on a "our" variable. This works fine until i generate some network load for this server (1000 persistent connections each wants to get the same stuff). Than it looks like the "our" is forgeting its value. This is happening much faster if you are using more threads per child. Here a simple example:

    package example::PerlResponseHandler; use strict; use warnings; use APR::OS (); use Apache2::Const -compile => qw(OK); our $obj; sub handler { my $r = shift; my $tid = APR::OS::current_thread_id(); if(!$obj) { $obj = {one => 1}; warn "[pid $$ tid $tid] New object generated"; } $r->content_type('text/html'); $r->print('mod_perl rules!' . $obj->{one}); return Apache2::Const::OK; } 1;

    Using this package as responsehandler in your apache2.conf and the `ab`-tool targeting this handler, you will see at your error.log that the our var is getting setted. After some time you will see that this variable is reseted on and on.

    Using 5000 MaxRequestWorkers splitted by threads 250 on each child i could see that only 18 threads was able to hold this variable without any interaction after it was initialized (over days!).

    Even if i used only 3 threads per child and 1500 possible servers, the error was reproduced after the 264 thread was spawned. 263 threads was keeping their states over days.

    The server have enough ressources over and no limits being reached.

    I want to achive that all my threads holding the states of their our vars.

    After some sleepless days i decided to ask the perlmonk community. Hopefully somebody can help further.

[PPM (Perl Package Manager)] Installing multiple modules from a single ppd file
1 direct reply — Read more / Contribute
by syphilis
on Mar 28, 2017 at 06:17
    Here follows a post I sent to ActiveState's ppm mailing list about 24 hours ago:


    Is it possible to have the one ppd file download, unpack and install more than one tarred and gzipped blib file.

    That is, instead of having just one "<CODEBASE HREF= ..." line, I'm looking for the option of having multiple such "<CODEBASE HREF=...." lines present in the one ppd file, such that a number of different tarred and gzipped blib files are dowwnloaded, unpacked and installed.

    Possible ? ... or do I have to put the additional files into their own separate ppm distro and pull them in with "DEPENDENCY NAME".

    Btw, is there a difference between DEPENDENCY NAME and REQUIRE NAME ?


    It's a very low volume mailing list, and no replies yet.
    So I thought I might repeat the post here.

    I've a vague notion that, at some time in the past, I've come across a ppd file that would install multiple perl modules, but I'm currently unable to locate such an example.

How to patch this module?
3 direct replies — Read more / Contribute
by ultranerds
on Mar 28, 2017 at 05:19
    Hi guys,

    I've setup my own server with Perl 5.22.1, and I'm having issues installing a Perl module (Kavorka, which is an annoying requirement of Net::Stripe). After some digging, it seems to be around this :

    PERL_DL_NONLAZY=1 "/usr/bin/perl" "-MExtUtils::Command::MM" "-MTest::H +arness" "-e" "undef *Test::Harness::Switches; test_harness(0, 'blib/l +ib', 'blib/arch')" t/*.t t/01basic.t .................... ok t/02named-functions.t .......... Can't locate object method "_set_decl +ared_name" via package "Kavorka::Sub::Fun" at /root/.cpan/build/Kavor +ka-0.037-RoeMIW/blib/lib/Kavorka/ line 182. t/02named-functions.t .......... Dubious, test returned 255 (wstat 652 +80, 0xff00) No subtests run t/03anon-functions.t ........... Can't locate object method "declared_ +name" via package "Kavorka::Sub::Fun" at /root/.cpan/build/Kavorka-0. +037-RoeMIW/blib/lib/Kavorka/ line 48. t/03anon-functions.t ........... Dubious, test returned 255 (wstat 652 +80, 0xff00) No subtests run t/04named-methods.t ............ Can't locate object method "_set_decl +ared_name" via package "Kavorka::Sub::Method" at /root/.cpan/build/Ka +vorka-0.037-RoeMIW/blib/lib/Kavorka/ line 182. t/04named-methods.t ............ Dubious, test returned 255 (wstat 652 +80, 0xff00) No subtests run t/05anon-methods.t ............. Can't locate object method "declared_ +name" via package "Kavorka::Sub::Method" at /root/.cpan/build/Kavorka +-0.037-RoeMIW/blib/lib/Kavorka/ line 48. t/05anon-methods.t ............. Dubious, test returned 255 (wstat 652 +80, 0xff00) No subtests run t/10positional.t ............... Can't locate object method "_set_decl +ared_name" via package "Kavorka::Sub::Fun" at /root/.cpan/build/Kavor +ka-0.037-RoeMIW/blib/lib/Kavorka/ line 182. t/10positional.t ............... Dubious, test returned 255 (wstat 652 +80, 0xff00) No subtests run t/11named.t .................... Can't locate object method "_set_decl +ared_name" via package "Kavorka::Sub::Fun" at /root/.cpan/build/Kavor +ka-0.037-RoeMIW/blib/lib/Kavorka/ line 182. t/11named.t .................... Dubious, test returned 255 (wstat 652 +80, 0xff00) No subtests run t/12invocant.t ................. Can't locate object method "_set_decl +ared_name" via package "Kavorka::Sub::Method" at /root/.cpan/build/Ka +vorka-0.037-RoeMIW/blib/lib/Kavorka/ line 182. t/12invocant.t ................. Dubious, test returned 255 (wstat 652 +80, 0xff00)

    I found a report of a bug in Devel::CallParser:

    I made the change the suggest in the patch for CallParser.xs in the .gz file, but I can't work out what this file is meant to be:


    (I don't see it in the .gz from CPAN)

    Can anyone point me? Its sooooo frustrating that ALL of my issues are resting on this one bug, that after over a year still doesn't seem to have been fixed in the official releas :/


perl6 custom operator problem
2 direct replies — Read more / Contribute
by freakcoco
on Mar 28, 2017 at 05:07

    hi monk I am studying chemistry in the university,
    and then I try to write all the things in the textbook with Perl6 or Perl,
    like balancing the chemical formula or other process!
    Then I encountered the problem is on perl6 custom operator.
    I feel I have been repeating my code and myself when i use the feature.
    It is hard to read and write, and what is the way to deal with such problems?

    #!/usr/bin/env perl6 use v6; #basic SI(International System of Units) type role MetricPrefix { method baseOn ( Str $base , Numeric $input ) { given $base { when 'pico' { return $input * 10**-12 } when 'namo' { return $input * 10**-9 } when 'micro' { return $input * 10**-6} when 'milli' { return $input * 10**-3 } when 'centi' { return $input * 10**-2 } when 'hecto' { return $input * 10**2 } when 'kilo' { return $input * 10**3 } when 'mega' { return $input * 10**6 } when 'giga' { return $input * 10**9 } when 'tera' { return $input * 10**12 } default { fail "you must input a metric prefix which allow + pico to tera" } } } } class Mass does MetricPrefix { #basic Mass is g is different form si statda has $.g; submethod BUILD ( :$!g ) { } } class Length does MetricPrefix { has $.Length ; submethod BUILD ( :$!Length ) { } } multi postfix:<(kg)>( $input ) { return g => Mass.baseOn("kilo",$input) ) or fail "you Mu +st input a number"; } multi postfix:<(g)>( $input ) { return g => $input ) or fail "you Must input a number"; } multi infix:<+>( Mass $inputOne , Mass $inputTwo ) is assoc<right> { return g => $inputOne.g + $inputTwo.g) or fail "error in + there "; } multi infix:<->( Mass $inputOne , Mass $inputTwo ) is assoc<right> { return g => $inputOne.g - $inputTwo.g) or fail "error in + there "; } multi infix:<*>( Mass $inputOne , Mass $inputTwo ) is assoc<right> is +tighter( &infix:<+> ) is tighter( &infix:<-> ) is tighter( &infix:</> +) { return g => $inputOne.g * $inputTwo.g) or fail "error in + there "; } multi infix:</>( Mass $inputOne , Mass $inputTwo ) is assoc<right> is +tighter( &infix:<+> ) is tighter( &infix:<-> ) { return g => $inputOne.g / $inputTwo.g) or fail "error in + there "; } #the meterLeng multi postfix:<(km)>( $input ) { return Length => Length.baseOn("kilo",$input) ) or fai +l "you Must input a number"; } multi postfix:<(m)>( $input ) { return Length => $input ) or fail "you Must input a nu +mber"; } multi infix:<+>( Length $inputOne , Length $inputTwo ) is assoc<right> + { return Length => $inputOne.Length + $inputTwo.Length) +or fail "error in there "; } multi infix:<->( Length $inputOne , Length $inputTwo ) is assoc<right> + { return Length => $inputOne.Length - $inputTwo.Length) +or fail "error in there "; } multi infix:<*>( Length $inputOne , Length $inputTwo ) is assoc<right> + is tighter( &infix:<+> ) is tighter( &infix:<-> ) is tighter( &infix +:</>) { return Length => $inputOne.Length * $inputTwo.Length) +or fail "error in there "; } multi infix:</>( Length $inputOne , Length $inputTwo ) is assoc<right> + is tighter( &infix:<+> ) is tighter( &infix:<-> ) { return Length => $inputOne.Length / $inputTwo.Length) +or fail "error in there "; } #just a test say 10(kg) + 1(g); say 10(m) + 1(m);
How best to write a cross-platform .xs module using x64 assembler?
3 direct replies — Read more / Contribute
by cnd
on Mar 28, 2017 at 04:18
    I wish to donate an intel chip-speed algorithm to perl users.

    It works exclusively on 64bit x64 compatible CPUs (mac, windows, linux at least).

    What would be the best way to make this available, and what build instructions (if any) do I need for those platforms so users can get and use my module ?

    Is anyone aware of any existing assembler .xs modules that work at least on linux, preferable also mac and maybe windows ?

    If anyone has suggestions for which assembler toolchains and debugging environments I should use for build pre-release testing - those would also be greatly received! Chris.

Q regex escape within variable
2 direct replies — Read more / Contribute
by palkia
on Mar 28, 2017 at 04:18

    I tried clustering some file names based on their prefix (those beginning with closers) while ignoring the specific numerical values within them.
    To achieve this, whenever a desired prefix pattern appeared, I subbed the numerical values with \d++ so it can be used later as a regex pattern,
    however since the prefix contains closers and possibly other special regex characters, I have sandwiched all non-\d++ parts with \Q and \E,
    but that raises the error Unrecognized escape \Q passed through in regex;
    I can't seem to figure what I am missing ?
    ... if($fName =~ /^([\[\(].+?[\]\)])/) { #pref detected. generalizing digits my $pref = '^\Q'.$1.'\E'; $pref =~ s/\d++/\\E\\d++\\Q/g; #finding indexes of matches to this prefix my @matchIndexes; for(my $mex=0;$mex<@fNames;$mex++) {if($fNames[$mex] =~ /$pref/i){push(@matchIndexes,$mex);}} ...
    Thank you very much for any assistance, and have an awesome day ☺

    Update: resolved by quotemeta(), thx to Eily.
Hash vs constant vs package vs other for data structure
7 direct replies — Read more / Contribute
by oldtechaa
on Mar 27, 2017 at 14:38

    I'm using an AoAoA currently for a data structure. An example of its use would be like this: $notes[$x][$y][0] = ... As you can see, the first two dimensions refer to the location of an object and the third refers to properties of that object such as flags and other data. My problem is that although the indices always refer to the same data member, it's not very readable or maintainable if you forget the index number for the data you want.

    A couple solutions I've thought of are below:

    • Use an AoAoH instead, and refer to each data member by name
    • Use constant declarations to name each index
    • Use upper-case variables to show their status as constant names for indices
    • Use a package with setter and getter functions or public data members and use an AoA with the package objects as the contents
    • Get other ideas from PM

    What do you think? I don't want to use any external CPAN distributions and I'd like the solution to not require too much boilerplate. Thanks for your time.

New Meditations
#p5p finds your lack of failing tests disturbing
3 direct replies — Read more / Contribute
by Corion
on Mar 27, 2017 at 13:42

    5.26 will come with a major change in how Perl builds and runs modules. The current directory will not be in @INC when running Perl programs.

    This affects all programs that call require or use and expect files relative to the current directory to be available. Besides plugin systems, any Makefile.PL using for example Module::Install is a likely offender. So far very little has been caught in the net of CPAN testers.

    As an example, one of my tests loads Makefile.PL:

    use lib '.'; use vars '%module'; require 'Makefile.PL'; # Loaded from Makefile.PL %module = get_module_info(); my $module = $module{NAME};

    This will fail under 5.26+ without the use lib '.'; statement at the top.

    I've altered @INC, pray I do not alter it further

    If you want to check whether your modules should still work and test OK under the upcoming 5.26 release, I think that the following oneliner should give you a good indication:

    perl -M-lib=. Makefile.PL && make && make test

    If you run author tests or prefer your tests to be run using prove, you have to take care of prove invoking a fresh Perl:

    # Windows syntax: set PERL5OPT=-M-lib=. perl Makefile.PL && dmake && prove -bl xt t
    @rem Shell syntax: export PERL5OPT=-M-lib=. perl Makefile.PL && make && prove -bl xt t

    Please test your distributions and release new versions if they need . in @INC. Thanks!

    Update: Added call to action and noted where use lib '.' helps.

New Cool Uses for Perl
Automatically ensure your CPAN dists have up-to-date prereq version numbers
No replies — Read more | Post response
by stevieb
on Mar 26, 2017 at 19:29

    So... one of my distribution relies heavily on other distributions I've written, and it's hard to ensure my dependencies for my own modules are up-to-date in the prerequisite list in the build system. Sometimes I forget to bump a prereq before I do a release, which means I have to immediately do a one-line release the next day, because I'll have emails from CPAN Testers because tests are failing.

    I've been toying with a few ways to automatically check this for me. Below is one such hack I came up with. There's two vars that need to be set: $dist and $author. It then pulls the distribution from the CPAN, extracts all of it's prerequisite dependency information. Then, it fetches the list of all distributions I've put on the CPAN, and creates a dist/version hash.

    Note that this compares *only* the prereqs that I personally have uploaded. It'd be trivial to modify a bit to check them all.

    After the data is collected, it iterates the known dependencies, and if there's a match with one of my own other distributions, I compare versions. Currently, it just prints out the list, but I'm going to hack this into my Test::BrewBuild system as another command line option so that every build run, I'll be notified of any discrepancies. Eventually, I'll likely make it auto-update the Makefile.PL files for me with the new dep versions, as well as have it review the prereq versions in the current repo of the dist I'm working on, instead of comparing to the latest CPAN release, so I can correct the issues *before* pushing to PAUSE :)

    use warnings; use strict; use MetaCPAN::Client; my $c = MetaCPAN::Client->new; my $dist = 'RPi-WiringPi'; my $author = 'STEVEB'; check_deps($dist, $author); sub check_deps { my ($dist, $author) = @_; if ($dist =~ /:/){ die "\$dist must be hyphenated... don't use ::\n"; } my $release = $c->release($dist); my $deps = $release->{data}{dependency}; my $author_modules = author_modules($author); for my $dep (@$deps){ my $dep_mod = $dep->{module}; my $dep_ver = $dep->{version}; if (exists $author_modules->{$dep_mod}){ my $cur_ver = $author_modules->{$dep_mod}; print "$dep_mod: \n" . "\tdep ver: $dep_ver\n" . "\tcur ver: $cur_ver\n\n"; } } } sub author_modules { my ($author) = @_; my $query = { all => [ { author => $author }, { status => 'latest' }, ], }; my $limit = { '_source' => [ qw(distribution version) ] }; my $releases = $c->release($query, $limit); my %rel_info; while (my $rel = $releases->next){ my $dist = $rel->distribution; $dist =~ s/-/::/g; $rel_info{$dist} = $rel->version; } return \%rel_info; }


    perl perl/dependency_version_compare/ RPi::DigiPot::MCP4XXXX: dep ver: 2.3603 cur ver: 2.3603 RPi::BMP180: dep ver: 2.3603 cur ver: 2.3603 RPi::ADC::MCP3008: dep ver: 2.3603 cur ver: 2.3603 RPi::SPI: dep ver: 2.3606 cur ver: 2.3606 RPi::DAC::MCP4922: dep ver: 2.3604 cur ver: 2.3604 RPi::WiringPi::Constant: dep ver: 0.02 cur ver: 0.02 RPi::DHT11: dep ver: 1.02 cur ver: 1.02 WiringPi::API: dep ver: 2.3609 cur ver: 2.3609 RPi::ADC::ADS: dep ver: 1.01 cur ver: 1.01
oneliner: autorun script when I save it in the editor
3 direct replies — Read more / Contribute
by FreeBeerReekingMonk
on Mar 26, 2017 at 18:08
    Sometimes you get spoiled by IDE's that have F5 to save and run what you have scripted so far... so... what can you do if you have 2 xterms (one for vi, the other for the output)?

    perl -E 'while(-f $ARGV[0]){ $now=(stat(_))[9]; system($^X,@ARGV) if($ +now-$prev); $prev=$now; sleep 1}' /home/user/ foo bar

    with having:

    #! env perl my $p1 = $ARGV[0]; my $p2 = $ARGV[1]; print "param1=$p1 param2=$p2\n";


    param1=foo param2=bar

    Tested to work under Win10 and Linux

    Of course, there are better implementations. inotifywait or auditd if available on your system...

    any perl golfers?

    Update: we now incorporate the improvement made by haukex. Feel free to add more parameters if you need these

Log In?

What's my password?
Create A New User
and the radiator hisses contentedly...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2017-03-31 00:43 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (364 votes). Check out past polls.