Dear Monks,

After 25+ years of submitting perl modules to the CPAN I feel the need to ask the following question.

I have a module Foo version 1.10. It is packaged for CPAN with Makefile.PL and tests as Foo-1.10.tar.gz.

One of the tests fails under specific circumstances so I fix the test. The module does not need changing.

How can I update the kit version (to e.g. 1.10.1) without having to change the module version?

I have a perl_Tk script which has recently started aborting with the following message.

Can't locate loadable object for module Tk::Canvas in @INC (@INC conta
+ins: C:\Us
ers\Bill\Perl\lib C:/Strawberry/perl/site/lib/MSWin32-x64-multi-thread
+ C:/Strawb
erry/perl/site/lib C:/Strawberry/perl/vendor/lib C:/Strawberry/perl/li
+b) at C:\U
sers\Bill\projects\fractal\mandelbrotTk.pl line 25.
Compilation failed in require at C:/Strawberry/perl/site/lib/Tk/Widget
+.pm line 
268.
[download]

I am using Tk version 804.036001, Strawberry perl 5.38 under windows 7.

Strawberry perl 5.38 is the only perl on my computer. Several months ago I uninstalled a previous version of perl and installed 5.38, then installed Tk with the command cpan Tk. My existing script worked immediately and continued to until some time last week. I am certain that the script has not changed. I am not aware of any changes to perl, Tk, or any of its components, in fact, I have verified that the modules Tk.pm, Tk/widget.pm, and Tk/canvas.pm are all up to date and stored in C:/Strawberry/perl/site/lib. Another Tk script (which does not use canvas) still works.

Does "loadable object" refer to anything other than Tk/canvas.pm? I would appreciate any suggestion on finding and fixing the problem. Of course, I will post any additional material which may be helpful.

This is not directly related to Perl, but it is to allow one of my team to start working on our Perl scripts...

Our Debian 12 webserver has Apache and Plesk installed. All Perl scripts under the webroot have the 'owner' set to a user created by Plesk for that website and the 'group' set to psacln. The 'permissions' for each script is set to 0755.

I log on as root, so have no issue accessing Perl scripts and other files.

I've created an FTP account for a team member and added them to the psacln group. They can read files on the server but cannot edit them because the write permission is set for the owner only. Of course, I could change the permissions to 0775 which would give the FTP account write access but I'm concerned about doing that for two reasons.

1. It seems like a security risk
2. Apache gives a 403 error for scripts set to 0775

I assume Apache can be set to run scripts with the group write bit set. But is this a good idea or is there a better way to give read/write access to an FTP account?

Hi Monks,

Today I decided to practice some Perl by porting a Python script. What took me the most to wrap my head around was working with JSON data using JSON::XS::decode_json. In my example below, this returns an array of hashes, i.e.: [{}, {}, {}]. Therefore, I would've thought that the return value could be inferred as a list, and declared using:

@decoded = decode_json($result);
[download]

But this didn't work as expected, and this threw me off when trying to do something simple like looping on the resulting value. I found a few similar questions online and managed to finish the script, but I was wondering if there's a better way of doing this. In particular, the syntax for my $workspace (@$decoded) seems really weird to me. Do you have any thoughts on this?

For context, I'm using the i3 window manager and I often want to move windows over to the next empty workspace. This problems translates to finding the next non-consecutive number in a sequence of numbers. For example, given the workspaces 1, 2, 3, 5 and 6, while currently focusing workspace 1, this returns workspace #4. If I'm focused on workspace #5, however, it would create a new workspace at #7.

#!/bin/perl

use v5.10;
use strict;
use warnings;

use JSON::XS qw/decode_json/;
use feature qw/say/;

sub main {
    my $result = qx{ i3-msg -t get_workspaces }; # returns [{},{},{}]
    my $decoded = decode_json($result);
    my $current = 0;

    for my $workspace (@$decoded) {

        my $num = $workspace->{'num'};

        if ($workspace->{'focused'}) {
            $current = $num;
            next;
        }

        # Ignore workspaces below the currently focused one.
        if ($current == 0) { next; }

        # Found the gap!
        if ($current + 1 != $num) { last; }

        # Keep increasing the soon-to-be current workspace.
        $current = $num;

    }

    say $current + 1;
}

main();
[download]

And the Python version, in case you want to give some advice on this too! :P

#!/bin/python3

import json
import subprocess

