http://www.perlmonks.org?node_id=479

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
Cpanel::JSON::XS crash under Perl 5.26.0
2 direct replies — Read more / Contribute
by Athanasius
on Aug 19, 2017 at 02:52

    I’m trying to install MongoDB for Strawberry Perl 5.26.0:

    This is perl 5, version 26, subversion 0 (v5.26.0) built for MSWin32-x +64-multi-thread-ld

    under Windows 8.1 64-bit. One of MongoDB’s dependencies is BSON. which not only fails to install but actually crashes the Perl interpreter while doing so.

    After some debugging I eventually reduced the problem code to the following SSCCE:

    use strict; use warnings; use JSON::MaybeXS; my $json_codec = JSON::MaybeXS->new; print ref $json_codec, "\n"; print $json_codec->encode( { d => 1.0 } ), "\n";

    Note that I have the following modules installed:

    16:27 >mversion -f JSON::MaybeXS Cpanel::JSON::XS JSON::XS JSON::PP JSON::MaybeXS 1.003009 Cpanel::JSON::XS 3.0233 JSON::XS 3.04 JSON::PP 2.94 16:27 >

    Now to the point: when I run the SSCCE, I get the following output:

    19:26 >perl 1800_SoPW.pl Cpanel::JSON::XS

    and the Perl interpreter crashes. But if I change the JSON module:

    19:26 >perl -MJSON::XS 1800_SoPW.pl JSON::XS {"d":1} 19:27 >

    the code completes successfully. I have also tested the SSCCE on Strawberry Perl 5.24.1, and it runs without a problem:

    16:37 >perl 1800_SoPW.pl Cpanel::JSON::XS {"d":1.0} 16:38 >

    So, I have two sets of questions:

    (1) Can other monks confirm this behaviour under Perl 5.26.0? If so, is it confined to Windows or does it occur on other platforms as well? And does anyone know of a change from 5.24 to 5.26 which could account for this? Should I report it as a bug under Cpanel::JSON::XS?

    (2) Until the bug is fixed, what’s the best way to prevent JSON::MaybeXS from defaulting to Cpanel::JSON::XS? I can add -MJSON::XS to the command line when invoking a Perl script directly, but how can I get cpanm to do this? Or will I need to uninstall Cpanel::JSON::XS from my system?

    Thanks,

    Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

Generic/Variable/Dynamic Subroutines? (Not a redefine)
2 direct replies — Read more / Contribute
by mlewando
on Aug 18, 2017 at 14:50
    I am working on some code for Nagios automations and was curious if there is a way to generalize the following:
    sub WriteLine { my $self = shift; my $it = $self->OStream->WriteLine($_[0]); $self->Trace(_CallerStr($it)); return $it; }; sub Select { my $self = shift; my $it = $self->OStream->Select($_[0]); $self->Trace(_CallerStr($it)); return $it; }; sub Add { my $self = shift; my $it = $self->OStream->Add($_[0]); $self->Trace(_CallerStr($it)); return $it; };
    To something along the line of:
    sub <Call> { my $self = shift; my $it = $self->OStream-><Call>($_[0]); $self->Trace(_CallerStr($it)); return $it; };

    Such that, I can use $Wrapper->Remove($item) and the function '<Call>' is executed and <Call> is substituted with 'Remove'. I can only think of using callbacks and a dispatcher but it seems like I would still have to generate all of the callback subs which I kind of want to avoid. Don't get me wrong it's not like copy/pasting is the end of the world, but why copy paste redundancy if there exists a method where I can almost template it? I would also like the simplicity in $X->Y->Z($item) and not have to work a dispatch and sub-call, which I have done before by passing a dispatch function a 'function name' like:

     if(defined $dev_desc{$tcp_data->Dispatch((USF::Modbus::Modbus::CB_NUMBERS))})

    But then I end up checking function name and data followed by execution, whereas I want something like (kind of a bad example but the point is there):

     if(defined $dev_desc{$tcp_data->Dispatch->Numbers($tcp_data->Value)})

    Maybe an overload? But then I would still have to have overload functions where all I really want to do is have it intuitively fill in the blacks since all of the functions will be doing the same thing since it is essentially a proxy class with subroutine tracing built-in for logging/debugging traceability. If it's not possible then oh well I guess, I just feel like there should be a better solution to excessive redundancy (especially when I am already using a proxy). I also feel it isn't entirely a thing since it would be a nightmare for the interpreter.

    Thanks

