Seekers of Perl Wisdom

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask.

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions

Applying logical operators in either complex SQL xor hashes? 3 direct replies — Read more / Contribute	by mldvx4 on May 10, 2025 at 08:01

Greetings, PerlMonks, Thanks for DBI. It works very well with SQLite3. I have a short (for now) Perl script which is accessed via CGI::Fast which will soon have a small but varying number of SQL queries for SQLite3. The queries are targeted at various FTS5 tables. The number of queries is between 1 and n where n is a "small" number, but in any case changing each time. They are executed theough `prepare` and `execute` statements. The results from each query are collected by the Perl script into its own hash with the records' unique key (recno) as the hash key. For illustration, here is the basic sample query: `SELECT old_keys.recno AS recno, 'http://example.org/' \|\| old_keys.file, old_metadata.value AS title FROM old_keys JOIN old_metadata ON old_keys.recno = old_metadata.recno WHERE term='dc.title' AND old_metadata.recno IN ( SELECT rowid AS recno FROM old_fts5_metadata WHERE old_fts5_metadata MATCH ?);` [download] When there is more than one query, there will be an operator XOR, AND, OR, or NOT applied between them. My question is about the recommended approach, should I apply the operators to the various hashes after separate queries, or should I have the script build out more complex queries into a single SQL query for each search?
What's the best way to ask about code from an older book? 3 direct replies — Read more / Contribute	by adamsj on May 09, 2025 at 16:00

I've hit a snag working through an example from MJD's Higher Order Perl and am wondering what the best way to ask for guidance is. I haven't post the code, because it's copyrighted, and I try to respect that. What's the etiquette for this? They laughed at Joan of Arc, but she went right ahead and built it. --Gracie Allen
Strange Occurrence in Substitution Statement 1 direct reply — Read more / Contribute	by roho on May 06, 2025 at 14:50

I have paired the problem down as much as possible. In the SSCCE below I am removing placeholder backticks between date and time (the reason for this lies in complete program). I am also removing extra spaces in the text (again, the reason for this lies in the complete program). When there is no extra space to remove the "$extra" variable contains the empty string, which I explicitly set to the empty string to recreate the error condition in the SSCCE. The problem is the second and subsequent lines have the backtick removed (i.e., replaced with nothing), while the first line is processed as expected where the backtick is replaced by a single space. It appears the substitution of "$extra" is taking out the backticks (for data lines 2 and following) before the following substitution replaces backticks with a single space. It's a mystery why only the first data line is processed correctly. #!/usr/bin/perl use strict; use warnings; while ( <DATA> ) { chomp; my $fname = $_; print qq(\nBefore: $fname\n); my $extra = ''; $fname =~ s/$extra//; $fname =~ s/`/ /; print qq( After: $fname\n); } exit; __DATA__ 2025-05-05`09:22:00 7,674 -rw-rw-rw- C:\~Zipfile\H\Helpin +gHand\Software\DevTools\.edit.current 2025-05-05`09:22:00 7,674 -rw-rw-rw- C:\PerlApps\H\Helpin +gHand\Software\DevTools\.edit.current 2025-05-05`09:22:00 5,448 -rw-rw-rw- C:\~Zipfile\B\Bat\pi +cs\.edit.current [download] "It's not how hard you work, it's how much you get done."
Resource Not Found error 1 direct reply — Read more / Contribute	by StorminN61 on May 05, 2025 at 13:48

Recently copied a Perl script to a new server since old one is no longer in compliance. When I run the script on the old server, it creates a text file, aka trigger file, which is used by IBM Workload Scheduler to start processing a particular job. Depending on the trigger file, IWS determines which job should run. I copied the directory structure on the new server, made the IIS entries on the new server match what is on the old server, but when I try to create the triggers, I get the 404 Resource not found error, with no further information as to what resource it is specifically missing. #!/usr/bin/perl -w use CGI; print "Content-type: text/html\n\n"; print "<html>\n<head>\n<meta http-equiv=\"Content-Type\" content=\"tex +t/html; charset=iso-8859-1\" />\n"; print "<link rel=\"stylesheet\" href=\"http://pctldocs/doc_style.css\" + type=\"text/css\" />\n"; print "<title>Trigger Result</title>\n</head>\n"; print "<body>\n"; print "Result:<br />"; my @query = split(/=/, $ENV{'QUERY_STRING'}); my $term = $query[$#query]; my $file = 'd:\\apps\\AETrigger\\' . $term . '.txt'; if (open (FH, '>', $file)) { print "Trigger for $term ($query[0]) has been created."; } else { print "Error creating trigger; please contact support."; } print "</body>\n</html>"; [download]
Cannot Remove Redefined Warnings 4 direct replies — Read more / Contribute	by Sukhster on May 05, 2025 at 11:41

