I don't see a better place than SoPW at the Monastery to put this so I'll just dump it here and see what happens.

Just a simple inquiry: I just ran cpan (not cpanplus, which I post about a lot); I entered the command r for "reporting outdated/upgradeable modules" and cpan reported 92 unparseable module versions. Whoa. That makes me want to ask: is it really that difficult to write a package with a sane / parseable version? Or is cpan's programmatic notions of "parseable" odd or too strict? Opinions and knowledge welcomed.

  Soren

$ python -c 'import regex; print(regex.sub("^(?<a>.)|(?<c>.)$|(?<b>.)"
+, lambda m:m.lastgroup, "xxx"))'
abc
[download]

$ perl -E'say "xxx" =~ s/^(?<a>.)|(?<c>.)$|(?<b>.)/@{[keys %+]}/gr'
abc
[download]

How can I convert MySQL datetime format without considering time

my $last_update = ('2025-06-30 14:40:26'); #convert to days without co
+nsidering time

if ($last_update < 20) { # if last update was done less than 20 days a
+go
print "20 days has not passed for you to update again"
}
[download]

Having an issue with code below. It's to be for a one-time pad encryption routine (just for fun).

Having an issue with binmode input and output. Losing a byte at the very end of output file. Not sure whether it happens on read or write. Someone please point out my error. TIA

#!user/bin/perl -w

my $infile = '/home/me/Documents/Sample.txt';
my $outfile = '/home/me/Documents/Sample_Copy.txt';

open(IN, "< $infile") or die "Can't open $infile: $!";
binmode IN;

open(OUT, "> $outfile") or die "Can't open $outfile: $!";
binmode OUT;

my $blksize = (stat IN)[11] || 16384; 
print "\nBlock Size = $blksize\n";

my @bufAry = [];

while (my $len = sysread IN, my $buf, $blksize)
{ if (!defined $len)
  { next if $! =~ /^Interrupted/;
    die "System read error: $!\n";
  }

  @bufAry = unpack('I*', $buf);        # Disassemble buf into array.
    print "\nIn = " . scalar @bufAry;
  
  # Encryption subs here...
  
  undef($buf);                # Barrier to buf falling through.

    # Decryption subs here...
  
  $buf = pack('I*', @bufAry);        # Reassemble buf from array.
    print " Out = " . scalar @bufAry;
  
  $offset = 0;
  while ($len)
  { defined($written = syswrite OUT, $buf, $len, $offset)
    or die "System write error: $!\n";
        last if $written == 0;        # Avoid infinite loop.
    $len -= $written;
    $offset += $written;
  }
    print "\n";
}

close(IN);
close(OUT);
[download]

OFFSET_BITS=64 -D_FORTIFY_SOURCE=2 -O2   -DVERSION=\"2.40014\" -DXS_VE
+RSION=\"2.40014\" -fPIC "-I/home/perlbrew/perl5/perlbrew/perls/perl-5
+.26.2/lib/5.26.2/x86_64-linux/CORE"  -DHAVE_S
OCKET -DHAVE_POLL -DAMQ_PLATFORM='"Perl_linux_v5.26.2"' -DNAR_HAVE_OPE
+NSSL amqp_mem.c
cc -c  -I. -Irabbitmq-include -Irabbitmq-c/include -Irabbitmq-include/
+unix -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/u
+sr/local/include -D_LARGEFILE_SOURCE -D_FILE_
OFFSET_BITS=64 -D_FORTIFY_SOURCE=2 -O2   -DVERSION=\"2.40014\" -DXS_VE
+RSION=\"2.40014\" -fPIC "-I/home/perlbrew/perl5/perlbrew/perls/perl-5
+.26.2/lib/5.26.2/x86_64-linux/CORE"  -DHAVE_S
OCKET -DHAVE_POLL -DAMQ_PLATFORM='"Perl_linux_v5.26.2"' -DNAR_HAVE_OPE
+NSSL amqp_openssl.c
amqp_openssl.c: In function ‘amqp_ssl_socket_open’:
amqp_openssl.c:182:3: warning: passing argument 1 of ‘BIO_new’ discard
+s ‘const’ qualifier from pointer target type [enabled by default]
   bio = BIO_new(amqp_openssl_bio());
   ^
