my @executions = $jobInfo->{'content'}{'executions'};
print Dumper (@executions, scalar(@executions));
[download]

$VAR1 = [];
$VAR2 = 1;
[download]

It has been some time since I last used curl2perl (via Corion's HTTP::Request::FromCurl) and I remember it was working perfectly. Now, v0.55, it seems counter-intuitive how the curl's command-line parameters are passed. For example, how to convert this curl command coming out of FF developer tools?:

I tried:

I gives me usage, confused by -H. Ok then let's add all that follows the url into double quotes:

It thinks all headers are part of the first -H:

## Please see file perltidy.ERR

    my $ua = LWP::UserAgent->new('send_te' => '0');
        my $r = HTTP::Request->new(
        'GET' => 'https://example.com/',
        [
            'Accept' => '*/*',
            'User-Agent' => 'curl/7.55.1',
            ''User-Agent' => 'Mozilla/5.0 (X11;)' -H 'Accept: applicat
+ion/json, text/plain, */*' -H 'Accept-Language: en-GB,en;q=0.5''
        ],
        
    );

    my $res = $ua->request( $r,  );
[download]

Changing quotes from single to double and vice-versa gives same result.

What sort of works is when each curl parameter is quoted:

which gives this, notice the extraneous single-quotes:

    my $ua = LWP::UserAgent->new('send_te' => '0');
        my $r = HTTP::Request->new(
        'GET' => 'https://example.com/',
        [
            'Accept' => '*/*',
            'User-Agent' => 'curl/7.55.1',
            ''Accept' => 'application/json, text/plain, */*'',
            ''Accept-Language' => 'en-GB,en;q=0.5'',
            ''User-Agent' => 'Mozilla/5.0 (X11;)''
        ],
        
    );
[download]

But adding all these quotes is way too much work. Plus I am sure that I used it without having to quote anything. All I had to do was to remove the curl from the beginning of the command-line. Perhaps the Getopt::Long should be removed?

What DOES WORK is diy:

use HTTP::Request::FromCurl;
print HTTP::Request::FromCurl->new(command_curl => <<'EOC')->as_snippe
+t;
curl 'http://example.com' --compressed -H 'User-Agent: myagent'
EOC
[download]

(note: when omitting curl, it complains about Can't locate object method "host_port" via package "URI::_generic" ... HTTP/Request/CurlParameters.pm line 457., I mention it just in case this mis-usage reveals something more serious.)

bonus b[au]g: request2perl is missing a use Pod::Usage;.

I hope I am doing something wrong :) or else i write my own (that's a threat hehe :))

I really need some help on my script, am trying to create sever-side back-end script for datatable and its working, am getting the data, seems working for me very well, but the only problem i have is search (filter results)

actually this part in my script is the one disturbing me

if ($search_value) {
    $sql .= "WHERE product LIKE ? OR descp LIKE ?";
    $count_sql .= "WHERE product LIKE ? OR descp LIKE ?";
}
[download]

and this

# Add LIMIT for pagination 
# $sql .= " LIMIT ?, ?"; # i disabled it by comment. because was getti
+ng alot errors with it
[download]

this is the error i get

file.pl: DBD::mysql::st execute failed: You have an error in your SQL 
+syntax; check the manual that corresponds to your MariaDB server vers
+ion for the right syntax to use near 'LIKE '%tam%' OR product LIKE '%
+tam%'' at line 1 at file.pl
[download]

i really need help if someone can look into my script for errors and advice. because i want to hold 1million record and access them via datatable server-side

#!/usr/bin/perl

use strict;
use warnings;
use CGI;
use JSON;
use DBI;

my $q = CGI->new;
print $q->header('content-type: application/json; charset=UTF-8');

my $dsn = "DBI:mysql:database_name:host=localhost";
my $db_user = "user";
my $db_pass = "password";
my $dbh = DBI->connect($dsn, $db_user, $db_pass, { RaiseError => 1, Au
+toCommit => 1 });

my $draw = $q->param('draw') || 1;
my $start = $q->param('start') || 0;
my $length = $q->param('length') || 5;
my $search_value = $q->param('search[value]') || '';

my $total_info = $dbh->prepare("SELECT count(*) FROM t_infos WHERE sta
+tus = ?");
$total_info->execute('bought');
my $infos = $total_info->fetchrow_array(); 
$total_info->finish;

my $count_sql = "SELECT COUNT(*) FROM t_infos";

my $sql = '';

if ($infos >= 1) {

 $sql = "SELECT 
  snd.avatar, snd.fullname, m.product, m.descp, m.price, m.tag, m.seal
+ FROM
  t_infos as m
  JOIN users as snd ON snd.accountnumber = m.accountnum WHERE CASE WHE
+N (SELECT SUM(status = ?) FROM  t_infos) > 0 THEN m.status = ? ELSE m
+.status = ?  OR m.status = ? OR m.status = ? END
  ORDER BY created ASC";
}

if ($infos <= 0) {

  $sql = "SELECT 
  snd.avatar, snd.fullname, m.product, m.descp, m.price, m.tag, m.seal
+ FROM
  t_infos as m
  JOIN users as snd ON snd.accountid = m.accountnum WHERE CASE WHEN (S
+ELECT SUM(status = ?) FROM  t_infos) > 0 THEN m.status = ? ELSE m.sta
+tus = ?  OR m.status = ? OR m.status = ? END
  ORDER BY created ASC LIMIT 100";
}


if ($search_value) {
    $sql .= "WHERE product LIKE ? OR descp LIKE ?";
    $count_sql .= "WHERE product LIKE ? OR descp LIKE ?";
}

# Add LIMIT for pagination but not working if i remove comment
# $sql .= " LIMIT ?, ?";

my $count_sth = $dbh->prepare($count_sql);
if ($search_value) {
    my $search_term = "%$search_value%";
    $count_sth->execute($search_term, $search_term);
} else {
    $count_sth->execute();
}
my ($recordsTotal) = $count_sth->fetchrow_array;
my $recordsFiltered = $recordsTotal; 

my $data_sth = $dbh->prepare($sql);
if ($search_value) {
     my $search_term = "%$search_value%";
     $data_sth->execute($search_term, $search_term, 'bought', 'bought'
+, 'available', 'outstock', 'sold');
} else {
     $data_sth->execute('bought', 'bought', 'available', 'outstock', '
+sold');
}

my @rows;
while (my $row_hash = $data_sth->fetchrow_hashref) {
    push @rows, {
        avatar         => $row_hash->{'avatar'},
        fullname       => $row_hash->{'fullname'},
        product   => $row_hash->{'product'},
        descp     => $row_hash->{'descp'},
        price => $row_hash->{'price'},
        tag     => $row_hash->{'tag'},
        seal     => $row_hash->{'seal'},
    };
}


my %output = (
    "draw" => int($draw),
    "recordsTotal" => int($recordsTotal),
    "recordsFiltered" => int($recordsFiltered),
    "data" => \@rows,
);


my $jsonOutput = encode_json \%output;
print $jsonOutput;


$dbh->disconnect();
[download]

$s = '0123456789';
printf "%x\n", unpack 'Q', pack 'P', $s
    while $s =~ /\G./g;

# 55fd180fcc60
# 55fd18107f30
# 55fd18107ed0
# 55fd180e6700
# 55fd180fcc60
# 55fd18107f30
# 55fd18107ed0
# 55fd180e6700
# 55fd180fcc60
# 55fd18107f30
[download]

Looks like patterns don't matter, both between slashes (the above is for illusion of being useful, supposedly performed daily by thousands) and alternation of addresses, it just picks what's available.

use strict;
use warnings;
use feature 'say';
use Config;

say "$^V / $Config{ archname }";

for my $len ( 1e4, 1e5, 1e6, 1e7 ) {
    my $s = 'a' x $len;

    my %h;
    my @before = times;
    $s =~ /\G./gs and ++ $h{ pack 'P', $s } 
        for 1 .. $len / 100;                    # do just 1% !!!
    my @after = times;

    printf "Length: %8d, addresses: %6d, user: %6g, system: %6g\n",
        $len, scalar( keys %h ), 
        $after[ 0 ] - $before[ 0 ],
        $after[ 1 ] - $before[ 1 ]
}

__END__

v5.40.3 / x86_64-linux-thread-multi
Length:    10000, addresses:      1, user:      0, system:      0
Length:   100000, addresses:      1, user:      0, system:      0
Length:  1000000, addresses:      1, user:   0.01, system:      0
Length: 10000000, addresses:      1, user:   0.02, system:      0

v5.42.0 / x86_64-linux-thread-multi
Length:    10000, addresses:      2, user:      0, system:      0
Length:   100000, addresses:      3, user:   0.01, system:      0
Length:  1000000, addresses:      3, user:   0.39, system:      0
Length: 10000000, addresses:      3, user: 139.87, system:      0

v5.43.8 / x86_64-linux
Length:    10000, addresses:      2, user:      0, system:      0
Length:   100000, addresses:      3, user:   0.01, system:      0
Length:  1000000, addresses:      3, user:   0.38, system:      0
Length: 10000000, addresses:      3, user: 138.75, system:   0.01

v5.42.0 / MSWin32-x64-multi-thread
Length:    10000, addresses:      2, user:      0, system:      0
Length:   100000, addresses:      2, user:      0, system:      0
Length:  1000000, addresses:      2, user:  0.844, system:  1.063
Length: 10000000, addresses:     70, user: 154.453, system: 253.812
[download]

It's much worse on Windows, with absurdly grotesque "system" time (I understand it's approximation for that OS); I can only assume buffers, when long enough (?), are continuously requested to be de-allocated and allocated, from OS, again and again, which is not the case with Perl on Linux.

If there's a bug it's a shock it goes unnoticed, I'm just a no-one. In fact I'm grateful that yesterday it wasn't possible to post, I now see the above is separate from another similar issue from 5.20 and on; better not to mix them together

Hello good monks and nuns. I'm in the build directory for the distribution File::NFSLock working on installing it as I'm doing with hundreds of modules I've made a bundle of on one machine, getting them put in place on a new machine (finally figured out how that works). The tests in File-NFSLock stagger to a halt, freezing up in the code shown below, which is in t/120_single.t

Is it possible that the lock operations are breaking because I have the build directories for these modules on a FAT32 filesystem, rather than NTFS? Wild guess.

# Blocking Exclusive test within a single process (no fork)

use Test::More tests => 2;
use File::NFSLock;
use Fcntl qw(O_CREAT O_RDWR O_RDONLY O_TRUNC LOCK_EX);
use File::Temp qw(tempfile);

my $datafile = (tempfile 'XXXXXXXXXX')[1];

# Create a blank file
sysopen ( my $fh, $datafile, O_CREAT | O_RDWR | O_TRUNC );
close ($fh);
ok (-e $datafile && !-s _);
# Wipe any old stale locks
unlink "$datafile$File::NFSLock::LOCK_EXTENSION";

# Single process trying to count to $n
my $n = 20;

for (my $i = 0; $i < $n ; $i++) {  # <-- we never see output after thi
+s point in the code (Soren)
  my $lock = new File::NFSLock {
    file => $datafile,
    lock_type => LOCK_EX,
  };
  sysopen(my $fh, $datafile, O_RDWR);

  # Read the current value
  my $count = <$fh>;
  # Increment it
  $count ++;

  # And put it back
  seek ($fh,0,0);
  print $fh "$count\n";
  close $fh;
}

# Load up whatever the file says now
sysopen($fh, $datafile, O_RDONLY);
$_ = <$fh>;
close $fh;
chomp;
# It should be the same as the number of times it looped
is $n, $_;

# Wipe the temporary file
unlink $datafile;
[download]

I'm using CygPerl v5.40.3 (5.040003), on Windows 11. I am testing File::NFSLock 1.29. Do any of my good friends in the Cygwin camp here at Perlmonks get the same result? I checked RT @ cpan.org and didn't see any tickets that would apply to what's happening.

EDIT

I ran a test on my first system, that is, the one that the mentioned Bundle:: file came from; it's also Windows 11. The same CygPerl version. Guess what the result was ... yeah, the tests all passed. I have a significant amount to think about from the two (right now) replies below (thanks guys). But before immersion in NFS lore I thought I'd just try that. I have no theories at the moment. I will note, Alexander, that I don't recall ever choosing to install File::NFSLock on my computer. I think something I knowingly meant to install had a dependency on it.

Jan 18, 2026 at 22:04 UTC

i tested a program under 5.42 and 5.38 and it worked the same on both versions. on how many computers would this program produce the expected output?

/usr/bin/perl -v

This is perl 5, version 38, subversion 2 (v5.38.2) built for x86_64-li
+nux-gnu-thread-multi
/usr/bin/perl -E 'srand(80085);say(join("",map({g($_)}("3f5a6471135061
+5c5b4f5867114c5666521f59535b604e57"=~m/../g))));sub g($num){chr(hex($
+num)+int(rand(31)));}'
Just another Perl hacker
[download]

perl -v

This is perl 5, version 42, subversion 0 (v5.42.0) built for x86_64-li
+nux

perl -E 'srand(80085);say(join("",map({g($_)}("3f5a64711350615c5b4f586
+7114c5666521f59535b604e57"=~m/../g))));sub g($num){chr(hex($num)+int(
+rand(31)));}'
Just another Perl hacker
[download]

I have a script that can accept input from STDIN, but only if the proper option is specified (-i -). I want the script to warn if STDIN is not specified but the script is being piped to (echo test | ./script.pl) or if input is redirected (./script < input.txt). I also want it to warn in the opposite case, where STDIN is specified, but the script is not being piped or input is not redirected.

I can detect if STDIN is a pipe with -p STDIN and if STDIN is redirected using (stat STDIN)[0] != 0, but when the script is run under cron, STDIN is a pipe even if the command is not being piped to. The only case under cron where STDIN is not a pipe is if it is redirected input. And testing if STDIN is empty is inadequate, because it's possible that the writing command in a pipeline will not have any output.

Is it possible to do what I'm attempting, or is a bad idea?

use Getopt::Long qw(:config bundling);
GetOptions('input-file|i=s' => \my @file);

my ($stdin_is_redir, $want_stdin) = !! (stat STDIN)[0];
for my $arg (@file) {
    my $fh;
    if ('-' eq $arg) {
        $want_stdin = 1;
        # This is never triggered under cron.
        warn "stdin isn't connected- missing pipe?\n" and next
            unless -p STDIN or ($stdin_is_redir and ! -t STDIN);
        $fh = *STDIN{IO};
    }
    else {
        require Path::Tiny;
        my $file = path($arg);
        $fh = eval { $file->openr } or warn "$file: $@->{err}\n" and n
+ext;
    }
    # do_something($_) while <$fh>;
}

# This is always triggered under cron unless $stdin_is_redir
warn "stdin is connected, missing `-i -`?\n"
    if ! $want_stdin and ! -t STDIN and ($stdin_is_redir or -p STDIN);

# Tested with:
# ./script.pl
# ./script.pl -i -
# ./script.pl -i /dev/null
# ./script.pl -i - < /dev/null
# echo test | ./script.pl
# echo test | ./script.pl -i -
[download]

1. Acme::Tools
2. Alien::CFITSIO
3. Alien::Plotly::Kaleido
4. Alien::TALib
5. App::cpanminus::reporter
6. App::perlfind
7. Astro::Catalog
8. Astro::FITS::CFITSIO
9. Astro::Montenbruck
10. Astro::SpaceTrack
11. CGI-Kwiki
12. CGI::Ajax
13. CGI::Application
14. CGI::Carp
15. CGI::Compress::Gzip
16. CGI::PSGI
17. CGI::Prototype
18. Catalyst::Controller::POD
19. Chart
20. Chart::GGPlot
21. Chart::Kaleido
22. Chart::Plotly
23. Color::RGB Not on CPAN?
24. Devel::Chitin
25. Devel::hdb
26. Dist::Zilla
27. EV
28. File::Fingerprint Not on CPAN?
29. Geo::Compass::Variation
30. Geo::IPinfo
31. Geo::WebService::Elevation::USGS
32. GeoIP2
33. HTML-TableExtract
34. HTML::Template
35. HTTP::Server::Simple
36. HTTP::Server::Simple::PSGI
37. IO::Socket::SSL
38. Imager::File::GIF
39. Imager::File::JPEG
40. Imager::File::PNG
41. Imager::File::TIFF
42. LWP::Protocol::https
43. Markup::Perl
44. Module-Overview
45. Module::XSOrPP
46. Net::SSLeay
47. Pod::Cpandoc
48. SOAP::Lite
49. Syntax
50. Syntax::Feature::EachOnArray
51. Syntax::Keyword::Dynamically
52. Syntax::Keyword::Match
53. Syntax::Keyword::Try
54. Test::WWW::Mechanize
55. Test::WWW::Mechanize::Catalyst
56. URI::ws Not on CPAN?
57. pod2pdf

I use WWW::Mechanize::Chrome but I can't manage to write in a <input>-field that's not inside a form.
According to the docs I need the set_field() method. Maybe it also works with the get_set_value() method but I have no idea here either...

If we assume that the only thing I know about the input-field is that it has the attribute id="foo" and that their is only one of these fields, how can I do this ?
The only progress I made so far is that I managed to create a WWW::Mechanize::Chrome::Node object with $node = $mech->xpath('//input[@id="foo"]', single => 1);