I tried installing Test2::Harness and a couple tests failed. I am not totally understanding the output and if someone knowledgeable could interpret this for me I'd be grateful.

Running make test for EXODIST/Test2-Harness-1.000170.tar.gz
PERL_DL_NONLAZY=1 "/usr/bin/perl.exe" "-Iblib/lib" "-Iblib/arch" test.pl

  FAIL    job 46  +~find_in_updir
  PASS    job 46    + Found file in expected spot
  FAIL    job 46    + Found file in expected spot
  DEBUG   job 46    | t/unit/App/Yath/Util.t line 133
(  DIAG  )  job 46    | +---------+----+-----------------------------------------------------------+
(  DIAG  )  job 46    | | GOT     | OP | CHECK                                                     |
(  DIAG  )  job 46    | +---------+----+-----------------------------------------------------------+
(  DIAG  )  job 46    | | <UNDEF> | =~ | (?^:\/cygdrive\/c\/Users\/somia\/AppData\/Local\/Temp\/ya |
(  DIAG  )  job 46    | |         |    | th\-149000\-j3p7oZ\/tmp\/FJbCQG\/17DQP5yPmV\/thefile$)    |
(  DIAG  )  job 46    | +---------+----+-----------------------------------------------------------+
  PLAN    job 46    | Expected assertions: 2
            job 46    ^
(  DIAG  )  job 46    Failed test 'find_in_updir'
(  DIAG  )  job 46    at t/unit/App/Yath/Util.t line 134.

-------------------------------------------------------------------------------------------

  FAIL    job 57  + /cygdrive/c/Users/somia/AppData/Local/Temp has correct permissions
  DEBUG   job 57    t2/tmp_perms.t line 36

The following jobs failed at least once:
+--------------------+-----------+--------------------+--------------------+
| Job ID             | Times Run | Test File          | Succeeded Eventual |
|                    |           |                    | ly?                |
+--------------------+-----------+--------------------+--------------------+
|                    |           |                    |                    |
| 796D54CF-8067-1014 | 2         | t/unit/App/Yath/Ut | NO                 |
| -B37C-A366FD41E411 |           | il.t               |                    |
|                    |           |                    |                    |
| 7973C25C-8067-1014 | 2         | t2/tmp_perms.t     | NO                 |
| -B37C-A366FD41E411 |           |                    |                    |
+--------------------+-----------+--------------------+--------------------+

The following jobs failed:
+---------------------------------+------------------------+---------------+
| Job ID                          | Test File              | Subtests      |
+---------------------------------+------------------------+---------------+
| 796D54CF-8067-1014-B37C-A366FD4 | t/unit/App/Yath/Util.t | find_in_updir |
| 1E411                           |                        |               |
|                                 |                        |               |
| 7973C25C-8067-1014-B37C-A366FD4 | t2/tmp_perms.t         |               |
| 1E411                           |                        |               |
+---------------------------------+------------------------+---------------+

                                    Yath Result Summary
-------------------------------------------------------------------------------------------
     Fail Count: 2
     File Count: 91
Assertion Count: 1996
      Wall Time: 632.81 seconds
       CPU Time: 1960.39 seconds (usr: 3.67s | sys: 1.70s | cusr: 459.45s | csys: 1495.57s)
      CPU Usage: 309%
    -->  Result: FAILED  <--

yath exited with 256 yath exited with 256
not ok 1 - Passed tests when run by yath (allow fork)
not ok 2 - Passed tests when run by yath (no fork)

-------------------------------------------------------------------------------------------

My Perl and System characteristics:

cygwin_nt-10.0-26200 - 3.7.0
AMD Ryzen 5 4600H with Radeon Graphics (AuthenticAMD 3000MHz) x86_64
Perl (/usr/bin/perl:
This is perl 5, version 40, subversion 3 (v5.40.3) built for x86_64-cygwin-threads-multi

Thanks, all.
    – Soren
Apr 15, 2026 at 18:38 UTC

% perl -MHTTP::Tiny -MJSON::PP -le 'print decode_json(HTTP::Tiny->new-
+>get("https://fastapi.metacpan.org/v1/module/" . shift)->{content})->
+{version}' Encode     
3.21