In file included from rabbitmq-include/amqp_openssl_bio.h:10:0,
                 from amqp_openssl.c:15:
/usr/include/openssl/bio.h:659:6: note: expected ‘struct BIO_METHOD *’
+ but argument is of type ‘BIO_METHOD_PTR’
 BIO *BIO_new(BIO_METHOD *type);
      ^
amqp_openssl.c: In function ‘amqp_ssl_socket_new’:
amqp_openssl.c:339:3: warning: passing argument 1 of ‘SSL_CTX_new’ mak
+es pointer from integer without a cast [enabled by default]
   self->ctx = SSL_CTX_new(TLS_client_method());
   ^
In file included from amqp_openssl.c:31:0:
/usr/include/openssl/ssl.h:2087:10: note: expected ‘const struct SSL_M
+ETHOD *’ but argument is of type ‘int’
 SSL_CTX *SSL_CTX_new(const SSL_METHOD *meth);
          ^
amqp_openssl.c: In function ‘get_tls_version’:
amqp_openssl.c:547:22: error: ‘TLS1_3_VERSION’ undeclared (first use i
+n this function)
       *tls_version = TLS1_3_VERSION;
                      ^
amqp_openssl.c:547:22: note: each undeclared identifier is reported on
+ly once for each function it appears in
make: *** [amqp_openssl.o] Error 1
-> FAIL Installing Net::AMQP::RabbitMQ failed. See /root/.cpanm/work/1
+751032905.481/build.log for details. Retry with --force to force inst
+all it.
[download]

Hi monks and nuns of the Monastery. I'm having trouble setting up cpanplus running on Gnu/Linux to use a partial cpan mirror (a Mini-cpan created with the code of that name) ...on another Linux system on my LAN. On that server I have apache running and serving (a few) static web pages successfully. I acknowledge that this question may have less to do with Perl and more with system administration & configuration, but there are undoubtedly monks here who are very good at that stuff too.

Here's a snippet of what my cpanplus config currently holds:

    $Conf->{'conf'}->{'hosts'} = [
            {
                'scheme' => 'http',
                'path' => '/www/public/minicpan',
                'host' => '192.168.1.7'
            },

            {
                'scheme' => 'http',
                'path' => '/',
                'host' => 'www.cpan.org'
            },
        ];
[download]

I've tried the following variations on path =>:

/minicpan
/public/minicpan
/www/public/minicpan

But none of these work. The failure is seen as

CPAN Terminal> i Archive::Any --verbose

  Installing Archive::Any (0.0946)
  [MSG] Trying to get 'http://192.168.1.7/www/public/minicpan/authors/
+id/O/OA/OALDERS/Archive-Any-0.0946.tar.gz'
  Fetch failed! HTTP response: 404 Not Found [404 Not Found] at /usr/l
+ocal/lib/perl5/site_perl/CPANPLUS/Internals/Fetch.pm line 398.
[download]

That's pretty clear. One more detail I ought to add is that my minicpan is actually located in /var/mirrors/minicpan:

total 32
drwxr-xr-x 3 somian somian  4096 Jun 23 14:51 authors
drwxr-xr-x 2 somian somian  4096 Jun 23 14:51 modules
-rw-r--r-- 1 somian somian 23768 Jun 23 14:51 RECENT

and I've made a symlink to /var/mirrors/minicpan from /var/www/public/minicpan. Does this seem like a sane setup? I'd be really jazzed if I could get it to work. Thanks in advance for giving me a look.

  Soren

How can i have an output like this

from string values, i dont want to use array

my $string = (+book +dog +cat);
print join(',', $string), "\n";
[download]

but my main target is to get what entered from html and join it like this

$string = $q->param("us1"); # this is what entered +book +dog +cat
print join(',', $string), "\n";
[download]

output like this

I would like to be able to read my Chrome cookies on a Mac.

My understanding is that I can use HTTP::Cookies::Chrome to do this. The following is an example script I pulled from the git repository and modified it for my Chrome profile.

