Hi all.

I'm working with a fleet of devices running Perl on a ARM chipset (armhf) that are experiencing an infrequent, random crash in SQL::Abstract (via DBIx::Class). I've not yet been able to reproduce it manually, our only clue to go off of has been the following log statement.

panic: stack_grow() negative count (-16777216) at /usr/share/perl5/SQL/Abstract.pm line 1493

I've found similar threads of https://rt-cpan.github.io/Public/Bug/Display/108578/ and https://github.com/Perl/perl5/issues/15013. But neither of which were fruitful.

My first observation was that -16777216 is 0xFF000000 as a 32-bit signed value. This makes me think it's due to a unsigned to signed cast gone wrong. However, adding 16 MiB to the stack seems incorrect as well. To me this screams memory corruption or an uninitialized value.

I ran it with the -d flag to get the following stack trace:

@ = SQL::Abstract::_join_sql_clauses(ref(DBIx::Class::SQLMaker), 'and'
+, ref(ARRAY), ref(ARRAY)) called from file '/usr/share/perl5/SQL/Abst
+ract.pm' line 678
@ = SQL::Abstract::_where_HASHREF(ref(DBIx::Class::SQLMaker), ref(HASH
+), undef) called from file '/usr/share/perl5/SQL/Abstract.pm' line 54
+5
@ = SQL::Abstract::_recurse_where(ref(DBIx::Class::SQLMaker), ref(HASH
+)) called from file '/usr/share/perl5/SQL/Abstract.pm' line 525
@ = SQL::Abstract::where(ref(DBIx::Class::SQLMaker), ref(HASH), ref(HA
+SH)) called from file '/usr/share/perl5/SQL/Abstract.pm' line 469
@ = SQL::Abstract::select(ref(DBIx::Class::SQLMaker), ref(ARRAY), 'me.
+id, me.name, me.value, me.modified_at', ref(HASH), ref(HASH)) called 
+from file '/usr/share/perl5/DBIx/Class/SQLMaker.pm' line 172
@ = DBIx::Class::SQLMaker::select(ref(DBIx::Class::SQLMaker), ref(ARRA
+Y), ref(ARRAY), ref(HASH), ref(HASH)) called from file '/usr/share/pe
+rl5/DBIx/Class/Storage/DBI.pm' line 1679
@ = DBIx::Class::Storage::DBI::_gen_sql_bind(ref(DBIx::Class::Storage:
+:DBI::Pg), 'select', ref(ARRAY), ref(ARRAY)) called from file '/usr/s
+hare/perl5/DBIx/Class/Storage/DBI.pm' line 1666
@ = DBIx::Class::Storage::DBI::_prep_for_execute(ref(DBIx::Class::Stor
+age::DBI::Pg), 'select', ref(ARRAY), ref(ARRAY)) called from file '/u
+sr/share/perl5/DBIx/Class/Storage/DBI.pm' line 1810
@ = DBIx::Class::Storage::DBI::_execute(ref(DBIx::Class::Storage::DBI:
+:Pg), 'select', ref(ARRAY), ref(ARRAY), ref(HASH), ref(HASH)) called 
+from file '/usr/share/perl5/DBIx/Class/Storage/DBI.pm' line 2409
@ = DBIx::Class::Storage::DBI::_select(ref(DBIx::Class::Storage::DBI::
+Pg), ref(ARRAY), ref(ARRAY), ref(HASH), ref(HASH)) called from file '
+/usr/share/perl5/DBIx/Class/Storage/DBI.pm' line 2586
@ = DBIx::Class::Storage::DBI::select_single(ref(DBIx::Class::Storage:
+:DBI::Pg), ref(ARRAY), ref(ARRAY), ref(HASH), ref(HASH)) called from 
+file '/usr/share/perl5/DBIx/Class/ResultSet.pm' line 1104
[download]

This puts us at the following function and line of the crash: https://github.com/dbsrgits/sql-abstract/blob/2972827e573b0217735b901088e69c994ba8d226/lib/SQL/Abstract.pm#L1493

sub _join_sql_clauses {
  my ($self, $logic, $clauses_aref, $bind_aref) = @_;

  if (@$clauses_aref > 1) {
    my $join  = " " . $self->_sqlcase($logic) . " ";
    my $sql = '( ' . join($join, @$clauses_aref) . ' )';
    return ($sql, @$bind_aref);
  }
  elsif (@$clauses_aref) {
    ##### CRASH TRIGGERED ON LINE 1493 BELOW #####
    return ($clauses_aref->[0], @$bind_aref); # no parentheses
  }
  else {
    return (); # if no SQL, ignore @$bind_aref
  }
}
[download]

However, trying to add a breakpoint to stack_grow() fails. From further research this is an internal symbol, so does not have a subroutine to match.

My questions are:

• How does stack_grow get called when returning an array like in the above _join_sql_clauses?
• Is there a way to include internal symbol calls (stack_grow) in the Perl debugger? If not, how would you go about tracking that call?
• Does this indicate a memory corruption? If so, are there any Perl tools to help debug such an issue?

Versions: Perl version: 5.32.1 DBIx::Class version: 0.082841 SQL::Abstract version: 1.87

I appreciate any and all feedback, thank you all in advance. - Casey

Hello. I built a small local database in Postgres and use some perl scripts to load and update data, and then to extract for some reports. My scripts use the standard DBI module:

use DBI;
$dbh = DBI->connect("dbi:Pg:dbname=mydb;host=localhost;port=5432;",
                    $username,
                    $password,
                    {AutoCommit => 0, RaiseError => 1, PrintError => 0
+}
                   );
[download]

Now, I have to move my local database model to an AmazonAWS Postgres database, which it is using an SSL tunnel (a second hostname and port). Also, as my localhost is outside of the HQ, I had to connect my box to there using a VPN in order to be able to access AWS.

I was given some credentials and a PEM file, so I can connect to that database server using the pgAdmin tool, but I cannot figure out how to implement that kind of connection in my scripts. I'm not sure if the sslmode connect string option is useful in this case...

Any idea on how to configure the connect string? Should I use another module as a wrapper?

Thanks...

It is zipping all of them into just one file and I know it must be something simple that I am missing.

#!/usr/bin/perl
use IO::Compress::Zip qw(:all);
$path='/DATA/DOCUMENTS/';
opendir my $dh, $path;
my @files = readdir $dh;
foreach my $files (@files){
print "$files\n";
$zipfilename=substr($files,7);
$zipfilename1=$path.$zipfilename;
zip [ glob("$zipfilename1*.pdf") ] => "$zipfilename1.zip"
 or die "Cannot create zip file: $ZipError" ;
}
closedir $dh;
[download]

This is going to seem like a very esoteric line of inquiry, I suspect, but I will put it out here for the fine monks and nuns to give me feedback.

I use a computer with Windows 10 and with Cygwin installed (as I often mention on PMo). I have this computer and 5 other computers to configure for file locations under my home dir for the vim editor, meaning places to keep backup files and to keep swap files. All those 5 systems run Debian or some derivative distro of Debian Gnu/Linux. So things as they stand will be relatively predictable when I get around to configuring them. Yes, I could do this "by hand" on each system, but automating such a repetitive chore is exactly one of the compelling reasons Perl exists.

Here are the outputs of my script using File::XDG at this stage of writing it (see the code below):

According to File::XDG on Cygwin, the following directories would be used for "vim":

Config for app vim is   C:/Users/somia/config/vim
Data for app   vim is   C:/Users/somia/AppData/share/vim
Cache for app  vim is   C:/Users/somia/cache/vim

According to File::XDG on MSWin32, the following directories would be used for "vim":

Config for app vim is   C:/Users/somia/AppData/Local/.config/vim
Data for app   vim is   C:/Users/somia/AppData/Local/.local/share/vim
Cache for app  vim is   C:/Users/somia/AppData/Local/.cache/vim

According to File::XDG on Linux, the following directories would be used for "vim":

Config for app vim is   /home/somian/.config/vim
Data for app   vim is   /home/somian/.local/share/vim
Cache for app  vim is   /home/somian/.cache/vim

The Code

EDIT

The original code I posted - unfinished, placed in READMORE tags:

The (probably) final code

#!/usr/bin/env perl
# Last modified: Tue May 27 2025 03:02:52 PM -04:00 [EDT]

use strict;
use v5.18;
use utf8;
use warnings;

=head1 SYNOPSIS
perl Emplace-XDG-dirs

=cut

use File::XDG 1.00;
use File::Spec;
use File::Path qw(mkpath rmtree);
use subs qw/tellMe/;

my ($XDGUser, $XDGData, $XDGCache);
my $appName = 'vim';
my $xdgEmp = File::XDG->new( name => $appName , api => 1 );

$XDGUser   = $xdgEmp->config_home;
$XDGData   = $xdgEmp->data_home;
$XDGCache  = $xdgEmp->cache_home;

my @branches = (File::Spec->catdir($XDGData => 'backups'),
                File::Spec->catdir($XDGData => 'swapfiles'));

say "We could make these dirs for you:";
say join qq[\n]=>@branches, '';
if (tellMe("making those dirs for $appName")) {
    mkpath (@branches, {verbose => 'true', mode => 0775});
} else {
    say "No? OK, aborting now";
}   

=head2 Vim settings

  Put in our .vimrc config file:

  set backup
  set backupcopy=auto
  set backupdir= ... (dir created by script)
  set directory= ... (dir created by script)

=cut

sub tellMe {
    my $gummy = $_[0];
    my $ans = "Y";
    printf "Do you want proceed with: %s? [Y/n]\n", $gummy;
    chomp ($ans = <STDIN>);
    if ($ans =~/Y|y/)     {
        return 1;
    } elsif ($ans eq '')  {
        return 1;
    } else                {
        return 0;
    }
}
# vim: ft=perl et sw=4 ts=4 :
[download]

Thanks for your interest!

Greetings, PerlMonks!

I'm trying to figure out if foreach is faster than grep with map. I've replaced grep and map in a large script with foreach and noticed a substantial speed improvement, so my guess is that it is faster. However, I'd like to verify that somehow.

With the two scripts below, am I comparing the same things and not apple to oranges? Or have I misunderstood grep and map?

#!/usr/bin/perl

use strict;
use warnings;

my @c = (1 .. 10000000);

my @d;
foreach my $dd (@c) {
    push(@d, $dd % 2);
}

my @e;
foreach my $ee (@d) {
    if (!$ee) {
        push(@e, $ee);
    }
}

exit(0);
[download]

The script above is much faster than the one below, according to time.

#!/usr/bin/perl

use strict;
use warnings;

my @c = (1 .. 10000000);

my @d = map( $_%2, @c);

my @e = grep(/0/, @d);

exit(0);
[download]

x %INC shows that modules Term::Readline, Term::ReadKey and Term::Cap are loaded.

Does anybody know, how to switch off this editing function binding?

Thanks!

I'm an experienced perl programmer, and am having difficulty getting the module XS-Typemap::Typemap to work. It needs an XS.pm . I have searched, searched, and pulled out a lot of hair, and I cannot find what I must install to get an XS.pm . No, it's not something::XS or XS:something, just plain XS. I have installed Debian apts

  libx11-xcb
  libx11-xcb-dev
  libx11-protocol-perl
  libx11-protocol-other-perl
  libx11-xcb-perl
  xorg-dev
  libxext-dev
  libxfexes-dev
  libx11proto-dev
  libxmu-dev
  libxmuu-dev
  libxt-dev
  xutils-dev
  libperl-dev

Many thanks,

Lyman

I have a command-line app that parses commands and prints the output to the terminal. In search of new features, I'm migrating the terminal library from readline to tickit.

To simplify this changeover, my plan is to use open and select to direct the default output filehandle to a $variable, and then periodically dump the contents of $variable to a tickit widget.

I'm close, but my naive implementation loses every other line of output. Seems like I need to away to ensure that writes to $command_output are held up while printing and then deleting the contained text. Some kind of first-in-last-out buffer with synchronization.

Will be grateful for any hints on an easy way to accomplish this. Here is sample code demonstrating my conundrum:

I am having a problem with understanding expect. I have am trying to create an shh script. I have 3 different conditions:

1. host is unknown it needs to be added to known host list,
2. host needs password,
3. host dose not need password as it is using ssh key.

 $exp->expect($timeout,
             [ qr/\(yes\/no\)\?/i, sub { my $self = shift;
                                      $self->send("yes\r");   <----unk
+nown host
                                      exp_continue; }],
             [ qr/password: /i, sub { my $self = shift;
                                      $self->send("$password\n"); <---
+--- needs password
                                      exp_continue; }],
             [ qr/#/i, sub { my $self = shift;                 <------
+-- ready to go.
                                      $self->send("ls\n");
                                      ;
                                       }],

            );