Hi, I have recompiled Perl from Source (v5.40.2) with DBI (DBI-1.647.tar.gz) and DBD-Oracle (DBD-Oracle-1.90.tar.gz) - and am now getting redefined errors for the first time. Was previously on v5.38.0 with DBI (DBI-1.643.tar.gz) and DBD-Oracle (DBD-Oracle-1.83.tar.gz) and didn't face this issue. I would like to keep warning - and either resolve these warnings, or remove them. I have tried the following, but to no avail. I still get the defined warnings. `use warnings qw(-refine);` `no warnings qw(redefine);` `no warnings 'redefine';` Any advice, Ye Great Monks of Perl? ######################## # Declare Modules ######################## use strict; use warnings; # Other Modules use POSIX qw(strftime); use Time::HiRes qw(time); use Time::Piece; use Time::Seconds; no warnings 'redefine'; use DBI; use DBD::Oracle qw(:ora_types :ora_fetch_orient :ora_exe_modes); . . . . sub connect_to_database($$$) { # Declare the variables my ($db_uid, $db_pwd, $db_sid) = @_; my $dbh; my %attribs = ( PrintError => 0, AutoCommit => 0, RaiseError => 0 ); $dbh = DBI->connect("DBI:Oracle:".$db_sid, $db_uid, $db_pwd , +\%attribs ) or die "ERROR: Can't connect to database ($db_uid\@$d +b_sid): ".$DBI::errstr."\n"; return $dbh; } [download] Subroutine DBI::db::ora_lob_read redefined at /applications/app12345/A +PP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/DBI +.pm line 1398. Subroutine DBI::db::ora_lob_write redefined at /applications/app12345/ +APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/DB +I.pm line 1398. Subroutine DBI::db::ora_lob_append redefined at /applications/app12345 +/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/D +BI.pm line 1398. Subroutine DBI::db::ora_lob_trim redefined at /applications/app12345/A +PP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/DBI +.pm line 1398. Subroutine DBI::db::ora_lob_length redefined at /applications/app12345 +/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/D +BI.pm line 1398. Subroutine DBI::db::ora_lob_chunk_size redefined at /applications/app1 +2345/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-mul +ti/DBI.pm line 1398. Subroutine DBI::db::ora_lob_is_init redefined at /applications/app1234 +5/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/ +DBI.pm line 1398. Subroutine DBI::db::ora_nls_parameters redefined at /applications/app1 +2345/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-mul +ti/DBI.pm line 1398. Subroutine DBI::db::ora_can_unicode redefined at /applications/app1234 +5/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/ +DBI.pm line 1398. Subroutine DBI::db::ora_can_taf redefined at /applications/app12345/AP +P_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/DBI. +pm line 1398. Subroutine DBI::db::ora_db_startup redefined at /applications/app12345 +/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/D +BI.pm line 1398. Subroutine DBI::db::ora_db_shutdown redefined at /applications/app1234 +5/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/ +DBI.pm line 1398. Subroutine DBI::st::ora_fetch_scroll redefined at /applications/app123 +45/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi +/DBI.pm line 1398. Subroutine DBI::st::ora_scroll_position redefined at /applications/app +12345/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-mu +lti/DBI.pm line 1398. Subroutine DBI::st::ora_ping redefined at /applications/app12345/APP_H +OME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/DBI.pm +line 1398. Subroutine DBI::st::ora_stmt_type_name redefined at /applications/app1 +2345/APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-mul +ti/DBI.pm line 1398. Subroutine DBI::st::ora_stmt_type redefined at /applications/app12345/ +APP_HOME/apps/perl5/lib/site_perl/5.40.2/x86_64-linux-thread-multi/DB +I.pm line 1398. [download]
cpanplus test suite seems to be a bit ruinous 1 direct reply — Read more / Contribute	by Intrepid on May 03, 2025 at 17:01

