%tld_v4_masters = (
        "server1" => "10.1.1.1",
        "server2" => "10.1.1.2",
        "server3" => "10.1.1.3",
        "server4" => "10.1.1.4",
);
%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);
      }
    }
  }
}
[download]

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
[download]

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.

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

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 = "$module.pm") =~ s{::}{/}g;
  ($file) = grep -e, map { "$_/$file" } @inc;
  return undef
    unless $file;
  my $version = MM->parse_version($file);
  eval $version;
}
[download]

Q1) What purpose does this line serve?

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,

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? :-)

I have a simple test script that attempts to create a file and to append an existing file. This is a web-based script hosted by IIS.

When I call this script by putting its URL into a browser running on my PC, the tests pass: one file is created, the other file is appended to. However, if I run a browser on the application server and access the script using a "localhost" URL, I get a permission denied error on both file operations.

If I run the script from the command line on the server, either as an elevated (Run as Administrator) command line or not, the script is able to write to both files

The script is running under IIS's CGI module, not FastCGI, with the Impersonate User option enabled. The site uses Windows Authentication. In both cases, regardless of which browser I use to run the script, I see that the perl.exe process is running as my domain user. I can't figure out why I get different behavior when access the script from a browser running on the server versus a browser running on my own PC. Has anyone ever seen anything like this?

I used the Errno library to get some more info about the permission denied error when opening the files for write/append:

13 Permission denied
5 Access is denied
EVENT_SYSTEM_CONTEXTHELPEND
EMARCH_ENC_I17_IMM5C_INST_WORD_POS_X
EMR_SETBRUSHORGEX
EACCES
ERROR_INVALID_DATA

By the way, my specific Windows user account has explicit access to the folder I'm trying to write to.

As an experiment, I turned off Impersonate User on IIS's CGI module. The perl interpreter runs as DefaultAppPool and does have permission to write to the files.

I am trying to connect Quest Foglight using REST::Client over https. I tried in PostMan tool and it is working over there but it accept authToken in Request Body.

Appreciate if someone could help me to understand how to pass "authToken" in PERL code as Request Body. Below is my code FYR. This is not working as I am new to PERL and don't know how to pass authToken as request body.

Use REST::Client;
my $client = REST::Client->new();
$req = '{"authToken":"<My Auth Token Value>"}';     

# Above value should be passed as request Body. As per Postman Tool.

$url = "https://<my Quest Server>/api/v1/security/login";
$client->POST($url,$req);
print($client->responseCode());
exit();
[download]

I inherited an in-house (rather critical and very well written) Perl application which uses MongoDB as a back end. Replacing this application with another one is not an option for now.

Should I start looking for another DB to completely replace MongoDB (which is a rather daunting task)? If yes, any suggestions?

Should i try to keep the application working using the last version (2.2.0) of the driver?

Any other suggestions?

foreach my $file (keys %hash){
    foreach my $opt (keys %{$hash{$file}}){
        if (!(defined $opt,$hash{$file}->{$opt})){
        say '9809 ', join '|',$file,$opt,$hash{$file}->{$opt};
    }

    $hash{$file}->{$opt}=~s/[^[:ascii:]]//gxms;
    my $lined=join ("\t",$file,$opt,$hash{$file}->{$opt})."\n";
}
[download]

I'm trying to use a Tk::DialogBox in a way that's probably not the simple case it was meant for:

What I don't like is that when I click the default button, if I have an if statement that runs when you do that, it will go ahead and run that statement, but the dialog disappears while the code is still running. I'd like it to at least stay open long enough for the code in the if statement to finish, so the window can display status on its execution.

I know that DialogBox is ultimately derived from Toplevel, and it's probably just removing its window as soon as any of its bottom buttons are clicked because that's what it's written to do.

I've read that Tk::Derived is supposed to support making a derivative copy of a widget so you can then customize, but I've never done that before. Could it all be done inside the same Perl script as the program, or would some sort of external module be needed? What would be needed to make a version of DialogBox that lets you have more control over when the window goes away?

Hello, and as always thank you for help and support.

I have been using LWP::UserAgent with the NWS API using mirror to save API data for several locations once an hour.

Lately the API has been having issues (many other people having issues as well, not just me), but I think part of the issues I am having has to do with me using mirror, and occasionally I will get an older data file from NWS, but it will put a future date for the file date for some reason (July 27, 2020 for example), and then it does not update anymore because the file on the server is newer (but old data).

I am supposed to send User Agent with API requests to NWS. I could go back to just doing GetStore, but don't want to have to change to a UserAgent solution again at some point in the future if I get blocked for not sending it.

I have looked around and there are dozens of different ways to get and store a file from http, but some may be better suited for this case then others. So before I recode this to do some other get store type option instead of doing a mirror type option (I don't really need to check if I already have the same data at this point), are there any other ways/modules that you would recommend? I am not getting webpages, just JSON and XML data sets.</o>

Stick with LWP::UserAgent and use 'get' and then just output the response to a file? HTTP::Tiny? Mechanize? Something completely different?

Thank you!