I feel silly asking this, but...

I know how to set bits, and check for them. What I don't know how to do, nor find on Google,is turn off a specific bit whether it is set or not.

my $stats = 0;
$stats = upload | getTicket | downLoading;
printCLine($stats);
[download]

Yes, I can reset every bit minus the one I want, but that feels kludgy

How to remove the . in the generated string

my $file = shift;

For the above variable it is giving an output like this "./root/git/common/crt_del/cert/DEFAULT.pem"

I want to remove the "." before the /root for that can i use like this $file =~ s{.}{}g or any other way is there to remove that dot in the string

Monks, I come seeking wisdom and am confused by a statement I see.... I inherited a perl code project, and this statement in this foreach loop is confusing me... $chapter will end up being something like "5","7", and "11V"....

foreach my $chapter (.....){
   ( $chapter =~ /5/ )  and ( $chapter = 5 );
   ......
   ......
}
[download]

NB: Not off-topic!

I'm trying to build a one-click solution to switch between various Perl versions on Win for my colleagues.

Using portableshell.bat from strawberries portable versions works very good so far.

It will basically add the needed PATHs in %PATH%

C:\perls\strawberry-perl-5.32.1.1-64bit-portable\perl\site\bin;C:\perls\strawberry-perl-5.32.1.1-64bit-portable\perl\\bin;C:\perls\strawberry-perl-5.32.1.1-64bit-portable\c\bin;C:\Windows\system32;... etc

To make this even more idiot proof (talking about me not my colleagues ;) I'd like to purge all older entries from PATH C:\perls\*;

My BAT-Shell knowhow is limited, I was only able to find a weak solution by replacing C:\perls\ with a dummy DISABLED to "sabotage" those entries, but it'll keep ugly artifacts in the PATH. (I doubt this will insert much of a performance penalty)

So is there a good way to delete those older entries?

(off course I could spawn a perl one-liner, but the basic idea of BAT is to keep the delay minimal)

Thanks

PS: Yes I know about berrybrew, and I will look into it. But for the time being we need to extend this solution to support ActiveState too.

I used to use LWP and Mechanize to download files from the internet, but they stopped working today. Does anyone know what's going on? Thanks!

use strict;
use warnings;
use LWP::UserAgent();

my $ua = LWP::UserAgent->new(timeout => 10);
$ua->env_proxy;

my $response = $ua->get('https://www.sec.gov/Archives/edgar/full-index
+/2019/QTR1/master.idx');

open(OUT, ">" . "master") or die "Cannot open master";
    
if ($response->is_success) {print OUT $response->decoded_content; }
    else {die $response->status_line;}
    

close OUT;
[download]

Good morning,

Can anyone tell me how I would capture a non-printable character from STDIN and test what the character is?

Specifically, I want to test if the escape key has been pressed.

Trying to build a console based text editor.

C:\>perl -MMath::MPFR -MTest::More -e "cmp_ok(Math::MPFR->new(2), '!='
+, Math::MPFR->new(2), 'test for blow up'); done_testing();"
not ok 1 - test for blow up
#   Failed test 'test for blow up'
#   at -e line 1.
Operation "eq": no method found,
        left argument in overloaded package Math::MPFR,
        right argument in overloaded package Math::MPFR at C:/perl-5.3
+4.0/site/lib/Test/Builder.pm line 1006.
A context appears to have been destroyed without first calling release
+().
Based on $@ it does not look like an exception was thrown (this is not
+ always a reliable test)

This is a problem because the global error variables ($!, $@, and $?) 
+will
not be restored. In addition some release callbacks will not work prop
+erly from
inside a DESTROY method.

Here are the context creation details, just in case a tool forgot to c
+all release():
  File: -e
  Line: 1
  Tool: Test::More::cmp_ok

Here is a trace to the code that caused the context to be destroyed, t
+his could
be an exit(), a goto, or simply the end of a scope:
Context destroyed at C:/perl-5.34.0/site/lib/Test/Builder.pm line 1006
+.
        eval {...} called at C:/perl-5.34.0/site/lib/Test/Builder.pm l