perl -MHTTP::Tiny -MJSON::PP -le 'print decode_json(HTTP::Tiny->new->g
+et("https://fastapi.metacpan.org/v1/module/" . shift)->{content})->{v
+ersion}' Config
<NOTHING GETS PRINTED>
[download]

fastapi.metacpan.org/v1/module/Encode 

{ "abstract" : "character encodings in Perl"...

fastapi.metacpan.org/v1/module/Config

{ "code" : 404, "message" : "Not found" }
[download]

% perlbrew install -v perl-5.8.9
...
DB_File.xs:998:34: error: incompatible function pointer types assignin
+g to 'u_int32_t (*)(const void *, size_t)' (aka 'unsigned int (*)(con
+st void *, unsigned long)') from 'int (const void *, size_t)' (aka 'i
+nt (const void *, unsigned long)') [-Wincompatible-function-pointer-t
+ypes]
                info->db_HA_hash = hash_cb ;
                                 ^ ~~~~~~~
DB_File.xs:1041:36: error: incompatible function pointer types assigni
+ng to 'size_t (*)(const DBT *, const DBT *)' (aka 'unsigned long (*)(
+const DBT *, const DBT *)') from 'int (const DBT *, const DBT *)' [-W
+incompatible-function-pointer-types]
                info->db_BT_prefix = btree_prefix ;
                                   ^ ~~~~~~~~~~~~
...
308 warnings and 2 errors generated.
make[1]: *** [DB_File.o] Error 1
make: *** [lib/auto/DB_File/DB_File.bundle] Error 2
perl-5.8.9 is successfully installed.

% perlbrew list
* perl-5.42.0                               
  perl-5.38.2   

% perlbrew install -v perl-5.24.4
...
# Failed test 25 - SHA for cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblis
+t/Kid.pm matches stashed SHA at porting/customized.t line 105
#      got "47d2fdf890d7913ccd0e32b5f98a98f75745d227"
# expected "bfd2aa00ca4ed251f342e1d1ad704abbaf5a615e"
porting/customized.t .............................................. 
Failed 1/181 subtests 
...
Test Summary Report
-------------------
porting/customized.t                                            (Wstat
+: 0 Tests: 181 Failed: 1)
  Failed test:  25
porting/libperl.t                                               (Wstat
+: 7424 Tests: 0 Failed: 0)
  Non-zero exit status: 29
  Parse errors: No plan found in TAP output
Files=2410, Tests=850611, 515 wallclock secs (11.99 usr  2.72 sys + 13
+4.39 cusr 16.64 csys = 165.74 CPU)
Result: FAIL
make: *** [test_harness] Error 1
perl-5.24.4 is successfully installed.

% perlbrew list                       
* perl-5.42.0                               
  perl-5.38.2
[download]

Summary of my perl5 (revision 5 version 42 subversion 0) configuration:
   
  Platform:
    osname=darwin
    osvers=23.3.0
    archname=darwin-2level
    gccversion='Apple LLVM 15.0.0 (clang-1500.3.9.4)'

    PERLBREW_PERL="perl-5.42.0"
    PERLBREW_SHELLRC_VERSION="1.02"
    PERLBREW_VERSION="1.02"

I have a fairly complex regexp, consisting of 9 match groups one of which has to match. I'm using copies of the exact same regexp in 4 different spots. All of them should match the same text. However, in one spot I want to access the match parameters as in $1 to $9, while in the other spots only one parameter ($3) and $`, $&, and $' are used.

How do I abstract a regexp so I only need to define and update it in one spot, but still be able to access the capture match groups anyway?

