I need your wisdom on nesting the rebinding of STDERR to a string buffer (one per nesting level). The communication is all within the same perl program. This is not about capturing STDERR from a system() call or a Pipe.

(Example program at the end of this text. Look for handleOuter() below).

Context: I have to capture the error output of a Perl module in a string buffer, which is already redirecting the error output of a third party module in order to handle the errors. The inner module follows the example given in the perlopentut man page and my outer code is following the same pattern.

The code tries to do a nested redirection of STDERR. It stores the prior buffers handle in an hash object. The outer code redirects STDERR to an $outerbuffer around the calls to the first module, which then redirects STDERR to an $innerbuffer again to capture the errors of some other module which prints on STDERR in case of errors.

It returns to the inner module which restores the binding and reacts to the errors in the $innerbuffer and writes its errors to STDERR and returns to the outer code. The outer code then restores its binding of STDERR and expects the error output or the inner module in $outerbuffer.

Problem: When the inner wrapper restores the binding for STDERR the prior binding of the outer STDERR to $outerbuffer is not restored. The text written by the inner module to STDERR after restoring the binding is not showing up in the $outerbuffer.

Question: How can I recursively rebind and restore STDERR? How can I rebind/restore STDERR in 'restore()' below? Is there a better way to save the prior handle? (Look for 'WHAT TO DO HERE INSTEAD' in the code.)

Pseudo code:


redirect STDERR to $outerbuffer in the classic way of perlopentut
call inner module:
    print STDERR "INNER BEFORE CAPTURE" # go to $outerbuffer
    redirect STDERR to $innerbuffer in the classic way of perlopentut
    call code which reports errors on STDERR eg: "FIRST CAPTURE" 
    #  above output goes to $innerbuffer 
    restore STDERR of $innerbuffer in the classic way of perlopentut
    # From here on printing to STDERR should go to $outerbuffer again 
    # But it does not. 
    code handling $innerbuffer ... 
    print STDERR "inner past restore"  # should go to $outerbuffer (is
+ missing)
print STDERR "outer past call" # should go to $outerbuffer (is missing
+)
restore STDERR of $outerbuffer in the classic way of perlopentut
# From here on STDERR goes to the standard file handle (fd=2)



#handleOuter() is expected to produce:
####################
#handleOuter() is expected to produce:
OUTER BEFORE CAPTURE
INNER BEFORE CAPTURE
INNER AFTER RESTORE
BUFFER (inner): >>FIRST CAPTURE<<
OUTER AFTER RESTORE
BUFFER (outer):
>>OUTER BEFORE CALL\ninner past restore\nouter past call<<

INNER BEFORE CAPTURE
INNER AFTER RESTORE
BUFFER (inner): 
#>>FIRST CAPTURE<<
OUTER AFTER RESTORE
BUFFER (outer): 
#>>INNER BEFORE CAPTURE\ninner past restore<<
[download]

Here comes the wrapper module embedded in a full program.

#!/usr/bin/perl
# Example code from  'perldoc -f open' 
#  
#  Redirect standard stream STDERR to a buffer and then
#   restore the standard stream 
#  With extension of nested redirections (which does not work!)  


###############################################################
package  WrapSTDERR; 
use strict;
use warnings;
use Carp;
use Data::Dumper;

sub capture;
sub restore;

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {
        'buffer' => "", 
        'STREAM' => undef,
        'state'  => 'closed'
    };
    $self = bless $self, $class;    
    return $self;
}

sub DESTROY {
    my $self = shift;
    if ($self->{'state'} eq 'bound') {
        $self->restore();
    }
}

sub capture {
    my $self = shift;

    if ($self->{'state'} eq 'bound') {
        confess "Cannot bind STDERR again while it is bound,"
         ." use another wrapper object.";
    }
    
    # duplicate STDERR filehandle in $self->{'STREAM'}
    open(  $self->{'STREAM'}, ">&STDERR") ## no critic
        or die "Failed to save STDERR";

## WHAT TO DO HERE INSTEAD?
## How to save the previous stream for restore?
## Can I find out whether STDERR is already bound to a string buffer 
#   and save the ref to the buffer for rebinding on restore?

    $self->{'STREAM'}->print(""); # get rid of silly warning message
    close STDERR; # required for open  
    open( STDERR, '>', \$self->{'buffer'} ) or die "Cannot open STDERR
+: $!";
    STDERR->autoflush();
    $self->{'state'} = 'bound';
    return $self; # for chaining with new
}