Trickery with Getopt::Long (flag option, with optional integer arg)
1 direct reply — Read more / Contribute
by stevieb
on Aug 18, 2017 at 11:03

    I'm in a position with Getopt::Long where I need to allow an option to operate as a flag, but also accept an argument to itself (an integer), and it also must set 0 as the flag value if no integer is passed along with it.

    The only way so far I've found to do it involves a bit of workaround, and I'm just wondering if I'm over thinking this. I haven't found another way to do this, so perhaps I'm overlooking something...

    use warnings; use strict; use Getopt::Long; my $arg = -1; { local $SIG{__WARN__} = sub { $_[0] =~ /^Option arg/ ? $arg = 0 : warn $_[0]; }; GetOptions( 'arg=i' => \$arg ); } print "$arg\n";

    So what that does is sets the argument variable to -1 as a default. If --arg|-a is sent in without an integer value along side it, I catch the warning and if it references the option properly, I set it to 0. If an integer is supplied to the option, things just work as normal.

    I'm happy with the code as it works very well, so I'm just looking to find out if there are built-in or other alternatives for this type of situation.

    Thanks,

    -stevieb

pass parameter in form action
1 direct reply — Read more / Contribute
by Anonymous Monk
on Aug 18, 2017 at 10:03
    <FORM onkeypress="return event.keyCode != 13;" ACTION = "/cgi-bin/shh +abcam/parse_params.cgi $user" METHOD = "get">

    I would like to pass a parameter (in this case '$user') to the 'action' program. I am finding that the parameter is getting attached to the action program file name (looks like: 'parse_params.cgi test'). Is there any way to do this?