I tried storing the regexp pattern in a string variable then use that variable in the search, but I don't know how to correctly set the variable to a multi-line string (using a here document?) and use that for the pattern. Below is a dump of the working code, then the failing code and the error messages:

            while (not $second and $linking =~
              /(\bINT\s?[0-9A-Fa-f]{2}[Hh]?
                (?:\/(?:E?[ABCD][XHL]|E?[SD]I|E?[SB]P|[DESC]S)=[0-9A-F
+a-f]{2,}[Hh]?)+
                (?:\"[^"]+\")?
               )
              |(\bINT\s?[0-9A-Fa-f]{2}[Hh]?
                (?:\"[^"]+\")?
               )
              |(\b(?:E?A[XHL])=[0-9A-Fa-f]{2,}[Hh]?
                (?:\/(?:E?[ABCD][XHL]|E?[SD]I|E?[SB]P|[DESC]S)=[0-9A-F
+a-f]{2,}[Hh]?)*
                (?:\"[^"]+\")?
               )
              |(\#[0-9A-Z][0-9]{4}\b)
              |(\bMEM\s?[0-9A-Fa-fXx]{1,4}[Hh]?:[0-9A-Fa-fXx]{1,4}[Hh]
+?
                (?:\"[^"]+\")?
               )
              |(\bMEM\s?[0-9A-Fa-fXx]{1,8}[Hh]?
                (?:\"[^"]+\")?
               )
              |(\@[0-9A-Fa-fXx]{1,4}[Hh]?:[0-9A-Fa-fXx]{1,4}[Hh]?
                (?:\"[^"]+\")?
               )
              |(\bPORT\s?[0-9A-Fa-fXx]{1,4}[Hh]?-[0-9A-Fa-fXx]{1,4}[Hh
+]?
                (?:\"[^"]+\")?
               )
              |(\bPORT\s?[0-9A-Fa-fXx]{1,4}[Hh]?
                (?:\"[^"]+\")?
               )
              /x) {
              my $intplus = $1;
              my $intonly = $2;
              my $regonly = $3;
              if (defined $regonly and not defined $int) {
                if (defined $link) {
                  print_or_errorline("Entered reg only link without im
+plicit INT");
                  return;
                }
                $maskhighlight .= " " x (length($`) + length($&));
                $linking = $';
                next;
              }
              my $table = $4;
              my $mem_16_16 = $5;
              my $mem_32 = $6;
              my $call = $7;
              my $portrange = $8;
              my $portsingle = $9;
              $maskhighlight .= " " x length $`;
[download]

            my $linkpattern = <<PATTERNEND;
              (\bINT\s?[0-9A-Fa-f]{2}[Hh]?
                (?:\/(?:E?[ABCD][XHL]|E?[SD]I|E?[SB]P|[DESC]S)=[0-9A-F
+a-f]{2,}[Hh]?)+
                (?:\"[^\"]+\")?
               )
              |(\bINT\s?[0-9A-Fa-f]{2}[Hh]?
                (?:\"[^\"]+\")?
               )
              |(\b(?:E?A[XHL])=[0-9A-Fa-f]{2,}[Hh]?
                (?:\/(?:E?[ABCD][XHL]|E?[SD]I|E?[SB]P|[DESC]S)=[0-9A-F
+a-f]{2,}[Hh]?)*
                (?:\"[^\"]+\")?
               )
              |(\#[0-9A-Z][0-9]{4}\b)
              |(\bMEM\s?[0-9A-Fa-fXx]{1,4}[Hh]?:[0-9A-Fa-fXx]{1,4}[Hh]
+?
                (?:\"[^\"]+\")?
               )
              |(\bMEM\s?[0-9A-Fa-fXx]{1,8}[Hh]?
                (?:\"[^\"]+\")?
               )
              |(\@[0-9A-Fa-fXx]{1,4}[Hh]?:[0-9A-Fa-fXx]{1,4}[Hh]?
                (?:\"[^\"]+\")?
               )
              |(\bPORT\s?[0-9A-Fa-fXx]{1,4}[Hh]?-[0-9A-Fa-fXx]{1,4}[Hh
+]?
                (?:\"[^\"]+\")?
               )
              |(\bPORT\s?[0-9A-Fa-fXx]{1,4}[Hh]?
                (?:\"[^\"]+\")?
               )
PATTERNEND
            while (not $second and $linking =~
              /$linkpattern/x) {
              my $intplus = $1;
              my $intonly = $2;
              my $regonly = $3;
              if (defined $regonly and not defined $int) {
                if (defined $link) {
                  print_or_errorline("Entered reg only link without im
+plicit INT");
                  return;
                }
                $maskhighlight .= " " x (length($`) + length($&));
                $linking = $';
                next;
              }
              my $table = $4;
              my $mem_16_16 = $5;
              my $mem_32 = $6;
              my $call = $7;
              my $portrange = $8;
              my $portsingle = $9;
              $maskhighlight .= " " x length $`;
[download]

Unrecognized escape \s passed through at /home/[user]/proj/tractest/in
+tlist.pl line 419.
Unrecognized escape \s passed through at /home/[user]/proj/tractest/in
+tlist.pl line 419.
Unrecognized escape \s passed through at /home/[user]/proj/tractest/in
+tlist.pl line 419.
Unrecognized escape \s passed through at /home/[user]/proj/tractest/in
+tlist.pl line 419.
Unrecognized escape \s passed through at /home/[user]/proj/tractest/in
+tlist.pl line 419.
Unrecognized escape \s passed through at /home/[user]/proj/tractest/in
+tlist.pl line 419.
Unmatched ( in regex; marked by <-- HERE in m/              INTs?[0-9A
+-Fa-f]{2}[Hh]?
                (?:/(?:E?[ABCD][XHL]|E?[SD]I|E?[SB]P|[DESC]S)=[0-9A-Fa
+-f]{2,}[Hh]?)+
                (?:"[^"]+")?
               )
              |INTs?[0-9A-Fa-f]{2}[Hh]?
                (?:"[^"]+")?
               )
              |(?:E?A[XHL])=[0-9A-Fa-f]{2,}[Hh]?
                (?:/(?:E?[ABCD][XHL]|E?[SD]I|E?[SB]P|[DESC]S)=[0-9A-Fa
+-f]{2,}[Hh]?)*
                (?:"[^"]+")?
               )
              |(#[0-9A-Z][0-9]{4)
               <-- HERE |MEMs?[0-9A-Fa-fXx]{1,4}[Hh]?:[0-9A-Fa-fXx]{1,
+4}[Hh]?
                (?:"[^"]+")?
               )
              |MEMs?[0-9A-Fa-fXx]{1,8}[Hh]?
                (?:"[^"]+")?
               )
              |(@[0-9A-Fa-fXx]{1,4}[Hh]?:[0-9A-Fa-fXx]{1,4}[Hh]?
                (?:"[^"]+")?
               )
              |PORTs?[0-9A-Fa-fXx]{1,4}[Hh]?-[0-9A-Fa-fXx]{1,4}[Hh]?
                (?:"[^"]+")?
               )
              |PORTs?[0-9A-Fa-fXx]{1,4}[Hh]?
                (?:"[^"]+")?
               )
/ at /home/[user]/proj/tractest/intlist.pl line 447, <$array_lstff[...
+]> line 197305.
[download]

I have an NFS file system mounted on many machines. I am attempting to use file locking to get exclusive access by one system to a file. The critical code section shown here:

        # loop through file names looking for one we can lock
        open ( my $file_handle, '+<', $file_name ) or next;
        if ( !flock( $file_handle, LOCK_EX | LOCK_NB ) ) {
            close( $file_handle );
            next;
        }
        # do some work here based on the file contents
        unlink $file_name;
        close( $file_handle );
[download]

This almost always works, but occasionally there is a failure where two machines get a lock on the same file. It appears there is a race between unlinking (deleting) the file and releasing the lock. It seems like there is a small window where the lock is actually released before the file is deleted allowing another machine to lock and read the file before it is deleted.

I am wondering if this is a known problem and if there is a preferred way to work around this.

Been a lurker since ~2k and an active member since ~2k9. Threw a question to "AI" the other day to write a script to safely allow me to update an iptables chain that I need to implement remotely. The result is below. My question for the monks isn't a question. It's a request from an old timer to see if there are any newcomers who can rewrite this script in Perl, properly.

#!/bin/sh
# apply-new-iptables.sh
OLD=/root/iptables-old.rules
NEW=/root/iptables-new.rules
# backup current
iptables-save > "$OLD"
# apply new rules
iptables-restore < "$NEW"
# start rollback timer: restore OLD after 60s if not canceled
( sleep 60 && iptables-restore < "$OLD" ) &
ROLLBACK_PID=$!
echo $ROLLBACK_PID > /tmp/iptables-rollback.pid
echo "New rules applied. To keep them, run: kill $(cat /tmp/iptables-r
+ollback.pid) && rm /tmp/iptables-rollback.pid"
[download]

Hint: there is at least one hugely fundamental issue that AI hallucinated.

-stevieb

Update: Hablo español si prefieres.

Using SIOCGIFCONF looks like an interesting alternative, but the only perl example I found is very non-portable: Re: How do I get the local internet IP address?. sys/ioctl.ph isn't present in any of my perlbrewed perls, and even after running h2ph, it fails with "unsupported architecture" for macOS. But I did confirm with the following C program that SIOCGIFCONF is relatively portable when implemented right: https://gist.github.com/OrangeTide/909204.

Is there an alternative I missed?

Hello.

I am reading a .docx file in Russian. The code $text =~ s/^Испытательная(.*?)/\1/ug; is supposed to process a line by removing part of the text. If the text is written in English, everything is detected and trimmed correctly, but I cannot get it to work with Russian text. In the console, instead of Russian text, I see garbled characters. I've been dancing around encodings — utf8, utf16, cp1251, cp1252 — but none of them give the desired result. Apparently, I am doing something wrong.

Important! When the text is written to a text file from the Word document, it displays correctly.

I would appreciate your help. Thank you.

#!/usr/bin/perl
use Win32::OLE;
use Win32::OLE::Enum;
use utf8;
use strict;

my $text;
my $paragraph;

my $document = Win32::OLE -> GetObject($ARGV[1]);
open (FH,">$ARGV[0]") || die "Can't open file: $!\n";

my $paragraphs = $document->Paragraphs();
my $enumerate = new Win32::OLE::Enum($paragraphs);
while(defined($paragraph = $enumerate->Next()))
{
    $text = $paragraph->{Range}->{Text};
    $text =~ s/^Испытат&#107
+7;льная(.*?)/\1/ug;
    $text =~ s/[\n\r]//g;
    print FH "$text\n";
}
[download]

• First 8 bytes = 64 bit string representing the positions of the white pieces on the board
• Next 8 bytes = 64 bit string representing the positions of the black pieces on the board
• Next 6 bytes = Sixteen 3 bit strings representing the white pieces (pawn, rook, knight, bishop, king, queen)
• Next 1 byte = 1 bit representing black/white's turn, 4 bits representing what type of castling is still possible, 3 bits representing the column the last turn moved the pawn 2 places

That last 3 bits may be hard to understand but in en passant, if your opponent moves 2 places to avoid being attacked by a pawn you already have in position, you have the option to capture that pawn but you must immediately do so on your next turn. These bits serve to either tell you that en passant is possible and which piece is able to be attacked, or if en passant is not possible is set to an invalid column.

• Previous board configurations leading to the three-fold repetition or five-fold repetition draw rules
• Number of previous moves without pawn move or capture for 50/75 move draw rules
• Time remaining for each player if time control is employed

While the 3 or 5 board position repetition is beyond the scope of this approach (you would essentially have to serialize every board from every move), you could fairly easily add a byte or two in order to address time and 50/75 move draw rules if you wanted.

An interesting aspect of the approach I have provided is that you can go with either fixed length records (every serialized board is 23 bytes) or with variable length since the number of white and black pieces can be read from the first 16 bytes.

My question to you is - can you see a way to save any more space? This was a thought experiment so I have no practical use but it did keep me up for a long time so I want to make sure I am not missing something sneaky/creative.

Hi all, with the following test file how do I get prove to report 6 (assertions) rather than 2 (subtests)?

use Test::More;

subtest foo => sub {
    ok 1;
    ok 2;
    ok 3;
};

subtest bar => sub {
    ok 4;
    ok 5;
    ok 6;
};

done_testing;
[download]

Thanks!