+ine 1006
        Test::Builder::cmp_ok(Test::Builder=HASH(0x24eaa60), Math::MPF
+R=SCALAR(0x86b998), "!=", Math::MPFR=SCALAR(0x33cf88), "test for blow
+ up") called at C:/perl-5.34.0/site/lib/Test/More.pm line 511
        Test::More::cmp_ok(Math::MPFR=SCALAR(0x86b998), "!=", Math::MP
+FR=SCALAR(0x33cf88), "test for blow up") called at -e line 1


Cleaning up the CONTEXT stack...
# Tests were run but no plan was declared and done_testing() was not s
+een.
# Looks like your test exited with 255 just after 1.
[download]

...
    unless($ok) {
        $self->$unoverload( \$got, \$expect );

        if( $type =~ /^(eq|==)$/ ) {
            $self->_is_diag( $got, $type, $expect );
        }
        elsif( $type =~ /^(ne|!=)$/ ) {
            no warnings;
            my $eq = ($got eq $expect || $got == $expect) ## LINE 1006
...
[download]

Hello, I'm trying to retrieve the full TCP_INFO socket structure on a macOS system using Perl.

I have no problem retrieving this structure on other systems (Linux, FreeBSD...) using the getsockopt function, but on these systems the structure is less than 256 bytes long.
On macOS, this structure is supposed to be 292 bytes long (296 with padding), as one can see here. When I try to retrieve this structure from Perl using getsockopt on macOS 12.0.1 (Darwin 21.1.0), I only get 256 bytes of data: the last values are missing from the structure.

Is it due to this code from Perl core, which seems to limit getsockopt results to 256 bytes ? And in this case, what can I do to retrieve the full TCP_INFO structure ?

Here is a code snippet to reproduce the problem on macOS:

use Socket qw'PF_INET SOCK_STREAM IPPROTO_TCP inet_aton sockaddr_in';

my $TCP_INFO = ($^O eq 'darwin' ? 0x200 : eval { Socket::TCP_INFO() })
    or die "This system doesn't support the TCP_INFO structure.\n";

my ($testHost,$testPort)=('perl.org',443);

socket(my $sock, PF_INET, SOCK_STREAM, IPPROTO_TCP)
    or die "Could not create socket - $!\n";

my $iaddr=inet_aton($testHost);
my $paddr=sockaddr_in($testPort,$iaddr);
connect($sock,$paddr)
    or die "Failed to connect to $testHost:$testPort - $!\n";

my $tcpInfoData=getsockopt($sock,IPPROTO_TCP,$TCP_INFO)
    or die "Error while calling getsockopt - $!\n";

my $tcpInfoLength=length($tcpInfoData);
if($tcpInfoLength < 256) {
  print "This system doesn't have a TCP_INFO structure large enough to
+ reproduce the problem.\n";
}elsif($tcpInfoLength == 256) {
  print "The TCP_INFO structure seems to be truncated to 256 bytes on 
+this system.\n";
}else{
  print "This system doesn't seem to be affected by the problem.\n";
}
[download]

I am having some difficulty trying to understand how to reconnect this websocket. I have a simple discord bot that i am using to provide services to users at a website i moderate. Everything works as expected except when the gateway operation code '7' (server requests reconnect) is sent to my client. To reconnect/resume a connection, you must send session id, token and sequence number of the last event. I have all of this info already and am not to sure about how to reconnect/resume the websocket connection. I would ask at discord api chat but this isnt a discord problem, its a me not knowing how to reconnect with the lib i am using problem lol. EDIT: Before this code there are a POST and a GET request sent to their servers for authorization and logging the bot in. When i do this i get the session_id and token. those two values are stored in a %globals hash and accessed when needed to reconnect.

here is a snippet from my script:

my $ua = Mojo::UserAgent->new;

$ua->inactivity_timeout(0);
$ua->websocket(
    $gateway . ':443?v=9&application/json, text/plain, */*' => sub {
        my ( $ua, $tx ) = @_;

        # Check if WebSocket handshake was successful
        say 'WebSocket handshake failed!' and return unless $tx->is_we
+bsocket;

        # Wait for WebSocket to be closed
        $tx->on(
            finish => sub {
                my ( $tx, $code, $reason ) = @_;
                say "WebSocket closed with status $code and $reason";
                $ua->websocket->resume;    #would i use the payload he
+re somehow instead of using sub reconnect()?

            }
        );

        $tx->on(
            message => sub {
                my ( $tx, $msg ) = @_;

                my $data    = decode_json($msg);
                my %payload = %$data;

                $globals{'sequence'} = $payload{'s'} if defined $paylo
+ad{'s'};

                for ( $payload{'op'} ) {
                    when ('7') { reconnect( $tx, %payload ) }
                }
            }
        );
    }
);

Mojo::IOLoop->start unless Mojo::IOLoop->is_running;

sub reconnect {

    my $reconnect_payload = {
        op => 6,
        d  => {
            token      => $globals{'token'},
            session_id => $globals{'session_id'},
            seq        =>  defined( $globals{'sequence'} ) ? $globals{
+'sequence'} : 'null'
        },
        s => 'null',
        t => 'null'
    };

    #how to reconnect
}
[download]

The code is not a drop in place and work kind of thing. There could be syntax errors but hopefully this gets the point across of what i am trying to figure out. I just cant figure out how to reconnect.

here are links to their api reference and i am pretty sure i have the payload setup right, I just dont know how to reconnect this websocket when requested.

resume structure sent by client to server to reconnect
server op code payload structure

I'm struggling with something that I thought would be very simple. I have a legacy system which sends data in JSON. The underlying data, which I can't change, uses HTML entities. I need to convert this to UTF8, because a receiving system can't handle the entities. I wrote a one-line test for this, which is failing, and I don't know why.

When I do the conversion on the text itself, it looks fine. When I do the conversion on the JSON, it also looks fine, but when I decode the JSON for the test, it seems to re-convert the UTF8 JSON elements into something wrong. A simple test case:

#!/usr/bin/env perl

use strict;
use warnings;
use HTML::Entities;
use Encode;
use JSON::MaybeXS;

my $original_string = "Eötvös Loránd University";
my $converted_string = encode_utf8( decode_entities($original_string) 
+);

print "Original string: [$original_string]\n"; # shows the entities
print "Converted string: [$converted_string]\n"; # shows the special c
+haracters

my $entities_json = '{"school":"Eötvös Loránd Uni
+versity"}';
my $converted_json = encode_utf8(decode_entities($entities_json));

print "Original JSON: [$entities_json]\n"; # shows the entities
print "Converted JSON: [$converted_json]\n"; # looks right: shows the 
+special characters

my $decoded_json = decode_json($converted_json);

print "School: " . $decoded_json->{'school'} . "\n"; # should be "Eötv
+ös Loránd University" but is actually "�tv�s Lor&#65533
+;nd University", with the special characters messed up (N.B. Perlmonk
+s is showing this incorrectly as well)
[download]