Return all the data from child to parent with Parallel::Forkmanager
5 direct replies — Read more / Contribute
by Microcebus
on Aug 18, 2017 at 08:14
    Dear wise monks,
    sorry if that is a stupid question but I'm a biologist rather than a coder... I want to analyze some biological data. Therefore, I need to read and analyze 4 large files before I can actually analyze my own data. To save time I would like to read the 4 files in parallel using Parallel::Forkmanager. My problem is that I have no idea (even after google search) how to return the data back to the parent. Each subroutine generates a lot of different data structures such as hashes and arrays that I need later on in the parent process. Below is the code that I currently try.
    use Parallel::ForkManager; $threads=4; if($threads==1) { read_genome(); read_mapfile(); read_GTF(); read_RM(); } else { @eval_code=("read_genome();","read_mapfile();","read_GTF();","read +_RM();"); my$pm=new Parallel::ForkManager($threads); foreach$eval_code(@eval_code) { $pm->start and next; eval$eval_code; $pm->finish; } $pm->wait_all_children; } sub read_genome { # do something } sub read_mapfile; { # do something } sub read_GTF { # do something } sub read_RM { # do something } # use data generated in the subroutines
variables in substition/eval
5 direct replies — Read more / Contribute
by xaphod
on Aug 17, 2017 at 18:41

    I run this script:

    use strict; use warnings; my @lines = ( "Once upon a time", "scrooge & donald", "went for a long walk" ); my @list = ("huey", "dewey", "louis"); foreach my $who (@list) { my $sub = "\$ln =~ s/scrooge (& donald)/$who \$1/g;"; print "$who\n"; foreach my $ln (@lines) { eval $sub; print "$ln\n"; } print "\n"; }

    and I get this:

    huey Once upon a time huey & donald went for a long walk dewey Once upon a time huey & donald went for a long walk louis Once upon a time huey & donald went for a long walk

    not what I was expecting. Anyone help?

    --
    TTFN, FNORD

    xaphod
Nested loops?
5 direct replies — Read more / Contribute
by Speed_Freak
on Aug 17, 2017 at 15:18

    I am working with existing code, and trying to add a "filter" to it. Currently the code pulls an id number and a sequence from a table in the database.(sql1) A foreach loop then permutes each sequence and searches the list to find out if any of the alternates exists. This leads to way more matches than I need because the loop eventually gets to the existing alternates, permutes them, and finds all of the matches again, just with a different primary sequence. I created a second database pull that creates another list with the same id-sequence layout that contains only the primary keys that I want to evaluate. (sql2) I want to use this secondary list as the filter for which sequences are evaluated from the primary list, but I need each key identified in the secondary list to be evaluated against all of the primary list.

    #currently have strict turned off #code snippet foreach my $sql1 (@{$sql1}) { $table1{$sql1->[1]}{$sql1->[0]}=undef; #rearranges the sql pull } foreach my $sql2 (@{$sql2}) { $table2{$sql2->[1]}{$sql2->[0]}=undef; #rearranges the sql pull } my %hash = (); my @array = (); my @bases = ('A','C','G','T'); foreach my $tar1 (keys %table1){ foreach my $tar2 (keys %table2) { if ($tar1 eq $tar2) { #a bunch of follow on code that works if the second foreach and if sta +tements are removed

    I'm just not sure which direction I should go with trying to limit the list it chooses to evaluate, without limiting the list of sequences it uses to evaluate against. I have tried several combinations of foreach/if/where statements and the closest I have gotten lead me to loop through the entire first table, but only using one sequence from the second table. I couldn't get it to iterate through the "filter" table. I'm sure my explanation is lacking severely.

Weird Date::Manip DateParse fail
1 direct reply — Read more / Contribute
by cormanaz
on Aug 17, 2017 at 14:32
    Good day bros. The following snippet:
    #!/usr/bin/perl -w use strict; use Date::Manip; use HTML::TreeBuilder; my $htm = ' <html><div class="posthead"> <span class="postdate new"><span class="date">14th August 2017,&nbsp;<span class= "time">21:07</span></span></span> <span class= "nodecontrols"><a name="post27949278" href= "threads/2360460-product-reviews.htm" class="postcounter">#1937</a></span> </div></html>'; my $tree = HTML::TreeBuilder->new_from_content($htm); my $postdate = $tree->look_down('class','date')->as_text(); print "postdate: $postdate\n"; print "postdate parsed: ",ParseDate($postdate),"\n"; my $timestamp = '14th August 2017, 21:07'; print "string parsed: ",ParseDate($timestamp),"\n";
    yields output:
    postdate: 14th August 2017, 21:07 postdate parsed: string parsed: 2017081421:07:00
    So it fails to parse a date when it's passed to ParseDate as the contents of a variable gotten with HTML::Element, but if I take the exact same text, assign it to a variable as a string literal, and pass it to ParseDate, it parses fine. I've debugged into Date::Manip and it seems to be getting the same string in both cases. Anyone know what's going on here?!?
LWP::UserAgent Get timing out after few request
2 direct replies — Read more / Contribute
by sannag
on Aug 17, 2017 at 10:58
    Update

    **************

    I don't the underlying cause. I fixed the issue on my program by using REST::Client instead of LWP::UserAgent....details of the code are in one of my reply below

    ***************

    My Get request is timing out after processing 20 or 30 request...I have over 500 records to process. I did confirm that there is no limit on number of GET requested placed to API. I also tried using chrom extension postman to repeatably place GET request successfully. Yet when I place GET request though my perl program it failed after processing few requests. Any help is greatly appreciated

    error says following:

    500 can't connect to api.xxx.com:443. (A connection attempt failed because the connected party did not properly respond after a periold of time, or established connection failed because connected host has failed to respond

    LWP::Protoclo::https::Socket: connect: a connection attempt failed because the connected party did not properly respond after a period of time, or established connection failed because connected host has failed to respond at C:/Dwimperl/perl/site/LWP/Protocol/http.pm"

    my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 }, ); $ua->timeout('1000'); sub getUserInfo { my($userId) = @_; my $partnerId = 'B53765B23456678C1' my $userURI = 'https://xxx.com/api/m1/request/'. $partnerId. '/users/ +'. $userId; print $userURI, "\n"; #sleep (3); my $userResponse = $ua -> request(GET($userURI, Authorization => $aut +hHeaders)); # I am getting a token which is passed in the header. if ($userResponse->is_success) { my $userRecord = decode_json($userResponse->content); print $userResponse->status_line, "\n"; return ($userRecord); } else { displayMsg ( "No user Records to process...................."); print $userResponse->status_line, "\n"; print $userResponse->decoded_content, "\n"; error ("Error: ", $userResponse->status_line, " " , $userResponse- +>decoded_content); exit 1; } }
match digit, followed by hyphen, followed again by digit - then add whitespaces and replace in file
4 direct replies — Read more / Contribute
by fasoli
on Aug 17, 2017 at 08:48

    Hi Wise Monks!

    I've been really confused about a problem I'm having with a file. It's a text file, with 4 columns, and with a few thousand lines. The contents are numbers that look like this

    1.234 5.6789 -1.235

    Those files occur as outputs from a software. The problem is that in some cases the contents look like this

    1.234 5.6789-12.235

    *notice the number of the last column: because now there are 2 numbers before the decimal point, the number gets stuck on the second column.

    Naturally now I'm having trouble plotting this file. So I'm trying to match strings where there is a digit, followed by a hyphen, followed by another digit, and then I want to replace this -hopefully correctly- with an added whitespace so that the numbers are correct.

    I'm trying this and the regex match works, it does print the problematic bits:.

    #!/usr/bin/perl use warnings; use strict; my $test; open my $INPUT, '<', "file.txt" or die $!; while (<$INPUT>) { chomp $_; if ($_=~/(\d)(-)(\d)/) { print "$1$2$3 \n"; } }

    But now I'm stuck: how do I complete the replace action? And how do I print the new contents of the file? I haven't succeeded in anything more than compilation errors. In terms of replacing, I've tried this

       if ($_=~s/(\d)(-)(\d)/(\d)    (-)(\d)/) {  

    (supposedly telling the script to add spaces between the digit before the hyphen and the hyphen itself)

    but I get this error

    Unrecognized escape \d passed through

    Then I tried it with the $1$2$3 but again it was wrong. Can you give me any hints about how to make the replace function work?? Thank you so much!


Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.