I have a script that builds an HTML document and sends it out as an E-Mail. The problem we were seeing was that Outlook (Microsoft's E-Mail reader application) was having problems displaying the HTML document, while the raw document looked fine when I viewed it in my browser. Within Outlook, the HTML would render fine for a while, then it would drop down into showing the raw HTML, then go back to rendering the page. It was irritating.

I was using a template to generate the HTML document, so the tags were all matched: a starting and ending table tag, within that, a bunch of paired tr tags, and within each row, paired td or th tags. I've been generating tables in HTML since the late 90's, so I'm pretty sure that's right. The only new thing I've added is using styles that are defined in the page header.

Anyway, a new employee on the client team put my vanilla HTML into ChatGPT to see if it could identify what the problem was. ChatGPT listed six problems:

1. Invalid table headers - except they were all matched, and contained within a tr element;
2. CSS issues - telling me that border-collapse: collapse would be better than border-collapse: separate; - irrelevant;
3. Missing closing th tags - same error as #1. All tags were matched;
4. Potentially Incorrect Data Formatting - suggesting that <td class='left'>0</td> would be better displayed as <td class='left'>0.00</td>, which was irrelevant;
5. Incorrect HTML Tag Nesting (Semantics Issue) - this was reporting that a style was declared in the page header but never used, irrelevant; and
6. Email Signature Formatting - some discussion about how the confidentiality statement was too wordy.

Oh.

Oh no. Really?

Finally, at 8pm last night, I realized what the problem was. Blank lines. Outlook doesn't like blank lines within an HTML document. It interprets that as the end of the document, and goes back to showing raw text. Until the HTML starts up again, at which point (for some special, lucky, magic, Microsoft reasons) it goes back to showing the interpreted HTML. Oh, Microsoft.

ChatGPT didn't pick up on the blank lines, instead, it picked up on a bunch of inconsequential or irrelevant issues with the HTML.

So, I'm still a little suspicious of AI in general. It's not yet at the point where it can make creative leaps; it still wants to examine each grain of sand on the beach, rather than look at the shape of the dune. Sure, maybe ChatGPT should have been specifically prompted with 'Outlook isn't rendering this HTML document correctly, tell me why' -- but I think you can get better mileage by Telling It To The Bear, or having another pair of eyes looking at the problem.

In perl.perl5.porters, Philippe Bruhat wrote:

I'm very sorry to be the bearer of sad news, which I just learned
from a co-worker who was in regularl contact with Zefram.

He forwarded me this:
We are sad to announce that Zefram (Andrew Main) died yesterday
(2025-03-10) after being hit by a train. Further details are not yet
available. Everyone close to him is very shocked by this and contact
details and further arrangements will be announced in future.
He was a long-time and prolific contributor to Perl core and CPAN,
and he will be missed.

I will forward further details (memorial or place to send condolences)
as I receive them.

Christian Walde then followed up with:

Thanks for bearing the news BooK, even if it is sad news.

As an additional bit of info, his personal website's section on this 
matter is relevant: https://www.fysh.org/~zefram/personal/death

First thing: before you comment, read the rules. They're pinned at the top of the forum. If you need help finding them, ask, someone will point you to the right place. Read the rules. All of them. I made them funny, but I mean every word. This isn't Twitter. This isn't 4-chan. Don't act like it is.

Wheaton Rules: Don't be a dick.

You are adults, I will treat you that way, meaning you are responsible for adhering to the rules, behaving yourself, and being respectful, considerate, and decent to each other. You get one chance. You violate the rules, out you go and you're blocked from all of my feeds. If you want to be here, act like it.

I know how this sounds, I do. But I'm riding herd on 60,000 opinionated people and I'm neither patient nor pathologically capable of suffering fools, gladly or otherwise.

Read the rules. Welcome aboard. I'm glad you're here.

Of course, such a CoC could not be adopted here, because his "forum" is a one-man show.

Note: by "Wheaton Rules", he means Wheaton's Law.

Dear Nuns and Monks,

while playing with tr/// inside a string eval, I came across a strange feature in overload: It is possible to overload the arguments of a tr/// operator.

This feature can be used to have variable operands in tr/// without eval'ing them.

Here is a module (kind of) that overloads the arguments of tr///. If any of these starts with a $, it is taken as
a symbolic reference to an (unqualified) package variable
an identifier of a lexical scoped variable
that will act as the operand instead. A string eval is still required to compile the expression at runtime but in this case on a constant string that is not prone to code injection. It is even possible to have tr's delimiter inside the the referenced values.

What is your opinion on this? Is it secure? Is it useful?

Update: Incorporated ikegami's advice.

#!/usr/bin/perl -T

package Syntax::Tr::Ref;

use v5.26;
use warnings;
use overload;
use Carp;
use PadWalker qw(peek_my peek_our);
use experimental 'signatures';

sub ovl_tr ($,$str,$context) {
    # pass everything unmodified that is not an operand of tr///
    return $str unless $context eq 'tr';

    # <original>  
    ## get symbol table entry name
    #my ($name) = $str =~ /^\$(.*)/;
    ## pass regular operands
    #return $str unless defined $name;

    ## dereference the name
    #my $caller = caller(1);
    #no strict 'refs';
    #my $ret = ${"${caller}::$name"};
    # </original>

    # <update>
    # pass regular operands
    return $str unless $str =~ /^\$/;

    # search for a variable named $str defined as "my" or "our" in the
    # caller
    my $my = peek_my(1);
    my $our = peek_our(1);
    my $ret =
        exists $my->{$str} ? $my->{$str}->$* :
        exists $our->{$str} ? $our->{$str}->$* : undef;
    # </update>

    # illegal argument
    croak qq(symbolic reference "\$${caller}::$name" not found)
        unless defined $ret;

    $ret;
}

sub import {
    overload::constant q => \&ovl_tr;
}

sub unimport {
    overload::remove_constant q => \&ovl_tr;
}

1;

package Foo;

use v5.26;
use warnings;
use Carp::Always;

# emulate "use Syntax::Tr::Ref;"
BEGIN {
    Syntax::Tr::Ref->import;
}

# create a tainted empty string
my $tainted = substr $ENV{PATH}, 0, 0;

# a "bad" searchlist: tainted and contains the tr///-delimiter

# <original>
## must be an alias to a package variable
#local our $abc = '%/cde' . $tainted;
# </original>

# <update>
my $abc = '%/cde' . $tainted;
# </update>

# the tr/// subject
my $s = '%abcde/';
# eval on fixed string at runtime
# almost equivalent to tr{%/cde}{@|fgh}
eval 'tr/$abc/@|fgh/; 1' or warn $@ for $s;
say $s;

__DATA__
@abfgh|
[download]

Music::AirGuitar, really.

From the docs:

Music::AirGuitar - Interface for air guitars
…
my $keys = $guitar->keys(%opts);
…
The number of keys the guitar has. 
If it has keys it is a Keytar. 
Most don't.
Supported types: non-negative integer.
Default: 0.
[download]

say "Happy new year $sum!!! :)"

Hello Monks,

I've been using the testing harness of perl to run a download and watermark script, and I've had quite a bit of success with it in testing. As I enter the monastery, I'm getting some false results that I want to explore using perl.

I got back to the literature and used Module::Starter, and now have something that could count as a distro. It's passed 12 rounds of testing, but I've made a big mistake because I backed off of stat'ing the file as an ultimate test of a success. Let me just start with perl as I present Frobnitz.pm:

package Acme::Frobnitz;

use strict;
use warnings;
use IPC::System::Simple qw(capturex);
use Cwd qw(abs_path);
use File::Spec;
use File::stat;
use File::Basename;
use FindBin;
use POSIX qw(strftime);

our $VERSION = '0.03';
[download]

That stack of modules just makes me happy to look at, like an xmas tree. And already version 3! IPC::System::Simple is a good choice for a grown-up's version of system() according to haukex's canonical treatment.

The methods wrap calls to bash:

sub new {
    my ($class) = @_;
    return bless {}, $class;
}

sub _get_script_path {
    my ($class, $script_name) = @_; # Resolve base directory dynamical
+ly
    my $base_dir = abs_path("$FindBin::Bin/.."); # One level up from b
+in
    my $script_path = File::Spec->catfile($base_dir, 'bin', $script_na
+me);

    unless (-x $script_path) {
        die "Script $script_path does not exist or is not executable.\
+n";
    }

    return $script_path;
}

sub download {
    my ($class, $hyperlink) = @_;
    die "No hyperlink provided.\n" unless $hyperlink;

    my $script_path = $class->_get_script_path("call_download.sh");
    my $output;
    eval {
        $output = capturex("bash", $script_path, $hyperlink);
    };
    if ($@) {
        die "Error executing $script_path with hyperlink $hyperlink: $
+@\n";
    }

    return $output;
}
[download]

I've been jammed up with version control, because I've been unable to reconstitute my gitlab circumstances (totally my fault). I take snapshots with

They mostly look the same, but I port them back and forth from my mini-mac to a linux machine, with an obligatory-named usb as download target. That happens in the bash part. There's also the docker part and a python part. Much of this source deals with calling one from the other and returning values as well as files. I've wanted perl to "pull the cart" for the whole process, so that I could subject it to testing. LanX rightly laments the dearth of this in contemporaneous culture.

I haven't revealed my screw-up yet...this isn't easy...

I thought I passed the 12th round of testing but later came to realize I was firing blanks as to whether files ended up on the usb drive, and it brings me to a weird moment in testing, where I can use perl to figure out why...

Here's the new perl caller...this is what is "pulling the cart," whatever that means...

use strict;
use warnings;
use Acme::Frobnitz;

my $frobnitz = Acme::Frobnitz->new();

# URL of the video to download
my $video_url = "https://www.instagram.com/p/DDa_FxsNtTe/";

# Step 1: Download the video
my $downloaded_file = $frobnitz->download($video_url);
print "Downloaded video to: $downloaded_file\n";

# Step 2: Verify the downloaded file
print "Verifying downloaded file...\n";
if ($frobnitz->verify_file($downloaded_file)) {
    print "File verification successful.\n";
} else {
    die "File verification failed. Aborting further processing.\n";
}

# Step 3: Add watermark to the downloaded video
my $final_file = $frobnitz->add_watermark($downloaded_file);
print "Final watermarked video is at: $final_file\n";
[download]

I want to make a pure perl test here and use perl to figure out my privileges, and I'm using this. You should note that this is untested software from chatgpt today:

sub verify_file {
    my ($class, $file_path) = @_;
    die "File path not provided.\n" unless $file_path;

    my $abs_path = abs_path($file_path) // $file_path;

    if (-e $abs_path) {
        print "File exists: $abs_path\n";

        # File size
        my $size = -s $abs_path;
        print "File size: $size bytes\n";

        # File permissions
        my $permissions = sprintf "%04o", (stat($abs_path)->mode & 077
+77);
        print "File permissions: $permissions\n";

        # Last modified time
        my $mtime = stat($abs_path)->mtime;
        print "Last modified: ", strftime("%Y-%m-%d %H:%M:%S", localti
+me($mtime)), "\n";

        # Owner and group
        my $uid = stat($abs_path)->uid;
        my $gid = stat($abs_path)->gid;
        print "Owner UID: $uid, Group GID: $gid\n";

        return 1; # Verification success
    } else {
        print "File does not exist: $abs_path\n";
        my $dir = dirname($abs_path);

        # Report directory details
        print "Inspecting directory: $dir\n";
        opendir my $dh, $dir or die "Cannot open directory $dir: $!\n"
+;
        my @files = readdir $dh;
        closedir $dh;

        print "Directory contents:\n";
        foreach my $file (@files) {
            next if $file =~ /^\.\.?\$/; # Skip . and ..
            my $file_abs = File::Spec->catfile($dir, $file);
            my $type = -d $file_abs ? 'DIR ' : 'FILE';
            my $size = -s $file_abs // 'N/A';
            print "$type - $file (Size: $size bytes)\n";
        }

        return 0; # Verification failed
    }
}
[download]

Ok, let's use the toolchain.

(base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ ls
Acme-Frobnitz-Snapshot.tar.gz  Dockerfile  Makefile     MYMETA.yml    
+    xt
bin                            ignore.txt  Makefile.PL  README
Changes                        lib         MANIFEST     requirements.t
+xt
conf                           logs        MYMETA.json  t
(base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ perl Makefile.PL
WARNING: Setting ABSTRACT via file 'lib/Acme/Frobnitz.pm' failed
 at /usr/share/perl/5.30/ExtUtils/MakeMaker.pm line 754.
 
...Q1) Why do I get this warning?
Generating a Unix-style Makefile
Writing Makefile for Acme::Frobnitz
Writing MYMETA.yml and MYMETA.json
(base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ make
cp lib/Acme/._Frobnitz.pm.bak blib/lib/Acme/._Frobnitz.pm.bak
cp lib/python_utils/watermarker2.py blib/lib/python_utils/watermarker2
+.py
cp lib/python_utils/__pycache__/watermarker2.cpython-39.pyc blib/lib/p
+ython_utils/__pycache__/watermarker2.cpython-39.pyc
cp lib/python_utils/__pycache__/watermarker2.cpython-313.pyc blib/lib/
+python_utils/__pycache__/watermarker2.cpython-313.pyc
...^^^I see all these little barnacle files now...

...in 3 lines we cross into python logging...
t/00-load.t ....... 1/? # Testing Acme::Frobnitz 0.03, Perl 5.030000, 
+/usr/bin/perl
t/00-load.t ....... ok   
t/13.download.t ... 1/? 2024-12-17 06:28:26,320 - __main__ - INFO - At
+tempting to create directory: E4B0-3FC22024-12-17/
2024-12-17 06:28:26,320 - __main__ - INFO - Directory created or alrea
+dy exists: E4B0-3FC22024-12-17/
2024-12-17 06:28:26,321 - __main__ - INFO - Entering function: mask_me
+tadata
2024-12-17 06:28:26,321 - downloader5 - INFO - Masking metadata
2024-12-17 06:28:26,321 - downloader5 - INFO - Received parameters for
+ metadata extraction:
2024-12-17 06:28:26,322 - downloader5 - INFO - download_path: E4B0-3FC
+22024-12-17/
...oh damn, that's the problem right there........................^^^^
+^^^^^^
[download]

Good heck. The progress I make with this is a function of effective logging. Continuing on STDOUT:

2024-12-17 06:28:36,493 - __main__ - INFO - Entering function: create_
+original_filename
2024-12-17 06:28:36,494 - downloader5 - INFO - Generated original file
+name: E4B0-3FC22024-12-17/Rick_Astley_20091025.webm
2024-12-17 06:28:36,494 - __main__ - INFO - Entering function: downloa
+d_video
2024-12-17 06:28:36,494 - downloader5 - INFO - Received parameters: do
+wnload_video:
2024-12-17 06:28:36,494 - downloader5 - INFO - download_path: E4B0-3FC
+22024-12-17/

...    again                                                       oop
+s^^^  .....
2024-12-17 06:28:36,496 - downloader5 - INFO - video_title: Rick_Astle
+y_-_Never_Gonna_Give_You_Up_(Official_Music_Video)
2024-12-17 06:28:36,496 - downloader5 - INFO - video_date: 20091025
...but here's the false positive:
2024-12-17 06:29:22,739 - downloader5 - INFO - Video download complete
+d.
2024-12-17 06:29:22,742 - downloader5 - INFO - Download completed in 4
+6.24 seconds

...this part is one of my favorites:
2024-12-17 06:29:22,742 - __main__ - INFO - Entering function: store_p
+arams_as_json
2024-12-17 06:29:22,743 - utilities1 - INFO - Params saved to JSON fil
+e: E4B0-3FC22024-12-17/Rick_Astley_20091025.json
2024-12-17 06:29:22,743 - __main__ - INFO - Returning original filenam
+e: E4B0-3FC22024-12-17/Rick_Astley_20091025.webm
t/13.download.t ... ok   

...should have failed...
Result: PASS
(base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ sudo make instal
+l
[sudo] password for fritz: 
Installing /usr/local/share/perl/5.30.0/Acme/Frobnitz.pm
...
[download]

Let's fire up the debugger, woohoo! This is why I can never leave perl:

(base) fritz@laptop:~/Desktop/Acme-Frobnitz-Snapshot$ perl -d  bin/3.d
+river.pl 

Loading DB routines from perl5db.pl version 1.55
Editor support available.

Enter h or 'h h' for help, or 'man perldebug' for more help.

main::(bin/3.driver.pl:5):    my $frobnitz = Acme::Frobnitz->new();
  DB<1>
[download]

Scout it out once with c, then set a break:

  DB<1> R                                                             
+          
Warning: some settings and command-line options may be lost!

Loading DB routines from perl5db.pl version 1.55
Editor support available.

Enter h or 'h h' for help, or 'man perldebug' for more help.

main::(bin/3.driver.pl:5):    my $frobnitz = Acme::Frobnitz->new();
  DB<0> b 16                                                          
+          
  DB<1>
[download]

Get in there...

2024-12-17 07:10:09,829 - downloader5 - INFO - Video download complete
+d.
2024-12-17 07:10:09,832 - downloader5 - INFO - Download completed in 9
+.76 seconds
2024-12-17 07:10:09,832 - __main__ - INFO - Entering function: store_p
+arams_as_json

...

Verifying downloaded file...
main::(bin/3.driver.pl:16):    if ($frobnitz->verify_file($downloaded_
+file)) {
  DB<1> s                                                             
+          
Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz
+.pm:65):
65:        my ($class, $file_path) = @_;
  DB<1> v                                                             
+          
62     }
63     
64     sub verify_file {
65==>        my ($class, $file_path) = @_;
66:        die "File path not provided.\n" unless $file_path;
67     
68:        my $abs_path = abs_path($file_path) // $file_path;
69     
70:        if (-e $abs_path) {
71:            print "File exists: $abs_path\n";
  DB<1> s                                                             
+          
Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz
+.pm:66):
66:        die "File path not provided.\n" unless $file_path;
  DB<1> s                                                             
+          
Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz
+.pm:68):
68:        my $abs_path = abs_path($file_path) // $file_path;
  DB<1> s                                                             
+          
Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz
+.pm:70):
70:        if (-e $abs_path) {
  DB<1> s                                                             
+          
Unsuccessful stat on filename containing newline at /usr/local/share/p
+erl/5.30.0/Acme/Frobnitz.pm line 70.
 at /usr/local/share/perl/5.30.0/Acme/Frobnitz.pm line 70.
    Acme::Frobnitz::verify_file(Acme::Frobnitz=HASH(0x5653a1900ad8), "
+2024-12-17 00:09:54 - Detected OS: Linux\x{a}2024-12-17 00:09:54 "...
+) called at bin/3.driver.pl line 16
Acme::Frobnitz::verify_file(/usr/local/share/perl/5.30.0/Acme/Frobnitz
+.pm:92):
92:            print "File does not exist: $abs_path\n";
  DB<1> p $abs_path                                                   
+          
2024-12-17 00:09:54 - Detected OS: Linux
2024-12-17 00:09:54 - Ensuring Docker is running...
2024-12-17 00:09:54 - Docker is already running.
2024-12-17 00:09:54 - Loading configuration from /home/fritz/Desktop/A
+cme-Frobnitz-Snapshot/bin/../conf/app_config.json...
2024-12-17 00:09:54 - Target USB mount name from config: E4B0-3FC2
2024-12-17 00:09:54 - Detected USB mount point: /media/fritz/E4B0-3FC2
2024-12-17 00:09:54 - Attempting to create directory: /media/fritz/E4B
+0-3FC2/2024-12-17/
2024-12-17 00:09:54 - Directory created or already exists: /media/frit
+z/E4B0-3FC2/2024-12-17/
2024-12-17 00:09:54 - Docker image 'my_dl:latest' found.
2024-12-17 00:09:54 - Running Docker with the specified volume and con
+fig path...
2024-12-17 00:10:13 - File validation successful: [Instagram] Extracti
+ng URL: https://www.instagram.com/p/DDa_FxsNtTe/
Adding lib_path to sys.path: /app/bin/../lib/python_utils
[Instagram] DDa_FxsNtTe: Setting up session
[Instagram] DDa_FxsNtTe: Downloading JSON metadata
[Instagram] Extracting URL: https://www.instagram.com/p/DDa_FxsNtTe/
[Instagram] DDa_FxsNtTe: Setting up session
[Instagram] DDa_FxsNtTe: Downloading JSON metadata
[info] DDa_FxsNtTe: Downloading 1 format(s): dash-560108753314303v+das
+h-1118756702933936ad
[download] Destination: E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.fdas
+h-560108753314303v.mp4
[download] 100% of   37.69MiB in 00:00:07 at 5.24MiB/s:00
[download] Destination: E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.fdas
+h-1118756702933936ad.m4a
[download] 100% of    1.14MiB in 00:00:00 at 2.32MiB/s:00  
[Merger] Merging formats into "E4B0-3FC2/2024-12-17/Tim_Ballard_202412
+11.mp4"
Deleting original file E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.fdash
+-1118756702933936ad.m4a (pass -k to keep)
Deleting original file E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.fdash
+-560108753314303v.mp4 (pass -k to keep)
E4B0-3FC2/2024-12-17/Tim_Ballard_20241211.mp4

  DB<2>
[download]

Q3) What the damn heck is that?

Alright, well I found enough things wrong in there to need to go back and fix. It's funny how you find stuff during the writeup. Without a githost I don't have a means to provide an SSCCE without violating the first S.

For creating the virtual environment with some diagnostics, I've been using this Dockerfile, which has a nice amount of tread on it:

# Start with a base image
FROM python:3.10-slim

# Set PYTHONPATH to include the python_utils directory
ENV PYTHONPATH="/app/lib/python_utils:/app/lib"

# Update apt repository and install necessary dependencies, including 
+ffmpeg
RUN apt-get update && \
    apt-get install -y --no-install-recommends \
    ffmpeg \
    python3 \
    python3-pip && \
    apt-get clean && \
    rm -rf /var/lib/apt/lists/*

# Set the working directory
WORKDIR /app


# Copy all files into the Docker image
COPY bin /app/bin
COPY lib /app/lib
COPY conf /app/conf
COPY requirements.txt /app/requirements.txt
COPY Dockerfile /app/Dockerfile


# Install Python dependencies
RUN pip3 install --upgrade pip && pip3 install -r requirements.txt --r
+oot-user-action=ignore

# Debug: List all files in /app and verify the content of lib/python_u
+tils
RUN ls -la /app && ls -la /app/lib && ls -la /app/lib/python_utils

# Debug: Verify requirements.txt is in the container
RUN cat /app/requirements.txt

# Debug: Verify Python environment and MoviePy installation
RUN python3 -c "import sys; print(sys.version)"
RUN python3 -c "import site; print(site.getsitepackages())"
RUN python3 -c "import moviepy; print('MoviePy is correctly installed'
+)"
[download]

The image is minimal. Execution is done from within bash:

original_filename=$(docker run --rm \
  -e PYTHONPATH="/app/lib/python_utils:/app/lib" \
  -v "$Config_Path":/app/conf/app_config.json \
  -v "$usb_mount_point":"$usb_mount_point" \
  my_dl python3 /app/bin/call_download.py "$1")
[download]

Docker isn't the easiest thing to get values out of, and this worked. Glad for any critical comments about the code. I gotta figure out how I threw a monkey wrench into what used to work, and I don't find that wrench without gdb. I'm not aware of a python equivalent.

May your solstice be filled with perl

It's that day again, my Monk Day. I'm up to 23 years on this site. Cool!

I had an idea recently that I wanted to scan the log files on the server I run to catch information about the life-cycle of customer tickets. I've written various scripts that run under crontab to create and to update a Freshdesk ticket.

As each of the scripts run, it uses the very handy Log::Log4perl module to log stuff, and they end up in log files which get rotated (so foo.log becomes foo.log.1) automatically. How big the files are, and how many backups you have are all configurable, of course. The logs contain lines like

2024/12/06 06:11:03 INFO : Create FD ticket 427993 for order 663363 ..
+ OK
[download]

Update ticket 413229 to add invoice 802924 tag .. OK
[download]

Of course! Named captures! (I wrote about this in Perl's hidden depths). I happily got the code working, and proudly pasted my clever solution here. And I got some feedback about how I could simplify my code. And then simplify it some more .. wow.

Clearly, I am *still* learning Perl, after 25+ years. That's how deep the language is, and that's how generous the Perl community is with sharing its knowledge.

"Nobody uses Perl anymore!!" Yeah, well, they should. it's an awesome language.

Recently I got myself a new phone. And, as one does, I installed Termux on it, to have a unix-ish environment for when I need it.

Then, of course, I went to configure Perl and install some modules I'd like there. As this was not my first time doing so, I thought about listing all the modules I want in a cpanfile and then using App::cpanminus to install these, making the process far more reproducible.

But that required some non-Perl prerequisites, like the C compiler, make and perl itself. And of course, also bootstrapping App::cpanminus.

Then I thought a bit on how to combine this setup into a single file. This is what I came up with. It's a cpanfile that doubles as shell script.

#!/bin/bash

# This will install cpanminus and then the Perl modules
# as listed at the end of this script. To run use
# the following commands:
#
# chmod ugo+x ./cpanfile && ./cpanfile
#

eval '
pkg install git perl make clang

if ! cpanm --help 2>&1 >/dev/null ; then
    curl -L https://cpanmin.us | perl - App::cpanminus
fi

DIR=$(dirname "$0")
cpanm --installdeps --notest --cpanfile "$DIR"

exit
'
if 0;

requires 'Mojolicious';
requires 'DBIx::Spreadsheet';
#requires 'App::sqldisplay'; # to be released on CPAN
requires 'DBIx::RunSQL';
[download]

Why not the other way around? Because I could not find a way to make cpanm take a file with a different name than cpanfile :)

The cpanfile is also available on Github, if you want to copy it.

Greetings from chilly, snowy Buffalo (NY, USA). I spent about 6 years doing no programming at all and now I'm using perl again. I am still hooked on it. So this week I started exploring CPAN modules that give info about and, in some cases, modify, the filesystem. I know of 3 modules that are used for that: the core module File::Spec, the module Path::Class (used it and liked it, a while back), and the module Path::Tiny. This meditation focuses on Path::Tiny, which seems to be stalking me. I see a lot of module authors using it in their code (that is, it has become a common dependency).

Path::Tiny is probably a bit of a misnomer. It has many methods. Many many. What I was most interested in this week was the method tempdir. Something about how tempdir works took me by surprise (yes, I am finally getting around to the point of this meditation :). The method returns a {normalized, right-slashed, absolute} pathname, but it also creates the temporary directory. Maybe I am odd, but I expected to be given a string and then create the directory with that pathname myself!

Below, some code (playful deliberately) that uses tempdir and will demonstrate that when tempdir is called, a directory is created.

#!/usr/bin/env perl
# Last modified: Wed Dec 04 2024 10:48:30 PM -05:00 [EST]

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

=head1 NAME
pathology.pl

=cut

use Term::ReadKey qw/ReadMode ReadKey/;
use File::Spec;
use Path::Tiny;

my $user;

sub versions
{
   say
       $File::Spec::VERSION, q[ ]
   ,   $Path::Tiny::VERSION ;
}

sub who
{
    no warnings 'deprecated', 'experimental';
    use Config;
    given (lc( $Config{osname} )) {
        when ('linux')    { $user = $ENV{USER}     }
        when ('cygwin')   { $user = $ENV{USER}     }
        when ('mswin32')  { $user = $ENV{USERNAME} }
        default           { say "osname is something we don't know, " 
+,
                                "we'll guess it's something Unixy, so 
+" ,
                                "let's say that user name is " ,
                               getlogin || "null";
                            $user = getlogin;
                          }
    }
    return $user;
}
# ------------------------------------------------------------- #
# For all its wealth of methods, I found no direct equivalent of
# "tmpdir" in Path::Tiny, so I use File::Spec's.
say "We use " , File::Spec->tmpdir , " for temporary files.";
# ------------------------------------------------------------- #
say "We are currently in directory " , Path::Tiny->cwd;
say "Our filesystem is rooted at " , Path::Tiny->rootdir;
say "Aha, " , who() , ", we may have a temp dir for you!";
my  $tadah = Path::Tiny->tempdir(TEMPLATE => "${user}-XXXXXXXX");
say "Maybe we have made a temp directory at " , $tadah , ", let's see:
+";

if ( -e $tadah and -d $tadah ) {
    say "'$tadah' already exists and is a directory.";
    say "Type 'y' if you wish to remove this directory:";
    ReadMode 'cbreak';
    my $reply = ReadKey(0);
    ReadMode 'normal';

    if (lc $reply eq "y") {
        print "Ok, we are going to attempt to remove it now ..." ;
        rmdir($tadah) and say "Success."
                       or say "BAH! Could not remove it, reason: $!";
    } else {
        say "Ok, leaving $tadah alone.";
    }
} else {
    mkdir($tadah => 0777) and say "created temp dir."
                           or die "We couldn't make a directory \"$tad
+ah\"", $!;
    sleep 6;
    rmdir($tadah) and say "$tadah removed."
}
[download]

         Rate   pp   xs
pp  3159521/s   -- -73%
xs 11612872/s 268%   --
      Rate    pp    xs   xs2
pp   333/s    --  -72%  -93%
xs  1192/s  258%    --  -74%
xs2 4516/s 1255%  279%    --
[download]

BEGIN {
    sub APICONTROL_CC_STD    () { 0 }
    sub APICONTROL_CC_C    () { 1 }
}
sub calltype_to_num {
    my $type = shift;

    if (!$type || $type eq "__stdcall" || $type eq "WINAPI" || $type e
+q "NTAPI"
        || $type eq "CALLBACK"  ) {
        return APICONTROL_CC_STD;
    }
    elsif ($type eq "_cdecl" || $type eq "__cdecl" || $type eq "WINAPI
+V") {
        return APICONTROL_CC_C;
    }
    else {
        warn "unknown calling convention: '$type'";
        return APICONTROL_CC_STD;
    }
}
[download]

I32
calltype_to_num_xs(type)
    SV* type
PREINIT:
    const char * p;
    I32 l;
CODE:
    SvGETMAGIC(type);
    if(!SvPOK(type)) {
        if(!SvOK(type) || (SvIOK(type) && !SvIVX(type)) || !sv_true(ty
+pe)) {
            RETVAL = APICONTROL_CC_STD;
        } else {
            unk:
            warn("unknown calling convention: '" SVf "'", type);
            RETVAL = APICONTROL_CC_STD;
        }
    } else {
        p = SvPVX(type);
        l = (U32)SvCUR(type);
        switch(l) {
            case STRLENs(""):
                if(memEQs(p,l,"")){RETVAL = APICONTROL_CC_STD;break;}
                else goto unk;
            case STRLENs("CDECL"):
                if(memEQs(p,l,"CDECL")){RETVAL = APICONTROL_CC_C;break
+;}
                else if(memEQs(p,l,"NTAPI")){RETVAL = APICONTROL_CC_ST
+D;break;}
                else if(memEQs(p,l,"cdecl")){RETVAL = APICONTROL_CC_C;
+break;}
                else goto unk;
            case STRLENs("PASCAL"):
                if(memEQs(p,l,"PASCAL")){RETVAL = APICONTROL_CC_STD;br
+eak;}
                else if(memEQs(p,l,"WINAPI")){RETVAL = APICONTROL_CC_S
+TD;break;}
                else if(memEQs(p,l,"WMIAPI")){RETVAL = APICONTROL_CC_S
+TD;break;}
                else if(memEQs(p,l,"pascal")){RETVAL = APICONTROL_CC_S
+TD;break;}
                else if(memEQs(p,l,"_cdecl")){RETVAL = APICONTROL_CC_C
+;break;}
                else goto unk;
            case STRLENs("WINAPIV"):
                if(memEQs(p,l,"WINAPIV")){RETVAL = APICONTROL_CC_C;bre
+ak;}
                else if(memEQs(p,l,"__cdecl")){RETVAL = APICONTROL_CC_
+C;break;}
                else goto unk;
            case STRLENs("APIENTRY"):
                if(memEQs(p,l,"APIENTRY")){RETVAL = APICONTROL_CC_STD;
+break;}
                else if(memEQs(p,l,"CALLBACK")){RETVAL = APICONTROL_CC
+_STD;break;}
                else if(memEQs(p,l,"IMAGEAPI")){RETVAL = APICONTROL_CC
+_STD;break;}
                else goto unk;
            case STRLENs("__CRTDECL"):
                if(memEQs(p,l,"__CRTDECL")){RETVAL = APICONTROL_CC_C;b
+reak;}
                else if(memEQs(p,l,"__stdcall")){RETVAL = APICONTROL_C
+C_STD;break;}
                else goto unk;
            case STRLENs("__fastcall"):
                if(memEQs(p,l,"__fastcall")){goto unk;RETVAL = APICONT
+ROL_CC_FC;break;}
                else if(memEQs(p,l,"__thiscall")){goto unk;RETVAL = AP
+ICONTROL_CC_TC;break;}
                else if(memEQs(p,l,"APIPRIVATE")){RETVAL = APICONTROL_
+CC_STD;break;}
                else goto unk;
            case STRLENs("__vectorcall"):
                if(memEQs(p,l,"__vectorcall")){goto unk;RETVAL = APICO
+NTROL_CC_VC;break;}
                else goto unk;
            case STRLENs("STDAPICALLTYPE"):
                if(memEQs(p,l,"STDAPICALLTYPE")){RETVAL = APICONTROL_C
+C_STD;break;}
                else goto unk;
            case STRLENs("STDAPIVCALLTYPE"):
                if(memEQs(p,l,"STDAPIVCALLTYPE")){RETVAL = APICONTROL_
+CC_C;break;}
                else goto unk;
            case STRLENs("STDMETHODCALLTYPE"):
                if(memEQs(p,l,"STDMETHODCALLTYPE")){RETVAL = APICONTRO
+L_CC_STD;break;}
                else goto unk;
            case STRLENs("STDMETHODVCALLTYPE"):
                if(memEQs(p,l,"STDMETHODVCALLTYPE")){RETVAL = APICONTR
+OL_CC_C;break;}
                else goto unk;
            default: goto unk;
        }
    }
OUTPUT:
    RETVAL

void
calltype_to_num_xs2(intype)
INPUT:
    SV* intype
PREINIT:
    SV* sv = sv_2mortal(newSVpvs("__stdcall"));
    int i;
PPCODE:
    SP = &(ST(-1));
    for(i=0;i<1000;i++) {
        PUSHMARK(SP);
        PUSHs(sv);
        PUTBACK;
        XS_Local__C_calltype_to_num_xs(aTHX_ cv);
        SPAGAIN;
        SP = &(ST(-1));
    }
    PUTBACK;
[download]

use Local::C;
use Benchmark qw(cmpthese :hireswallclock);

{   my ($pp, $xs, $xs2, $cctype) = (\&Local::C::calltype_to_num, \&Loc
+al::C::calltype_to_num_xs, 
\&Local::C::calltype_to_num_xs2);
    cmpthese( -1, {
        pp => sub{&$pp('__stdcall');}, 
        xs => sub{&$xs('__stdcall');}
    });
    cmpthese( -1, {
        pp => sub{&$pp('__stdcall') for(0..10000);}, 
    xs => sub{&$xs('__stdcall') for(0..10000);},
    xs2 => sub{&$xs2('__stdcall') for(0..10);}
    });
exit;
}
[download]

I'm semi-retired, which means I take care of a client's system of Perl scripts that mostly run without my intervention. I log everything with the excellent Log::Log4perl module, and sometimes I tail those files to keep on eye on the various scripts that run. One group of scripts creates tickets for new orders, and other scripts update these tickets based on what Sage (the accounting system) says.

Eventually, I started to think about understanding the life-cycle of these tickets -- they get created (that's logged in one file), they get updated (logged in a couple of other files), and they get closed (logged in two other files). Could I parse all of the log files and see the life-cycle just by drawing inferences? It's an academic exercise, since all I have to do is query the ticketing system's API about the history of a ticket, but like I said, I'm mostly retired, but I'm still curious.

The lines are like this:

2024/11/28 10:54:04 INFO : Update ticket 425955 to add invoice 802436 
+tag .. OK
2024/11/28 10:54:05 INFO : Update ticket 425912 to add invoice 802435 
+tag .. OK
2024/11/28 10:54:06 INFO : Add note to ticket 425912 with info about i
+nvoice 802435 .. OK
2024/11/28 10:57:02 INFO : Create FD ticket 425991 for order 662626 ..
+ OK
[download]

Eventually, some of my brain cells told me I needed to use a named capture in the regular expressions to handle this. Other brain cells complained that I'd never used that before, but the first group of brain cells said, Nonsense (or Buck Up, I forget), it's all in the Camel if you just look.

So, when you're capturing stuff in a regexp with a clause like (\d+), that first capture just gets stashed in $1. But you can also name that capture (a feature I never needed until now), like this: (?<ticket>\d+). And you get it out by looking at the magic variable %+, so the ticket value is available as $+{ ticket }. SO COOL!

I was then able to write a bunch of regular expressions, all with named captures, and collect whatever I needed from the log lines. Then, if a particular element was there, I would add it to the history hash I was building. So one of the AoH entries looked like this:

{
  filename => 'status.log',
  regexp   => qr/Update (?<ticket>\d+) status to (?<status>.+) \.\./,
  action   => 'update'
},
[download]

$history{ $+{ ticket } }{ $entry->{ action } } = {
                                     date  => $words[0],
                                    'time' => $words[1],
  ( exists ( $+{ order } ) ? (       order => $+{ order } ) : () ),
  ( exists ( $+{ invoice } ) ? (   invoice => $+{ invoice } ) : () ),
  ( exists ( $+{ shipment } ) ? ( shipment => $+{ shipment } ) : () ),
  ( exists ( $+{ scheduled_date } ) ? (
                            scheduled_date => $+{ scheduled_date } ) :
+ () ),
  ( exists ( $+{ status } ) ? (     status => $+{ status } ) : () ),
};
[download]

The code runs fine, and does what I expect. Named captures are a very cool feature, but they do exactly what I needed to do. Props to all the smart folks who came up with that idea (and then implemented it). What a cool language.

yesterday I was trying some perl code after neverending boring weeks (workwise..) and I tried to use -s to add rudimentary switch parsing as described here (emphasis added by me):

> -s enables rudimentary switch parsing for switches on the command line after the program name but before any filename arguments (or before an argument of --).

The above is true when there is a real file containing a perl program:

echo print join ' ', $0, $R > switch-test.pl

# after the program name
perl -s switch-test.pl  -R=OK
switch-test.pl OK

# before an argument of --
perl -s switch-test.pl  -R=OK --
switch-test.pl OK

# wrong usage
perl -s switch-test.pl -- -R=OK
switch-test.pl
[download]

But what if the program is just some code passed with -e (and this is a valid program also for the program name perl's internal value)?

Even with my limited English understanding, I'd suppose something like: perl -s -e "print $R" R=a or perl -s -e -n "print $R" R=a filename (before any filename arguments) but no, it works exactly in the opposite way:

# after the program name
perl -s -e "print join ' ', $0, $R"  -R=OK
Unrecognized switch: -R=OK  (-h will show valid options).

# before an argument of --
perl -s -e "print join ' ', $0, $R"  -R=OK --
Unrecognized switch: -R=OK  (-h will show valid options).

# it works in the opposite way of what perlrun states
perl -s -e "print join ' ', $0, $R" -- -R=OK
-e OK
[download]

So, given the switch is stated as rudimentary one should expect to use with small oneliners (only our dead pope used it as signature..) and not for serious programs.

In combination with other switches is even unfriendly:

perl -snwe "print join ' ', $0, $R, $/" -- -R=OK lorem.txt

-e OK
-e OK
-e OK
-e OK
[download]

..as it shuold be put before any file name but after the --

The docs also warns about warnings:

> Also, when using this option on a script with warnings enabled you may get a lot of spurious "used only once" warnings.

..but no... or.. what happens??

perl -wse  "print join ' ', $0, $R" -- -R=OK
-e OK

perl -swe  "print join ' ', $0, $R" -- -R=OK
-e OK

perl -sew  "print join ' ', $0, $R" -- -R=OK

#what the hell?! ..no output :)
[download]

I think the doc should metion the above. More: in this sight also -- is poorly documented.

Want some monk put a pr somewhere or point me, lazy peon, to the correct repository to strike?

Have a nice weekend!

L*

What's happening with the Cygwin project?

I recall recently seeing a remark (on a node I cannot find now) wherein the monk asked "is Cygwin still supported?" That's a good question. Certainly cygwinPerl seem to be alive and current on the Cygwin download servers (at the time of this writing, v5.40.0). But a mechanism for asking questions about Cygwin in general is seemingly problematic and has been for a while. The Cygwin website is completely out of date, directing users to mailing lists that do not exist anymore. Apparently to reach Cygwin developers one must use NNTP (we're talking old school here).

The Cygwin.com site says: "Please note that the gmane website and its newsgroup search interface is down since August 2016. Only the aforementioned NNTP gateway is still up."

I see a fair amount of traffic in Cygwin questions on StackOverflow and its related sites, and if someone were to ask me where to get general help with Cygwin today, that's where I would direct them.

The Wordpress and Mullenweg story popped up recently, and then just this morning, I read about Perforce and Puppet, where it sounds like Perforce took over the Slack community of Puppet.

The final comment in the Mastodon post was on point:

.. has something happened behind the scenes in tech that I don't know about? Because everybody seems to be acting proper weird lately.