[download]

So how do I, once I get through the 3 conditions continue using expect?

$exp->expect($timeout,
             [ qr/#/i, sub { my $self = shift;
                                      $self->send("ll\n");  <---- only
+ works when I have a line below (crazy that is how I know this is not
+ right)
                                      ;
                                       }],                          un
+less ($exp->expect($timeout, -re , "~")){} ;

            );
[download]

#!/usr/bin/env perl
use strict;
use warnings;
use Expect;
#$Expect::Exp_Internal = 1;
my $command = "ssh";
my $user = "root";

my @ips = ("10.16.135.157");
my $cnt= 0+@ips;
my $password = "aristo1";
my $timeout = 10;
for (my $i =0; $i < $cnt; $i++) {
my $exp = Expect->spawn ($command, "$user"."@"."$ips[$i]");
#$exp->debug(2);

$exp->expect($timeout,
             [ qr/\(yes\/no\)\?/i, sub { my $self = shift;
                                      $self->send("yes\r");
                                      exp_continue; }],
             [ qr/password: /i, sub { my $self = shift;
                                      $self->send("$password\n");
                                      exp_continue; }],
             [ qr/#/i, sub { my $self = shift;
                                      $self->send("ls\n");
                                      ;
                                       }],

            );

$exp->expect($timeout,
             [ qr/#/i, sub { my $self = shift;
                                      $self->send("ll\n");
                                      ;
                                       }],

            );


unless ($exp->expect($timeout, -re , "~")){} ;
#                 $exp->send("time\n");

}
[download]

Hello, I've installed https://metacpan.org/dist/PLS module.
Configured it in NVIM with https://github.com/neovim/nvim-lspconfig plugin.

Auto completions work. It even shows documentation excerpts, when cursor is over some keyword or library module, but out of all issues, my biggest problem is that Language Server's renaming doesn't work.
When I try to rename some function or a variable, it gives me an error:

'[LSP] Rename, no matching language servers with rename capability.'

Does anybody know, if perl Language servers don't support such functionality or did I configure something wrong?