Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

Seekers of Perl Wisdom

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

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
Modifying muliple matched strings in text
3 direct replies — Read more / Contribute
by nysus
on Jul 12, 2020 at 08:18

    In the following piece of markdown text, I want to replace the spaces with a hyphen and also make the link absolute with a slash in front. So I want to go from:

    blah blah [click me](click me) more stuff blah [link here](link here) blah blah ...


    blah blah [click me](/click-me) more stuff blah [link here](/link-here) blah blah ...

    So this is as far as I got and I'm stymied:

    #!/usr/bin/env perl use strict; use warnings; my $text = "blah blah [click me](click me) more stuff\nblah [link here +](link here) blah blah"; $text =~ s/(\[[^]]+]\()/$1\//g; # make links absolute $text =~ /(\[[^]]+]\(\/)([^\)]+)/; my $part1 = $1; my $part2 = $2; my $orig_part2 = $part2; $part2 =~ s/ /-/g; $text =~ s/\Q$part1$orig_part2\E/$part1$part2/g;

    The obvious problem with this code is that only the first link gets the space replaced:

    blah blah [click me](/click-me) more stuff blah [link here](/link here) blah blah

    I'm drawing a blank on how I might loop through all matches to links and modify those matches. Or maybe there is an entirely better way of pulling this off. Thanks!


    OK, I noodled around with this some more. On a lark, I tried a "global" match (which I didn't know existed outside substitution), and came up with this:

    my $text = "blah blah [click me](click me) more stuff\nblah [link here +](link here) blah blah"; $text =~ s/(\[[^]]+]\()/$1\//g; # make links absolute my @matches = $text =~ /(\[[^]]+]\(\/)([^\)]+)/g; while (@matches) { my $part1 = shift @matches; my $part2 = shift @matches; my $orig_part2 = $part2; $part2 =~ s/ /-/g; $text =~ s/\Q$part1$orig_part2\E/$part1$part2/g; }

    Though it seems to work, I have a hunch this isn't ideal.

    $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

Cannot connect to ?
1 direct reply — Read more / Contribute
by hakonhagland
on Jul 12, 2020 at 07:33
    I have tried for several days to connect to or but I keep getting:
    "Service Unavailable
    The CPAN Testers service is under heavy load and is temporarily unavailable. Please check back in an hour."
    An error was encountered:
    Timeout while fetching data from timeout=30s
    Any ideas what is going on? Are there any alternatives to view the test results for a module? What is the right place to ask for support?
Optree sorrows
No replies — Read more | Post response
by LanX
on Jul 11, 2020 at 17:05

    I noticed that B::Xref had problems listing a subroutine so I took a look into the optree only to see that the name isn't properly displayed there.

    file 1 and 2 are only different in the order of sub definition and call. as you can see at the line marked as ### the name fooxx is missing in version 2.

    What's the problem?

    I actually also did a Xref,-r which was buggy too, (the definition of &fooxx was located in in the file) but the output is just too verbose, to be shown here.

    D:\exp>perl -MO=Xref,-d File Subroutine (main) Package main &fooxx &1 ### syntax OK D:\exp>perl -MO=Xref,-d File Subroutine (main) Package (lexical) &? &4 ### syntax OK D:\exp> D:\exp>type fooxx(); sub fooxx { print @_; } D:\exp>perl -MO=Concise,-stash="main",-main,-src FUNC: *main::fooxx ### 6 <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->6 # 3: print @_; 1 <;> nextstate(main 2 v ->2 5 <@> print sK ->6 2 <0> pushmark s ->3 4 <1> rv2av[t2] lK/1 ->5 3 <#> gv[*_] s ->4 main program: c <@> leave[1 ref] vKP/REFC ->(end) 7 <0> enter ->8 # 1: fooxx(); 8 <;> nextstate(main 1 v:{ ->9 b <1> entersub[t2] vKS/TARG ->c - <1> ex-list K ->b 9 <0> pushmark s ->a - <1> ex-rv2cv sK/1 ->- a <#> gv[*fooxx] s/EARLYCV ->b ### # 6: - <;> ex-nextstate(main 3 v:{ ->c syntax OK D:\exp>type sub fooxx { print @_; } fooxx(); D:\exp>perl -MO=Concise,-stash="main",-main,-src FUNC: *main::constant:: ### 6 <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->6 # 2: print @_; 1 <;> nextstate(main 2 v ->2 5 <@> print sK ->6 2 <0> pushmark s ->3 4 <1> rv2av[t2] lK/1 ->5 3 <#> gv[*_] s ->4 main program: c <@> leave[1 ref] vKP/REFC ->(end) 7 <0> enter ->8 # 4: fooxx(); 8 <;> nextstate(main 3 v:{ ->9 b <1> entersub vKS ->c - <1> ex-list K ->b 9 <0> pushmark s ->a - <1> ex-rv2cv sK/1 ->- a <#> gv[IV \] s ->b ### syntax OK D:\exp>


    B::Deparse seems to get it right though.

    Cheers Rolf
    (addicted to the Perl Programming Language :)
    Wikisyntax for the Monastery

Server hold udp packets in reciev queue
1 direct reply — Read more / Contribute
by throwaway
on Jul 10, 2020 at 22:54
    I am working through a book where it uses perl to learn network programming. With a client written in a similar manner as to this server, the udp datagram is a little bit of text. When I run the program and send the packet it just sits in the receiv queue. I see this using netstat on all listening ports does anyone know how to not have it hold them in there and just process them? #! /usr/bin/perl -w use strict; use Socket; use constant SIMPLE_UDP_PORT => 4001; use constant MAX_RECV_LEN => 1500; use constant LOCAL_INETNAME => 'localhost'; my $trans_serv = getprotobyname('udp'); my $local_host = pack "C4", split('\.', ""); my $local_port = shift || SIMPLE_UDP_PORT; my $local_addr = sockaddr_in($local_port, INADDR_ANY); socket(UDP_SOCK, PF_INET, SOCK_DGRAM, $trans_serv); bind(UDP_SOCK, $local_addr); my $data; while(1) { my $from_who = recv(UDP_SOCK, $data, MAX_RECV_LEN, 0); if ($from_who) { my($the_port, $the_ip) = sockaddr_in($from_who); warn 'Received from ', inet_ntoa($the_ip), ": $data\n"; } else { warn "Problem with recv: $!\n"; } }
Ternary Quizical behaviour?
8 direct replies — Read more / Contribute
by bliako
on Jul 10, 2020 at 07:35

    I have a possibly bad habit to compact boring parts of my code like this:

    if( exists($hash->{akey}) && defined($m=$hash->{akey}) && ($m==1) ){ $ +y = $m; ... } # don't trust $m here

    But in this case it has unexpected results. This is the 1st part where a hash is constructed based on whether a key in another hash exists:

    use strict; use warnings; use Data::Dumper; my %tests = ( 'a' => 10, 'b' => 20, ); my $m; # this seems to assign $m once and never bother to check again my %hash = ( 'b' => exists($tests{'b'}) && defined($m=$tests{'b'}) ? $m : 0, 'a' => exists($tests{'b'}) && defined($m=$tests{'a'}) ? $m : 0, ); print Dumper(\%hash); # this works as expected $m = 10; my %hash2 = ( '1' => $m++, '2' => $m++, '3' => $m++ ); print Dumper(\%hash2);
    $VAR1 = { 'a' => 10, 'b' => 10 }; $VAR1 = { '1' => 10, '2' => 11, '3' => 12 };

    Does anyone have an explanation? And is my habit bad?

1 direct reply — Read more / Contribute
by The_Dj
on Jul 10, 2020 at 00:21
    Greetings Monks!

    Does anyone have any experience in getting Perl to talk to EWS using ADFS authentication?

    My company's Microsoft exchange tech people are friendly but API programming is well beyond their expertise.

    We are migrating from Exchange server to Office365 and I need to migrate my automated mail-based systems. (send and receive)

    Thanks, all.
Net::DNS::Resolver using IPv6 transport in nameservers
1 direct reply — Read more / Contribute
by elsifsheep
on Jul 09, 2020 at 12:48
    I'm trying to use IPv6 addresses in Net::DNS::Resolver and it's not working. Help?
    %tld_v4_masters = ( "server1" => "", "server2" => "", "server3" => "", "server4" => "", ); %tld_v6_masters = ( "server1" => "2620:10a:aaaa::1", "server1" => "2620:10a:aaaa::2", "server1" => "2620:10a:aaaa::3", "server1" => "2620:10a:aaaa::4", ); ###################################################################### +#################### ### SUB: &verifymasters; - Verify and Determine which zone masters to +compare myself against ###################################################################### +#################### sub verifymasters { print "Running verifymasters...\n"; foreach $tryzm (values %$prizms) { print "[DEBUG(verifymasters)] Verifying ZM $tryzm with test candid +ate zone $testcandidate...\n" if ($debug); $res = new Net::DNS::Resolver; $res->tcp_timeout (1) ; $res->retry (1) ; $res->retrans (1) ; $query = $res->nameservers($tryzm); $query = $res->query($testcandidate, "SOA"); my $serial=($query->answer)[0]->serial, if ($query); if (length($serial) > 2) { print "[DEBUG(verifymasters)] Marking ZM $tryzm as GOOD!\n" if ( +$debug); $goodzms++; } else { print "[DEBUG(verifymasters)] Marking ZM $tryzm as BAD!\n" if ($ +debug); } } if ($goodzms < 4) { foreach $tryzm (values %$seczms) { print "[DEBUG(verifymasters)] Verifying ZM $tryzm with test cand +idate zone $testcandidate...\n" if ($debug); $res = new Net::DNS::Resolver; $res->tcp_timeout (1) ; $res->retry (1) ; $res->retrans (1) ; $query = $res->nameservers($tryzm); $query = $res->query($testcandidate, "SOA"); my $serial=($query->answer)[0]->serial, if ($query); if (length($serial) > 2) { print "[DEBUG(verifymasters)] Marking ZM $tryzm as GOOD!\n" if + ($debug); $goodzms++; } else { print "[DEBUG(verifymasters)] Marking ZM $tryzm as BAD!\n" if +($debug); } } } }
    I end up with the IPv4 checks being marked as GOOD, an the IPv6 tests being marked as BAD.
Perl::Critic says don't modify $_ in list functions and other things
9 direct replies — Read more / Contribute
by Lady_Aleena
on Jul 08, 2020 at 21:29

    Hello all. I have been playing around with Per::Critic on the command line and found to my dismay that some of my modules do not pass gentle. I realize that I can ignore the recommendations of Perl critic, but I would love for my modules to pass "gentle" before I begin ignoring things.

    The most common issue is that I modify $_ in list functions. The following is a convenient and short one liner to put the lines of files into a list. I thought doing it this way was nice and slim.

    my @list = map { chomp($_); $_ } <$fh>; my @uc_list = map { chomp $_; [uc $_] } <$lc_fh>; # used only onc +e my @split_list = map { chomp $_; [ split(/\|/, $_) ] } <$piped_fh>; +# used only once

    In one subroutine, I have this three times.

    Also, my idify subroutine is just modifying $_.

    And my Fancy::Map modifies $_ too.

    If this is something ignored usually, I will ignore it, but I would like to know how to make it better. Should I just assign $_ to a variable and then use the variable?

    Another thing that I am confused by is why the expression form of eval is discouraged?

    The rest of the gentle issues are me being lazy with conditionals. While writing I was thinking my $var = "foo" if 'some condition', but Perl critic does not like it, but it is fixed easily.

    NOTE: Please see my update. Most are fixed, but the eval problem remains.

    My OS is Debian 10 (Buster); my perl versions are 5.28.1 local and 5.8.8 on web host.

    No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
    Lady Aleena
Why eval $version?
3 direct replies — Read more / Contribute
by Aldebaran
on Jul 08, 2020 at 18:22

    I'm still processing what I experienced at TPC. I've had time to catch up on some of the youtube videos from the ones I missed. Sometime in all the zooming, I thought I heard one of the presenters say

    that's why we eval version

    I thought it was Sawyer X, who says a lot of things parenthetically, but I went over his talk for a third time and didn't hear it again. I didn't understand what he meant, so I could well have misheard it or just dreamed up the recollection wholesale.

    A couple days later, I'm going through the guts of a test script for local::lib and I see this, beginning line 16 of xt/bootstrap.t

    sub check_version { my ($perl, $module) = @_; my @inc = `$perl -le "print for \@INC"`; chomp @inc; (my $file = "$") =~ s{::}{/}g; ($file) = grep -e, map { "$_/$file" } @inc; return undef unless $file; my $version = MM->parse_version($file); eval $version; }

    Q1) What purpose does this line serve?

     eval $version;

    Q2) Is this a "string eval?"

    Q3) Do dangers lurk in its use, cf. Uri Guttman's 2019 TPC talk on 'eval'?

    Q4) Does anyone else remember the "that's why we eval version" comment, or is it just me?

    Thanks for your comment,

Detect boundaries within .png's - and cropping
6 direct replies — Read more / Contribute
by Stickybit
on Jul 08, 2020 at 02:30

    Hi everyone

    Got at specific problem, that I need some hints on. :-)

    I got a bunch of fixed size .png images with logos. Those logos are centered on the images, and empty space on the left/right of the logo, is transparent background. I need to crop those images on the fly, so that empty space on the left/right of the logo is removed.

    Any hints on how to solve that one? :-)

Add your question
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.
  • 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 browsing the Monastery: (4)
    As of 2020-07-12 20:17 GMT
    Find Nodes?
      Voting Booth?

      No recent polls found