sub restore {
    my $self = shift;
    if (! $self->{'state'} eq 'bound') {
        confess "Cannot restore STDERR when it is not bound.";
    }
    
    close STDERR; # remove binding to string buffer
    # rebind STDERR to previous handle
    open( STDERR, ">&", $self->{'STREAM'} )   
        or die "Failed to restore STDERR";

## WHAT TO DO ABOVE INSTEAD?
## Can I get the buffer to rebind from the STDERR handle in capture an
+d save it?
## How to restore the binding to the buffer of the previous stream (if
+ there is one)?

    $self->{'STREAM'}->close();
    $self->{'STREAM'}= undef;
    $self->{'state'} = 'closed';
    my $data = $self->{'buffer'};   
    return $data;
}
1;
######################################################################

package main;

sub handleInner {
    print "INNER BEFORE CAPTURE\n";
    my $innerCapture = WrapSTDERR->new()->capture();
    print STDERR "FIRST CAPTURE\n";  # to innerbuffer, works
    my $buffer = $innerCapture->restore();
    chomp $buffer;
    print "INNER AFTER RESTORE\n";
    print STDERR "inner past restore\n";  
        # above goes to console or the outerbuffer, 
        #   it fails for outerbuffer when called from handleOuter
    print "BUFFER (inner): \n#>>$buffer<<\n";
}


sub handleOuter {
    print "OUTER BEFORE CAPTURE\n";
    my $outerCapture = WrapSTDERR->new()->capture();
    print STDERR "OUTER BEFORE CALL\n"; # to outerbuffer
    handleInner();
    print STDERR "outer past call\n"; # to outerbuffer
    #    (It does not go to the buffer in $outerCapture,
        #     which is the topic of this question)
    my $buffer = $outerCapture->restore();
    chomp $buffer;
    print "OUTER PAST RESTORE\n";
    print "BUFFER (outer): \n#>>$buffer<<\n";
}

handleInner();
#prints this: 
# INNER BEFORE CAPTURE
# INNER AFTER RESTORE
# INNER PAST RESTORE
# BUFFER (inner):
#>>FIRST CAPTURE<<

print "####################\n";

handleOuter();
#prints this:
# OUTER BEFORE CAPTURE
# INNER BEFORE CAPTURE
# INNER AFTER RESTORE
# BUFFER (inner): >>FIRST CAPTURE<<
# OUTER AFTER RESTORE
# BUFFER (outer):
#>>OUTER BEFORE CALL<<

# Above line is not correct.  

#handleOuter() is expected to produce:
# OUTER BEFORE CAPTURE
# INNER BEFORE CAPTURE
# INNER AFTER RESTORE
# BUFFER (inner): >>FIRST CAPTURE<<
# OUTER AFTER RESTORE
# BUFFER (outer):
#>>OUTER BEFORE CALL\ninner past restore\nouter past call<<
[download]

In a previous reply (Re: Use of BEGIN block) , pfaut suggested using BEGIN and END blocks with the Command Switch n . Here is a complete example.

#!perl -n
use strict;
use warnings;
# USAGE:  perl np.pl <np.dat
BEGIN{
    our $total = 0;
}

our $total;
$total += $_;

END{
    our $total;
    print $total
}
[download]

Note that the package variable $total is in scope in all three blocks because it is declared in each with our. Is there a preferred way to do this? I understand that without strict, no declaration is necessary and with the use vars syntax, there is no restriction on scope.

I have an online game with the game server written in Perl 5.32 hosted on Amazon Linux where players connect from their browser using web sockets. In addition to real players connecting, Bot players can also connect which is via a Perl script on the same server where the game server is running. The game works fine but of course you have to consider cases where a user wants to explicitly quit the game, closes their browser (or tab) or refreshes their browser tab. To deal with these I set an alarm for 1 second whenever getting a disconnect. If a player was just refreshing their browser, they will reconnect immediately cancelling the alarm and all is good. If they were explicitly quitting or closed their browser tab, there will be no reconnect and the alarm should go off and the sub will remove them from the game. This all works fine when it's just real players in a game all connected from their browser. However, when there is one or more bots connected and one of the real players disconnects, the alarm is set but NEVER goes off.