The Seekers of Perl Wisdom may not be the best place in the known universe for a bug report, but I know the maintainer of the module I am struggling with, bingos, is active here. So here goes. The test suite for cpanplus is the creature we need to tame. I am working with cpanplus v0.9916 and on CygwinPerl v5.40.2 First off, Params::Validate reports an error, exact text shown below, in Dist/MM.pm: Key 'dir' (t/20_CPANPLUS-Dist-MM.t) is of invalid type for 'CPANPLUS::Internals::Utils::_chdir' provided by CPANPLUS::Dist::MM::create at /cygdrive/c/Users/somia/AppData/Local/.cpanp/.cpanplus/5.40.2/build/nDoXKs5RLj/CPANPLUS-0.9916/t/../lib/CPANPLUS/Dist/MM.pm line 610. I inserted some dumb simple code to check what is being passed, the output is: `---------------------------------------------------------------------------- Args being passed to Params::Validate: dir\|t/20_CPANPLUS-Dist-MM.t ----------------------------------------------------------------------------` I will provide a plate of Buffalo chicken wings to the monk or nun that can work out why that error is appearing. ;-) I've looked and looked and cannot figure it out. The next matter is equally baffling. I have `DBD::SQLite` installed to my system but the test suite reports skipping test because "SQLite engine not available": t/031_CPANPLUS-Internals-Source-SQLite.t ...... skipped: SQLite engine not available t/032_CPANPLUS-Internals-Source-via-sqlite.t .. skipped: SQLite engine not available Lastly, the tests in the suite themselves seem to be out of order somehow: Test Summary Report ------------------- t/20_CPANPLUS-Dist-MM.t (Wstat: 0 Tests: 87 Failed: 77) Failed tests: 1, 1, 1, 1, 11-83 Parse errors: Plan (1..1) must be at the beginning or end of the TAP output Tests out of sequence. Found (1) but expected (11) Tests out of sequence. Found (11) but expected (12) Tests out of sequence. Found (12) but expected (13) Tests out of sequence. Found (13) but expected (14) Displayed the first 5 of 83 TAP syntax errors. Re-run prove with the -p option to see them all. Files=20, Tests=1712, 82 wallclock secs ( 0.34 usr 0.47 sys + 20.69 cusr 50.89 csys = 72.40 CPU) Result: FAIL Failed 1/20 test programs. 77/1712 subtests failed. Anyone able to provide suggestions for how to seek and destroy these annoying errors will have my sincere gratitude. May 03, 2025 at 21:01 UTC A just machine to make big decisions Programmed by fellows (and gals) with compassion and vision We'll be clean when their work is done We'll be eternally free yes, and eternally young Donald Fagen —> I.G.Y. (Slightly modified for inclusiveness)
Regex for hostname validation 2 direct replies — Read more / Contribute	by hrcerq on May 01, 2025 at 23:45

Hello again. I always used naive regexps for hostname validation. But recently I've been trying to build something more robust and more adherent to related RFCs. Mostly, I've consulted the following RFCs: RFC 952 RFC 1035 RFC 1123 From that I understand that: Hostnames might be composed by 1 or more labels (separated by dots) Each label may have at most 63 characteres Regardless of how many labels there are, it may be at most 255 characters long Each label may contain a combination of letters, numbers and hyphens No label may begin or end with a hyphen Hostnames can't be composed only by numbers If the hostname is qualified (i.e. there are at least 2 labels), then: There may be 2 or more labels Last label is a TLD TLDs must not be 1 character long or composed only by numbers A trailing dot may be present BTW, consulting RFCs sometimes feels like walking a complex maze full of hidden traps, because there's always some obscure detail you might overlook. Things get worse if we consider some hostnames in the wild not adherent to these rules (e.g. some use underscores, which is valid for DNS, but not when used in hostnames), and also that there exist internationalized domain names. I've tested my regex, but chances are, there are corner cases I'm not aware of, so maybe anyone you might help me find such cases. This is how I'm doing: `my $hname_re = qr/ ^ (?=(?&validchar){1,255}$) (?!\d+$) (?&label) (?: (?:\.(?&label))* \.(?&tld) \.? )? $ (?(DEFINE) (?<validchar>[a-zA-Z0-9.-]) (?<alnum>[a-zA-Z0-9]) (?<alnumdash>[a-z-A-Z0-9]) (?<label>(?> (?&alnum) (?: (?&alnumdash){,61} (?&alnum) )? ) ) (?<tld>(?!(\d+\|.)\.?$) (?&label) ) ) /x;` [download] Thanks for any suggestions. return on_success() or die;
Vexing Race Condition 5 direct replies — Read more / Contribute	by Maelstrom on May 01, 2025 at 10:51

