PWC #340 (current) task #1 is to delete pairs of duplicate adjacent letters until none are left. I thought "maybe it's a good place to use a recursive pattern instead of (possibly) many loop iterations" Did I write it wrong? Is it just not applicable for tasks like these?

use strict;
use warnings;
use Time::HiRes 'time';

my $str;
$str .= chr 97 + rand 2 for 1 .. 5e3;

{
my $n = 0;
my $s = $str;
my $t = time;
$n ++ while $s =~ s/((.)(?1)?\2)//g;
printf qq(%3d loops, %.3f s, result: "%s"\n), $n, time - $t, $s
}

{
my $n = 0;
my $s = $str;
my $t = time;
$n ++ while $s =~ s/(.)\1//g;
printf qq(%3d loops, %.3f s, result: "%s"\n), $n, time - $t, $s
}

#  4 loops, 1.542 s, result: "babababa"
# 47 loops, 0.001 s, result: "babababa"
[download]

Dear Perl Monks,

I just tried to make a simple logger package, having a compilation error with its ver.1 as attached below.

error message

Bareword found where operator expected at /home/tatsu/Perl/MyLog/MyLog
+.pm line 36, near "} encode"
    (Missing operator before encode?)
syntax error at /home/tatsu/Perl/MyLog/MyLog.pm line 36, near "} encod
+e"
Compilation failed in require at logtest.pl line 6.
BEGIN failed--compilation aborted at logtest.pl line 6.
[download]

MyLog.pm (ver.1)

use utf8;
use Time::Piece;
use Carp 'croak';
use Encode 'encode';

sub new {
  my $class = shift;
  my $self = {};
  bless $self, $class;
  my $timesig = localtime->strftime("%y%m%d%H%M%S");
  my $logfile = $timesig . '.log';
  if (-f $logfile) {
    croak "log file ${logfile} already exists.: $!";
  }
  open my $fh, '>>', $logfile
    or croak "can't open log file ${logfile}.: $!";
  $self->{fh} = $fh;
  return $self;
}

sub DESTROY {
  my $self = shift;
  close $self->{fh};
}

sub log {
  my $self = shift;
  my $timesig = localtime->strftime("%y%m%d%H%M%S");
#  my $fh = $self->{fh};
  foreach my $msg (@_) {
    print $self->{fh} encode('utf8', $timesig . ': ' . $msg . "\n");
#    print $fh encode('utf8', $timesig . ': ' . $msg . "\n");
  }
}

1;
[download]

When a local var $fh was used for the file handle with its print command in the log subroutine (ver.2), however, no error occurred and everything worked as expected. It appears that the error occurs with the 'print $self->{fh}' part, but I am not sure how it comes to the error message 'Bareword found where operator expected...'.

Any advice would be much appreciated.

Sincerely,

MyLog.pm (ver.2, log subroutine only)

sub log {
  my $self = shift;
  my $timesig = localtime->strftime("%y%m%d%H%M%S");
  my $fh = $self->{fh};
  foreach my $msg (@_) {
#    print $self->{fh} encode('utf8', $timesig . ': ' . $msg . "\n");
    print $fh encode('utf8', $timesig . ': ' . $msg . "\n");
  }
}

1;
[download]

logtest.pl

use strict;
use warnings;
use utf8;
use FindBin;
use lib $FindBin::Bin;
use MyLog;

my $mylog = MyLog->new();

$mylog->log();
$mylog->log('');
$mylog->log('a', 'b');
[download]