The failure occurs the next time the game server has to send a message out to all connected players. Since the alarm didn't go off, that disconnected player didn't get removed from the list. And when time the game server tries to send a message to that player, it pukes due to a syswrite error on the socket that was internally closed.

I have tried using unsafe signals and POSIX signal handler but neither of these work any differently or better.

$conn->on(
    disconnect => sub {
        my $disconnectPlayer = $self->{players}->getPlayerWithSocket( 
+$conn );
        $SIG{ALRM} = sub { $self->playerDisconnected() };
        $self->{playerDisconnected} = 1;
        $self->{disconnectedPlayerSocket} = $conn;
        alarm( 1 );
    }
);
[download]

So the bottom line is, why would the alarm be affected by having an incoming web socket connection from a process on the local host?

use strict;
use warnings;
use Fcntl;
use Inline C => Config => LIBS => '-lkernel32', BUILD_NOISY => 1, type
+maps => 'typemap';
use Inline C => <<'END_OF_C_CODE';

#include <windows.h>
#include <winbase.h>
void*
map_region(int filehandle, DWORD size, DWORD prot){
    HANDLE hMap = CreateFileMapping((HANDLE)filehandle, NULL, prot, 0,
+ size, NULL);
    LPVOID addr = MapViewOfFile(hMap, FILE_MAP_ALL_ACCESS, 0, 0, size)
+;
    CloseHandle(hMap);
    return addr;
}
int
unmap_region(void* addr, DWORD size){
    return UnmapViewOfFile(addr);
}
END_OF_C_CODE
my $test_file = 'test_mmap.bin';

sysopen(my $fh, $test_file, O_RDWR|O_CREAT|O_TRUNC)
  or die "can't open: $!";
binmode $fh;
my $size = 4096;
my $addr = map_region(fileno($fh), $size, 0x04)
  or die "mmap failed!!:  $^E ";

my $test_str = "Hello Windows mmap!";
syswrite($fh, $test_str);

unmap_region($addr, $size) or die "fail to unmap";
[download]

Beside: here is the typemap

BOOL            T_IV
LONG            T_IV
HANDLE            T_IV
HWND                    T_IV
HMENU                   T_IV
HKEY            T_IV
SECURITY_INFORMATION    T_UV
DWORD            T_UV
UINT                    T_UV
REGSAM            T_UV
WPARAM                  T_UV
LPARAM                  T_IV
LPVOID                  T_UV
HANDLE                  T_UV
SIZE_T                  T_UV
DibSect *         O_OBJECT

######################################################################
+#######
INPUT
T_UV
    $var = ($type)SvUV($arg)

######################################################################
+#######
OUTPUT
T_UV
    sv_setuv($arg, (UV)$var);
[download]

I am packaging a new perl distribution ( because https://pault.com/perl.html ) and I am looking for perl users, who might want to give it a try. I need to figure out a lot of stuff with current perl situation, so I tried to subscribe to various perl mailing lists that used to work 20 years ago and they simply do not work now. Somehow. Do you guys and gals know, how can I find the active Perl mailing lists? I only need to find a few people who care about perl as a language and would like to use perl for new challenges. Perl is the only language that makes sense to me last few years and I would keep it going. I have 70% done, planning to turn into 100% next few months.

Hello Monks!

I'm writing mod-perl handler scripts to run on Apache 2.4 under Ubuntu 24.04. I'm using mod_authnz_ldap to connect to an Active Directory for authentication and authorization. mod_authnz_ldap relies on mod-ldap and the docs for mod-ldap only discuss it providing LDAP services to other modules.

My handler script needs to make several LDAP queries and I would like to take advantage of mod-ldap's persistent connections and operation cache.

Is this possible? It's very hard to find relevant documentation on the web because of the huge number of search results regarding authentication, authorization, Net::LDAP and, of course, Apache's own Directory Server software. Can anyone point me at relevant material or give me some hints?

Yours,

<°}}}>«<

Hello, Monks!

I come seeking your wisdom once more. Today, the question that I have is a simple matter of loops and how they work when they happen within functions such as grep.

This is my code:

for my $component ( split(/,/, $components_csv) ) {
    if (grep { $_ eq $component } @url_components) {
        push( @selected_components, $component);
        next;
    }

    # ...
}
[download]

In this example, the next keyword: would take me to the next iteration of grep, or to the next iteration of the outer for loop? I could use a label to handle this, but I'm not sure if I need to.

Thank you, cheers.