def main():
    result = subprocess.run(
        ['i3-msg', '-t',  'get_workspaces'],
        capture_output=True,
        check=True
    )

    i3_workspaces = json.loads(result.stdout)
    current_workspace = next((x['num'] for x in i3_workspaces if x['fo
+cused']))
    last_workspace = i3_workspaces[-1]['num']
    remaining_workspaces = (x['num'] for x in i3_workspaces if x['num'
+] >= current_workspace)

    for i in range(current_workspace, last_workspace):
        if i != next(remaining_workspaces):
            print(i)
            return

    print(last_workspace + 1)

if __name__ == '__main__':
    main()
[download]

And for some fun, I decided to compare the performance of each. I know it's a really simple script and the test is basically meaningless, but I was curious, and actually the results are surprising to me:

time $(for i in {1..100}; do ./move_to_next.pl> /dev/null; done;)

Perl:
real    0m1.113s
user    0m0.843s
sys     0m0.266s

Python:
real    0m1.852s
user    0m1.516s
sys     0m0.323s
[download]

But then I changed the code to run the loop inside the program itself, basically calling `main` 100 times, and running the test again like so:

time ./move_to_next.pl > /dev/null

Perl:
real    0m0.231s
user    0m0.116s
sys     0m0.116s

Python:
real    0m0.099s
user    0m0.078s
sys     0m0.018s
[download]

So, it seems that spawning the Python interpreter itself is quite costly, but it runs faster on the long run? I also saw a video about how the JSON module in Perl is quite slow, could that be it?

Anyway, thank you in advance!

Suppose you have got an XML file where the Prolog states encoding='ISO-8859-1'. Could you detect via a Perl script whether this file contains any conflicting characters that are not defined in this charset and create a list that identifies these characters?

I am trying to extract (in csv, txt or any human-readable format), the data from the table results in this website: https://desmace.com/provincia/asturias/

According to table headings, I want my script to ask for two dates for the top letf column "FECHA DEL TRAMITE" (prodedure date), and set two fixed dates (always 01/01/1900 and 31/12/2000) in the "FECHA MATRICULA" (plate date) column.

You can also add more columns to the table by clicking in "Columnas" at the topright. By doing this, I add "Prov. Matriculacion", and I also want my script to ask input for this field.

Then, according to this criteria, table results are displayed, and this is what I want to store in csv, txt or similar.

I have this code so far...it runs ok, but does not properly store the data.

I would be super grateful if I can get some help to make the script work.

use strict;
use warnings;
use LWP::Simple;
use HTML::TreeBuilder;
use Text::CSV;
 
# URL of the website
my $url = 'https://desmace.com/provincia/asturias/';
 
# Filter criteria
my $fecha_tramite_min = '24/11/2024';
my $fecha_tramite_max = '27/11/2024';
my $fecha_matricula_min = '01/01/1900';
my $fecha_matricula_max = '31/12/2000';
my $prov_matriculacion_filtro = 'ASTURIAS';
 
# HTML page content
my $html = get($url) or die "No se pudo acceder a la URL: $!";
 
# Parse HTML
my $tree = HTML::TreeBuilder->new;
$tree->parse($html);
 
# Open csv file
my $csv = Text::CSV->new({ binary => 1, eol => "\n" });
open my $fh, ">", "resultados.csv" or die "No se pudo crear el archivo
+ CSV: $!";
 
# Headings for csv file
$csv->print($fh, ['FECHA DEL TRÁMITE', 'TRÁMITE', 'FECHA MATRÍCULA', '
+MARCA', 'MODELO', 'BASTIDOR (VIN)', 'PROV. MATRICULACIÓN']);
 
# This is the table that contains data
my @rows = $tree->look_down(_tag => 'tr');
 
foreach my $row (@rows) {
    my @columns = $row->look_down(_tag => 'td');
    my @data;
   
    # Extract values from columns
    foreach my $col (@columns) {
        push @data, $col->as_text;
    }
   
    # Row filtering
    if (@data >= 9) {
        my ($fecha_tramite, $fecha_matricula, $prov_matriculacion) = @
+data[0, 2, 7];
       
        if ($fecha_tramite ge $fecha_tramite_min && $fecha_tramite le 
+$fecha_tramite_max &&
            $fecha_matricula ge $fecha_matricula_min && $fecha_matricu
+la le $fecha_matricula_max &&
            $prov_matriculacion eq $prov_matriculacion_filtro) {
            $csv->print($fh, \@data);
        }
    }
}
 
# Close file
close $fh;
$tree->delete;
 
print "Datos filtrados guardados en 'resultados.csv'.\n";
[download]

I have a problem with my script

Am getting this error

{"code":401,"message":"Signature has expired"}401 Unauthorized
[download]

Full code

#!/usr/bin/perl - wT

use strict;
use warnings;
use HTTP::Request;
use JSON;
use HTTP::Tiny;
use LWP::UserAgent;
use JSON::WebToken;
use Digest::SHA qw(hmac_sha256_hex);

my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 }, );
$ua->agent("MyApp/0.1");

my $apiKey = 'key';
my $apiSecret = 'secret key';

my $urlcb = "https://api.poloniex.com/v2/wallets/withdraw";
my $url = URI->new($urlcb);
my $urlpath = $url->path();

my $nonce = time;
my %mas = (
"coin" => "USDT",
"network"   => "TRX",
"amount" => "10",
"address" => "TL81N0N8EEf4cAwayizMHuUuo6666666"
);
my $json = encode_json \%mas;

my $signature = hmac_sha256_hex($nonce.'POST'.$urlpath.$json, $apiSecr
+et);
my %payload = (
"key" => $apiKey,
"signatureMethod" => 'HmacSHA256',
"signatureVersion" => '2',
"signTimestamp" => $nonce,
"signature" => $signature
);

my $req = HTTP::Request->new(POST => $url);
$req->content_type('application/json');
$req->header(%payload);
$req->content($json);

my $resp = $ua->request($req);

if ($resp->is_success) {
  print $resp->decoded_content;
  print $resp->status_line, "n";
} else {
  print $resp->decoded_content;
  print $resp->status_line, "n";
}
[download]

I'm trying to write a stupid simple config for my own use.Like in ocaml's view, array is number indexed hash. And like lisp, is comma free. Quotes are used only if necessary.

(ignore (
    (0 ((0 k320w)
        (1 wireless))
    )
    (1 ((0 k330w)
        (1 wireless))
    )
    (2 acer)
    )
)

(config(
    (61 '61 key.kbd')
    (78 '78 key.kbd')
    (mouse mouse.kbd)
    (pad pad.kbd)
)
)
[download]

'ignore' => [
            [
             'k320w',
             'wireless'
            ],
            [
            'k330w',
            'wireless'
            ],
            [
            'acer'
            ]
],
'config' => {
             '61' => '61 key.kbd',
             '78' => '78 key.kbd',
             'mouse' => 'mouse.kbd',
             'pad' => 'pad.kbd'
              },
[download]

It's must be solved in a recursion. Hope it interest some monks

We received this ticket regarding Pod-Coverage-Moose. The user (who shall remain unnamed) apparently was using the RT system to seek support. Any ideas I can forward to the submitter? TIA...

This module is required for testing, so I am installing it. Before building starts in MacPorts package manager it complains:

--->  Configuring p5.34-pod-coverage-moose
Executing:  cd "/opt/local/var/macports/build/_opt_local_var_macports_
+sources_rsync.macports.org_macports_release_tarballs_ports_perl_p5-po
+d-coverage-moose/p5.34-pod-coverage-moose/work/Pod-Coverage-Moose-0.0
+8" && /opt/local/bin/perl5.34 Makefile.PL INSTALLDIRS=vendor CC="/usr
+/bin/clang" LD="/usr/bin/clang" 
*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING **
+*

If you're seeing this warning, your toolchain is really, really old* a
+nd
you'll almost certainly have problems installing CPAN modules from thi
+s
century. But never fear, dear user, for we have the technology to fix 
+this!

If you're using CPAN.pm to install things, then you can upgrade it usi
+ng:

    cpan CPAN

If you're using CPANPLUS to install things, then you can upgrade it us
+ing:

    cpanp CPANPLUS

If you're using cpanminus, you shouldn't be seeing this message in the
+ first
place, so please file an issue on github.

If you're using a packaging tool through a unix distribution, this iss
+ue
should be reported to the package manager.

If you're installing manually, please retrain your fingers to run Buil
+d.PL
when present instead of Makefile.PL.

This public service announcement was brought to you by the Perl Toolch
+ain
Gang, the irc.perl.org #toolchain IRC channel, and the number 42.

----

* Alternatively, you are doing something overly clever, in which case 
+you
should consider setting the 'prefer_installer' config option in CPAN.p
+m, or
'prefer_makefile' in CPANPLUS, to 'mb" and '0' respectively.

You can also silence this warning for future installations by setting 
+the
PERL_MM_FALLBACK_SILENCE_WARNING environment variable.
Checking if your kit is complete...
Looks good
Generating a Unix-style Makefile
Writing Makefile for Pod::Coverage::Moose
[download]

This is Perl 5.34, not really outdated. Most Perl Modules used in toolchain are already in Perl's core. Actually what is causing this warning? Which modules are being checked for their age?

In a character statistics for an XML file, I have found a huge discrepancy between "(" - 4659- and ")" - 5033. Between these parentheses, there might occur a lot of characters including digits or special characters or even XML entities. The opening and closing parenthesis might also be in different XML elements and worst case, they might be distributed across several lines.

I didn't find an answer using "Super Search".

Is there an easy way to locate the non-matching parentheses in such a file?