I have a long running script that logs it's process to a file and an FCGI that reads said file every 200ms when prompted to by ajax calls and it seems to mostly work but occasionally fails. I believe I've recreated the problem with the following 2 SSCCE's one.pl `use Fcntl qw (:DEFAULT :flock :seek); my $file = '/dev/shm/tmpcount.txt'; for (1 .. 180) { print "$_\n"; &filewrite($file,$_); sleep 1; } sub filewrite { my ($file,$enc) = @_; open(my $fh,">", $file) \|\| die "Can't open $file for reading: $!"; my $mode = LOCK_EX; flock($fh,$mode) or die "Couldn't lock $file for write"; print $fh $enc; close $fh; }` [download] two.pl `use Fcntl qw (:DEFAULT :flock :seek); my $file = '/dev/shm/tmpcount.txt'; my $c; do { if (-e $file) { $c = &fileread($file); die "C is empty" unless ($c); print "count is $c \n"; } else { print "File not found\n"; } } until ($c == 180); sub fileread { + # Read using perl IO my $file = shift; open(my $fh, "<", $file) \|\| die "Can't open $file for reading: $!"; my $mode = LOCK_SH; flock($fh,$mode) or die "couldn't lock"; my $string = do { local $/; <$fh> }; close $fh; return $string; }` [download] When I use warn instead of die the script appears to work, as it is it will invariably complain that $c is empty at some point. What I think is happening is one.pl opens the file and truncates it but before it gets to calling flock two.pl swoops in and reads an empty file. I suppose the obvious solution is semaphores but as I'm trying to develop a "safe" file handling library I'm wondering if there's another way to go about it. My first thought was an atomic open and lock with sysopen but apparently linux can't do that. I'm wondering if opening the file readwrite and truncating after flock would solve this or would possible race conditions remain? I'm aware if multiple processes are doing read-mutate-write then a semaphore lock is the only way to go but I'm curious if 1 writing and 1 reading process can work without them.
Nested redirect for STDERR to a string buffer within a perl program 2 direct replies — Read more / Contribute	by Anonymous Monk on Apr 30, 2025 at 11:28