When I run it I get the attached failure messages with no other output. Any help or pointers are much appreciated.

Thanks

Craig

Script:

#!/opt/homebrew/bin/perl
use v5.10;
use strict;
use warnings;

use Mojo::Util qw(dumper);

use HTTP::Cookies::Chrome;

my $class    = 'HTTP::Cookies::Chrome';
#my $path     = $class->guess_path;
my $path     = '/Users/cmv/Library/Application Support/Google/Chrome/P
+rofile 1/Cookies';
my $password = $class->guess_password;

say <<~"HERE";
    File: $path
    Pass: $password
    HERE

my $cookies = HTTP::Cookies::Chrome->new(
    chrome_safe_storage_password => $password,
    ignore_discard => 0,
    );
$cookies->load( $path );

$cookies->scan( \&summary );

sub summary {
    state $previous_domain = '';
    my( @cookie ) = @_;
    say $cookie[4] unless $cookie[4] eq $previous_domain;
    $previous_domain = $cookie[4];
    printf "\t%-5s %-16s %s\n", map { $_ // '' } @cookie[3,1,2];
    }
[download]

Errors:

Hello all,

I receive such json file as input. As you can see it is an array of objects where each object is an array of sub-objects. Brief it is a collection of nested objects and arrays. I don't know in advance the structure, the name of the keys and the levels of nesting. Or even it can also be the other way around, a collection of objects with arrays nested on it. The only thing I should know is the object identifier "key name" found at level 2 (in my example "Obj11Id", "Obj12Id", etc). My goal is for each pair of key name and value, to have the "full path" of the key name and the key value. By "full path" I understand the name of the above keys in the structure.

Example: for the pair "Obj11AttributesObj1Key1": "1", the "full path" would be: "Obj1.Obj11Attributes.Obj11AttributesObj1.Obj11AttributesObj1Key1" (dot "." being the separator of the above keys).

I'm new in Perl, I've tried many ways to obtain this info but failed. I'm using the library JSON::PP and function decode_json.

Thank you

The input json file:

[
    {
        "Obj1": [
            {
                "Obj11Id": "Id11",
                "Obj11Version": "v1",
                "Obj11Attributes": {
                    "Obj11AttributesObj1": {
                        "Obj11AttributesObj1Key1": "1",
                        "Obj11AttributesObj1Key2": "3"
                    },
                    "Obj11AttributesObj2": {
                        "Obj11AttributesObj2Key1": "9"
                    }
                }
            },
            {
                "Obj12Id": "Id12",
                "Obj12Version": "v1",
                "Obj12Attributes": {
                    "Obj12AttributesObj1": {
                        "Obj12AttributesObj1Key1": "2",
                        "Obj12AttributesObj1Key2": "4"
                    },
                    "Obj12AttributesObj2": {
                        "Obj12AttributesObj2Key1": "8"
                    },
                    "Obj12AttributesArray1": [
                        {
                            "Obj12AttributesArray1Obj1Key1": 1
                        }
                    ]
                }
            }
        ]
    },
    {
        "Obj2": [
            {
                "Obj21Id": "Id21",
                "Obj21Version": "v1",
                "Obj21Attributes": {
                    "Obj21AttributesObj1": {
                        "Obj21AttributesObj1Key1": "3",
                        "Obj21AttributesObj1Key2": "5"
                    },
                    "Obj21AttributesObj2": {
                        "Obj21AttributesObj2Key1": "7"
                    }
                }
            },
            {
                "Obj22Id": "Id22",
                "Obj22Version": "v1",
                "Obj22Attributes": {
                    "Obj22AttributesObj1": {
                        "Obj22AttributesObj1Key1": "4",
                        "Obj22AttributesObj1Key2": "6"
                    },
                    "Obj22AttributesObj2": {
                        "Obj22AttributesObj2Key1": "0"
                    },
                    "Obj22AttributesArray1": [
                        {
                            "Obj22AttributesArray1Obj1Key1": 1
                        }
                    ]
                }
            }
        ]
    }
]
[download]