I saw a regex here on PerlMonks awhile back that took a string and inserts commas into numbers. It's pretty amazing how that works, and I am just now beginning to grasp why and how it works. But now I would like to port it to bash. Now, of course, bash doesn't have regex search and replace but sed does. So, when I plugged this into sed, it complains and says "sed: -e expression #1, char 39: Invalid preceding regular expression" (I'm using sed GNU v4.9 and bash 5.2.15 x64)

WHAT IS WRONG???

Original perl code:

#!/usr/bin/perl -w
use strict;
use warnings;
# I copied this regex from:
# www.PerlMonks.org/?node_id=157725
# Usage: STRING = Commify(STRING)
#
sub Commify
{
  defined $_[0] or return '';
  my $N = reverse $_[0];
  $N =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  return scalar reverse $N;
}
print Commify('Testing 1234 testing... -123456789.01234567800 testing 
+test 4,500,000.00000');
[download]

And now the BASH script:

#!/bin/bash
# This function inserts commas into numbers
# at every 3 digits and returns the result
# in a global variable called $STR.
#
function Commify
{
  # First, reverse the string
  STR=$(echo "$1" | rev)

  STR=$(echo "$STR" | sed -E 's/([0-9]{3})(?=[0-9])(?![0-9]*\.)/\1,/g'
+)

  # Now reverse it back:
  STR=$(echo "$STR" | rev)
}
Commify 'Testing 1234 testing... -123456789.01234567800 testing test 4
+,500,000.00000'
echo $STR
[download]

my %haystack; @haystack{'aa'..'ff'} = ();
# syntax error:
say exists @haystack{qw(aa bb cc dd)};

# need to use this instead:
use List::Util qw(first);
say !! first { exists $haystack{$_} } qw(aa bb cc dd);
[download]

I built the aging but probably still-useful module extension HTML::Tidy this week (and, oi, that was an adventure) and it is failing one test. Built it using/for StrawberryPerl. I inserted blank lines in the screen output pasted below, for easier reading.

$ perl -T -Iblib/lib -Iblib/arch  t/clean.t

not ok 3 - $tidy->clean("") returns empty HTML document
#   Failed test '$tidy->clean("") returns empty HTML document'
#   at t/clean.t line 20.

#                   '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 3.2//EN">
# <html>
# <head>
# <meta name="generator" content="tidyp for Windows (v1.04), see www.w
+3.org">
# <title></title>
# </head>
# <body>
# </body>
# </html>
# '
#     doesn't match '(?^:<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 3.2//
+EN">
# <html>
# <head>
# <meta name="generator" content="[^"]+">
# <title></title>
# </head>
# <body>
# </body>
# </html>
# )'

Looks like you failed 1 test of 3.
[download]

  Platform:
    osname=MSWin32
    osvers=10.0.22631.5189
    archname=MSWin32-x64-multi-thread
    uname='Win32 strawberry-perl 5.40.2.1 # 05:42:50 Sun May 11 2025 x64'
    

Can anyone explain Andy's intent in how he coded that test? Thanks all.

Sep 19, 2025 at 22:28 UTC

This is a broad question; I'd be happy to be directed to any package for, or discussion of, this issue, even in Python or other languages.

I'm working with a legacy system that has functionality for sending reminder emails in relation to various events. It is unbelievably complicated, involving tens of thousands of lines of spaghetti if-else code, using dozens of non-obvious configuration variables. It seems to me that someone must have dealt with this before, and that there's a cleaner solution in place for this not-unusual problem, but I haven't been able to find anything.

The current system allows for many, many variations: Number of reminders in between "now" and the event; sending reminders every X days from "now"; sending reminders every X days before the event; adjusting the scheduling after a manual event (that is, if you manually cause a reminder to be sent, does that affect the timing of the remaining reminders, and if so, how); changing the timing in between reminders (e.g. the first reminders are a week apart, but the schedule compresses as we draw near to the event); reminders are usually sent by email but can also be sent by other mechanisms, and these don't necessarily work on the same schedule as the emails; etc. etc. etc.

The system is in use among a large number of people, and apparently many people genuinely do use all of these features at one point or another, so we can't simplify it by removing functionality. But any time we do need to make a change, we end up with even more spaghetti mess, and testing is a nightmare.

Is there a term for this, or some widely understood way of handling this problem, that I just haven't encountered? Thanks for any suggestions.

i have a JSON response of this

my question is how to get lending figures before (.) dot and have output 0

same applies to below

my question is how to get lending figures before (:) dots and have output 0

Dear Monkees,

I am using ExtUtils::MakeMaker for all of my projects just because it is how I started. I know how to create custom targets with it using the "postamble". Now I need to modify certain targets like all in order to add more tasks during making. For example, I have need to create special files before compilation, let's call this target translations (because it translates various strings to various languages and provides multilingual strings). This target should be called prior to whatever target all does. How do I achieve this?

Of course I can add a new target allall as

allall : translations all
[download]

bw, bliako

Dear Monks

I'm trying to read a range of text from Vte::Terminal

There is a very old reference of Gtk2::Vte on how to call this method at :
https://gtk2-perl.sourceforge.net/doc/pod/Gnome2/Vte/Terminal.html

And this link documents the function and its parameters
https://api.gtkd.org/vte.Terminal.Terminal.getTextRange.html

My problem is that I don't understand how to create the $func parameter

I have tried this code, but it fails with fatal errors

$$self{_GUI}{_VTE} = Vte::Terminal->new();
# more code

my $func = sub { return 1 };
my $string = $$self{_GUI}{_VTE}->get_text_range($row, $col, $row, $end
+_col, $func, my $data = undef);
[download]

ERROR:gperl-i11n-invoke-c.c:584:_allocate_out_mem: assertion failed: (interface_info)
Bail out! ERROR:gperl-i11n-invoke-c.c:584:_allocate_out_mem: assertion failed: (interface_info)

And many other variants that make even less sense, and all of them fail. Inclusive passing the undef value to the function.

For example this line does not crash, but it does not work either

my $func = {sub => {return 1}};
my $string = $$self{_GUI}{_VTE}->get_text_range($row, $col, $row, $end
+_col, $func, my $data = undef);
[download]

I need to be able to grab the text from a line where the user clicks, so I can test for the existence of a url and then try to open the url on a browser.

This is for the open source project asbru on github

If you need a working code, the only option I can offer is to clone the repo at : https://github.com/asbru-cm/asbru-cm

Edit PACTerminal.pm and around line 1141 you should see the button_press_event

In the button_press_event, you can add the line to grab the text with any fixed parameters at any point when the user clicks

Thanks

Esteemed Monks,

I have the short script below for receiving files over HTTPS and saving them in a directory. It works great for files of a few hundred kB or less in size. However, for files around 50MB or larger, the script times out without saving the files.

I've tried increasing the timeout for the HTTP daemon (OpenBSD's httpd) but that shouldn't be needed, the upload should take only a second or so with these network speeds, as with SFTP.

#!/usr/bin/perl

use CGI::Fast;
use CGI::Carp qw(fatalsToBrowser);

use strict;
use warnings;

my $socket = '/var/www/run/sockets/upload.sock';

# max file upload size MB
$CGI::POST_MAX = 1024 * 1024 * 500;
$ENV{FCGI_SOCKET_PATH} = $socket;
$ENV{FCGI_SOCKET_PERM} = 0775;

while (my $q = CGI::Fast->new) {
    print qq(Content-Type: text/html; charset=utf-8\n\n);

    print qq(<!DOCTYPE html>\n);
    print qq(<html xmlns="http://www.w3.org/1999/xhtml">\n);
    my $head = &head_default;
    print qq(<head>\n$head\n</head>\n);
    my $body;
    if ( $q->param && $q->request_method() eq 'POST') {
    $body = &upload($q);
    } else {
    $body = &body_default;
    }
    print qq(<body>\n$body\n</body>\n);
    print qq(</html>\n);
}

exit(0);

sub head_default {
    my $css = &css;
    my $head = <<"EOH";
        <title>Hello, World</title>
    $css
EOH

    return($head);
}

sub css {
    my $css=<<EOC;
 <style type="text/css" media="screen">
  /*<![CDATA[*/
  BODY { font-family: sans-serif; margin: 0; }
  H1 { font-size: 150%; font-weight: bold;
       font-family: serif; 
       background-color: #a080ff; 
       padding-left: 1em; padding-right: 1em; 
       border-right:  thin solid #000000;
       border-left:   thin solid #000000;
    }
  P.update { clear: both; font-size: 60%; text-align: center; 
             margin-left: 0.5em; margin-right: 0.5em; }
  FORM { border: thin solid #000; }
  FORM > LABEL:has(~ DETAILS[open]) { display: none; }

  }
  /*]]>*/
</style>
EOC
    return($css);
}

sub body_default {
    my $body;

    $body .= <<EOB;
        <h1>Upload a File</h1>
        <p></p>
    <form method="post" enctype="multipart/form-data">
    Select a file to upload: 
    <input type="file" name="fileToUpload" 
        id="fileToUpload"> <br />
    &nbsp; <br />
    <input type="submit" value="Upload File" name="submit">
    </form>
EOB
    
    return($body);
}

sub upload {
    my ($q) = (@_);

    if (!$q->param('fileToUpload')) {
        return(0);
    }

    my $file = $q->param('fileToUpload');
    $file =~ s/\s+/ /g;
    $file =~ s/[^\w\ \_\.\-]+//g;

    if (! $file) {
        return(0);
    }

    my $upload_dir = "/var/www/uploads";
    my $upload = $q->upload('fileToUpload');
    open ( my $ufile, ">", "$upload_dir/$file" )
        or die "$!"; 

    binmode($ufile);
    while ( my $data = <$upload> ) { 
        print $ufile $data; 
    }
    close ($ufile);

    my $body = <<EOB;
<p>
The file <b>$file</b> was uploaded successfully. <br />
Press the <b>back</b> button or close this tab.
</p>
EOB

    return($body);
}
[download]

Again, it seems to work fine with smaller files. What should I look at tweaking in order to upload larger files? Any other tips welcome, too.