Hi Monks, I need your wisdom on nesting the rebinding of STDERR to a string buffer (one per nesting level). The communication is all within the same perl program. This is not about capturing STDERR from a system() call or a Pipe. (Example program at the end of this text. Look for handleOuter() below). Context: I have to capture the error output of a Perl module in a string buffer, which is already redirecting the error output of a third party module in order to handle the errors. The inner module follows the example given in the perlopentut man page and my outer code is following the same pattern. The code tries to do a nested redirection of STDERR. It stores the prior buffers handle in an hash object. The outer code redirects STDERR to an $outerbuffer around the calls to the first module, which then redirects STDERR to an $innerbuffer again to capture the errors of some other module which prints on STDERR in case of errors. It returns to the inner module which restores the binding and reacts to the errors in the $innerbuffer and writes its errors to STDERR and returns to the outer code. The outer code then restores its binding of STDERR and expects the error output or the inner module in $outerbuffer. Problem: When the inner wrapper restores the binding for STDERR the prior binding of the outer STDERR to $outerbuffer is not restored. The text written by the inner module to STDERR after restoring the binding is not showing up in the $outerbuffer. Question: How can I recursively rebind and restore STDERR? How can I rebind/restore STDERR in 'restore()' below? Is there a better way to save the prior handle? (Look for 'WHAT TO DO HERE INSTEAD' in the code.) Pseudo code: redirect STDERR to $outerbuffer in the classic way of perlopentut call inner module: print STDERR "INNER BEFORE CAPTURE" # go to $outerbuffer redirect STDERR to $innerbuffer in the classic way of perlopentut call code which reports errors on STDERR eg: "FIRST CAPTURE" # above output goes to $innerbuffer restore STDERR of $innerbuffer in the classic way of perlopentut # From here on printing to STDERR should go to $outerbuffer again # But it does not. code handling $innerbuffer ... print STDERR "inner past restore" # should go to $outerbuffer (is + missing) print STDERR "outer past call" # should go to $outerbuffer (is missing +) restore STDERR of $outerbuffer in the classic way of perlopentut # From here on STDERR goes to the standard file handle (fd=2) #handleOuter() is expected to produce: #################### #handleOuter() is expected to produce: OUTER BEFORE CAPTURE INNER BEFORE CAPTURE INNER AFTER RESTORE BUFFER (inner): >>FIRST CAPTURE<< OUTER AFTER RESTORE BUFFER (outer): >>OUTER BEFORE CALL\ninner past restore\nouter past call<< INNER BEFORE CAPTURE INNER AFTER RESTORE BUFFER (inner): #>>FIRST CAPTURE<< OUTER AFTER RESTORE BUFFER (outer): #>>INNER BEFORE CAPTURE\ninner past restore<< [download] Here comes the wrapper module embedded in a full program. #!/usr/bin/perl # Example code from 'perldoc -f open' # # Redirect standard stream STDERR to a buffer and then # restore the standard stream # With extension of nested redirections (which does not work!) ############################################################### package WrapSTDERR; use strict; use warnings; use Carp; use Data::Dumper; sub capture; sub restore; sub new { my $proto = shift; my $class = ref($proto) \|\| $proto; my $self = { 'buffer' => "", 'STREAM' => undef, 'state' => 'closed' }; $self = bless $self, $class; return $self; } sub DESTROY { my $self = shift; if ($self->{'state'} eq 'bound') { $self->restore(); } } sub capture { my $self = shift; if ($self->{'state'} eq 'bound') { confess "Cannot bind STDERR again while it is bound," ." use another wrapper object."; } # duplicate STDERR filehandle in $self->{'STREAM'} open( $self->{'STREAM'}, ">&STDERR") ## no critic or die "Failed to save STDERR"; ## WHAT TO DO HERE INSTEAD? ## How to save the previous stream for restore? ## Can I find out whether STDERR is already bound to a string buffer # and save the ref to the buffer for rebinding on restore? $self->{'STREAM'}->print(""); # get rid of silly warning message close STDERR; # required for open open( STDERR, '>', \$self->{'buffer'} ) or die "Cannot open STDERR +: $!"; STDERR->autoflush(); $self->{'state'} = 'bound'; return $self; # for chaining with new } sub restore { my $self = shift; if (! $self->{'state'} eq 'bound') { confess "Cannot restore STDERR when it is not bound."; } close STDERR; # remove binding to string buffer # rebind STDERR to previous handle open( STDERR, ">&", $self->{'STREAM'} ) or die "Failed to restore STDERR"; ## WHAT TO DO ABOVE INSTEAD? ## Can I get the buffer to rebind from the STDERR handle in capture an +d save it? ## How to restore the binding to the buffer of the previous stream (if + there is one)? $self->{'STREAM'}->close(); $self->{'STREAM'}= undef; $self->{'state'} = 'closed'; my $data = $self->{'buffer'}; return $data; } 1; ###################################################################### package main; sub handleInner { print "INNER BEFORE CAPTURE\n"; my $innerCapture = WrapSTDERR->new()->capture(); print STDERR "FIRST CAPTURE\n"; # to innerbuffer, works my $buffer = $innerCapture->restore(); chomp $buffer; print "INNER AFTER RESTORE\n"; print STDERR "inner past restore\n"; # above goes to console or the outerbuffer, # it fails for outerbuffer when called from handleOuter print "BUFFER (inner): \n#>>$buffer<<\n"; } sub handleOuter { print "OUTER BEFORE CAPTURE\n"; my $outerCapture = WrapSTDERR->new()->capture(); print STDERR "OUTER BEFORE CALL\n"; # to outerbuffer handleInner(); print STDERR "outer past call\n"; # to outerbuffer # (It does not go to the buffer in $outerCapture, # which is the topic of this question) my $buffer = $outerCapture->restore(); chomp $buffer; print "OUTER PAST RESTORE\n"; print "BUFFER (outer): \n#>>$buffer<<\n"; } handleInner(); #prints this: # INNER BEFORE CAPTURE # INNER AFTER RESTORE # INNER PAST RESTORE # BUFFER (inner): #>>FIRST CAPTURE<< print "####################\n"; handleOuter(); #prints this: # OUTER BEFORE CAPTURE # INNER BEFORE CAPTURE # INNER AFTER RESTORE # BUFFER (inner): >>FIRST CAPTURE<< # OUTER AFTER RESTORE # BUFFER (outer): #>>OUTER BEFORE CALL<< # Above line is not correct. #handleOuter() is expected to produce: # OUTER BEFORE CAPTURE # INNER BEFORE CAPTURE # INNER AFTER RESTORE # BUFFER (inner): >>FIRST CAPTURE<< # OUTER AFTER RESTORE # BUFFER (outer): #>>OUTER BEFORE CALL\ninner past restore\nouter past call<< [download]
Initialize variable in BEGIN 5 direct replies — Read more / Contribute	by BillKSmith on Apr 30, 2025 at 09:18

In a previous reply (Re: Use of BEGIN block) , pfaut suggested using BEGIN and END blocks with the Command Switch n . Here is a complete example. `#!perl -n use strict; use warnings; # USAGE: perl np.pl <np.dat BEGIN{ our $total = 0; } our $total; $total += $_; END{ our $total; print $total }` [download] Note that the package variable `$total` is in scope in all three blocks because it is declared in each with `our`. Is there a preferred way to do this? I understand that without `strict`, no declaration is necessary and with the `use vars` syntax, there is no restriction on scope. Bill

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Any advice, Ye Great Monks of Perl?

The test suite for cpanplus is the creature we need to tame.