Hello my fellow Monks.

I've been absent the last few months. I have, unfortunately, been forced to submit to the snake cult.

I resisted. I resisted for as long as I could. I even thought I might get away with continuing to use Perl until my "retirement" from corporate life that is hopefully less than a half decade away. But alas, the pervasiveness of Python, and it's success in becoming the first language of choice for so many engineering schools for the last several years has backed me in to a corner, and the zealots have come for me demanding I convert or be burned at the stake for heresy. I am in effect being told I can no longer write scripts in Perl and must adopt Python so that others can read and modify my code. :-(

Our young engineers use Python. Our technicians use Python. All our automated tests and data analytics are now written in Python. I had such hope when I joined my current company. They even had an old learning course on video originally taught in person by someone who is now one of our VPs called "Test Automation with Perl Scripting"... but it's almost two decades old now.

Sadly, I simply don't have the capacity at this point to maintain any sort of proficiency in two scripting languages. Frankly, I barely have enough for one. So I am now forced to type their indoctrination mantras in the devil's own parseltoungue. Pity me, for your brother monk has truly fallen from grace.

I may leave the monastery now, some seven years after I joined your order, but I have decided to leave it as I have lived in it. With a bit of my own awkward brand of humor via one final Perl Poetry entry from the Monk who fancies himself a drunken poet.

To those of you who have helped me over the years, or made me laugh, or raised my spirits, I sincerely thank you. Be well, live long, and prosper. :-)

- perldigious

Happy Holidays, fellow Monks!

Over the last decade, with lots of help, I've been able to bring forth some interesting things for Perl, and I'm now in the beginning stage of another one.

I put forth an API to command and control Raspberry Pi devices and dozens of Integrated Circuits and sensors related to it. I then reverse engineered Tesla's API and wrapped it with Perl.

I'm a strong privacy advocate. For years, I distrusted all vendors of all kind. However, through one of my jobs, I was forced to better familiarize myself with Apple. Despite issues and setbacks, they are, IMHO, very reasonable with privacy. Even their legalese is human readable for the most part. In fact, not only am I typing this on a Macbook, I have an iPhone, Apple Watch and several devices that allow me to control my home automation. Yep, I am even friends with Siri.

With that said, I want to embark on another very, very ambitious project... figure out how I can write a Perl API to deal with Apple devices, particularly HomeKit stuff.

To keep this SoPW, does anyone have experience writing Perl software or wrappers against anything Apple? I'm wiggling my way into a position of a starting point.

Happy Holidays all, and thanks for being supportive of both Perl, and myself over the years. You're all the reason I've become the developer I have.

Cheers,

-stevieb

The website didn't tell me anything exciting on my arrival today, but I know it's my Monk Day because it's also my older step-son's birthday. :) Matt's now 35 (yikes).

My Dad, who was 90, died this Fall. He was a retired actuary, and loved Maths. His father was a higher-up at one of the insurance companies in London, so Dad kind of fell into that field, although I think his first love was trains and civil engineering. When I started to show an aptitude for math, he would gladly give me a problem (like calculating ten factorial) to go to sleep with. He worked on his insurance company's computer system, an IBM 360 package called A Life Insurance System (ALIS, an IBM product, obviously), written in COBOL. He also did some work in APL (another brilliantly name IBM package that stands for A Programming Language).

So, by the time my high school got time-sharing access to the school board's mainframe so we could learn BASIC, he was all keen to jump in and try it out (Fall of '73), by writing a program that calculated the probabilities of the various blood types in a population. I became one of the nerds who would hang out in the computer room, trying out code and watching fellow nerds do cool stuff on the teletype. Sometimes, we'd download our programs to yellow paper tape.

University work terms led to me learning assembler, and then C. Full time work led to Pascal, then awk and Perl. SQL crept in pretty soon after that. Once outside the safe walls of university, I had to figure out my own continuing education, which is where the Perl community came in. I started with the local Perlmongers, and continued with this community. It's a cool place to ask questions, read other folks' answers, and maybe provide some answers of your own.

My education continues to this day. And I thank you all. :)

sub setpixel {
  my ($self, %opts) = @_;

#  $self->_valid_image("setpixel") or return;

  my $color = $opts{color};
  unless (defined $color) {
    $color = $self->{fg};
    defined $color or $color = NC(255, 255, 255);
  }

#  unless (ref $color && UNIVERSAL::isa($color, "Imager::Color")) {
#    unless ($color = _color($color, 'setpixel')) {
#      $self->_set_error("setpixel: " . Imager->errstr);
#      return;
#    }
#  }

  unless (exists $opts{'x'} && exists $opts{'y'}) {
    $self->_set_error('setpixel: missing x or y parameter');
    return;
  }
...
}

sub _valid_image {
  my ($self, $method) = @_;
 
  ref $self
    or return Imager->_set_error("$method needs an image object");
 
  $self->{IMG} && Scalar::Util::blessed($self->{IMG}) and return 1;
 
  my $msg = $self->{IMG} ? "images do not cross threads" : "empty inpu
+t image";
  $msg = "$method: $msg" if $method;
  $self->_set_error($msg);
 
  return;
}
[download]

I admit that dualvar was a term I never felt looking up until it came up recently here at the Monastery at Re^2: Rosetta Code: Long List is Long -- dualvar by marioroy. And I had a look at it. I found that Scalar::Util's dualvar can indeed create such a variable but I did not find any way of driving an existing variable into schizophrenic behaviour.

And so here is a gutty way to alter the string and/or numeric part of an existing scalar. Mind you I did a brief search on whether there was already some existing package doing that but did not find any.

This can find applications in some cases of the Schwartzian transform where the "decorations" and "undecorations" can apply on existing data rather than creating new (re: decorate/undecorate, Schwartzian_transform). The concept is not new (e.g. see comments under https://www.endpointdev.com/blog/2009/08/perls-scalarutildualvar/), but I did not find anything without creating new (dual)var but altering existing var. So here it is in a single-file SCSE form (XS can be found in ./_Inline/build dir):

## by: bliako
## on: 2022-12-05
## EDIT: kudos to https://metacpan.org/release/PEVANS/Scalar-List-Util
+s-1.63/source/ListUtil.xs (line 1674, dualvar)

use strict;
use warnings;
use Devel::Peek;
use Inline Config => clean_after_build => 0;
use Inline C => <<'EOC';
        // alter the 'numeric' slot of existing var 'asv' with that of
+ 'theiv'
    void setIV(SV *asv, SV *theiv){
        (void)SvUPGRADE(asv, SVt_PVNV);
        SvIV_set(asv, SvIV(theiv));
        SvIOK_on(asv);
    }
        // alter the 'string' slot of existing var 'asv' with that of 
+'thesv'
    void setSV(SV *asv, SV *thesv){
        sv_setsv(asv, thesv);    
    } 
EOC

my $num = 42;
my $x = "My name is Ace!";
Dump($x);

setIV($x, $num);
Dump($x);
setSV($x, "Hello Ozy!");
Dump($x);

# and here is a one-legged Schwartzian transform
# to sort strings on their lengths using above XS:
my @unsorted = ("Just", "another", "Perl\x{7}\x{7}\x{7}", "hacker\x{7}
+");
my @sorted = sort { $a <=> $b }
    map { setIV($_, length($_)); $_ } @unsorted;
print "Sorted: @sorted\n";
;
[download]

Hacking away with Perl into the new year ... (actually I think I am in 2048 already, riding on Perl)

bw, bliako

I've long found it fun to implement the same algorithm in different languages, especially Perl and C++ ... and then sit back and reflect on the lessons learned ... so when Long list is long appeared recently, I felt it was short and interesting enough to make an excellent Rosetta code node.

Solutions to this problem must read a number of input LLiL-format files (given as command line arguments) and write a single merged LLiL-format file to stdout. The LLiL-format is described in the comments at the top of llil.pl below.

In the interests of keeping the code as short and fast as possible, you may assume the input LLiL files are well-formed. For example, you don't need to check for and remove leading and trailing whitespace on each line. The sample solutions given below in Perl and C++ should clarify program requirements.

Please feel free to respond away with solutions to this problem in your favourite programming language and to offer suggested improvements to my sample Perl and C++ solutions below.

Perl Solution

Here's my Perl solution, heavily influenced by responses to Long list is long, especially kcott's concise and clear solution:

# llil.pl
# Example run: perl llil.pl tt1.txt tt2.txt >oo1.tmp

use strict;
use warnings;

# --------------------------------------------------------------------
+--
# LLiL specification
# ------------------
# A LLiL-format file is a text file.
# Each line consists of a lowercase name a TAB character and a non-neg
+ative integer count.
# That is, each line must match : ^[a-z]+\t\d+$
# For example, reading the LLiL-format files, tt1.txt containing:
#   camel\t42
#   pearl\t94
#   dromedary\t69
# and tt2.txt containing:
#   camel\t8
#   hello\t12345
#   dromedary\t1
# returns this hashref:
#   $hash_ret{"camel"}     = 50
#   $hash_ret{"dromedary"} = 70
#   $hash_ret{"hello"}     = 12345
#   $hash_ret{"pearl"}     = 94
# That is, values are added for items with the same key.
#
# To get the required LLiL text, you must sort the returned hashref
# descending by value and insert a TAB separator:
#   hello\t12345
#   pearl\t94
#   dromedary\t70
#   camel\t50
# To make testing via diff easier, we further sort ascending by name
# for lines with the same value.
# --------------------------------------------------------------------
+--

# Function get_properties
# Read a list of LLiL-format files
# Return a reference to a hash of properties
sub get_properties
{
   my $files = shift;    # in:  reference to a list of LLiL-format fil
+es
   my %hash_ret;         # out: reference to a hash of properties
   for my $fname ( @{$files} ) {
      open( my $fh, '<', $fname ) or die "error: open '$fname': $!";
      while (<$fh>) {
         chomp;
         my ($word, $count) = split /\t/;
         $hash_ret{$word} += $count;
      }
      close($fh) or die "error: close '$fname': $!";
   }
   return \%hash_ret;
}

# ----------------- mainline -----------------------------------------
+--

@ARGV or die "usage: $0 file...\n";
my @llil_files = @ARGV;

warn "llil start\n";
my $tstart1 = time;
my $href    = get_properties( \@llil_files );
my $tend1   = time;
my $taken1  = $tend1 - $tstart1;
warn "get_properties : $taken1 secs\n";

my $tstart2 = time;
for my $key ( sort { $href->{$b} <=> $href->{$a} || $a cmp $b } keys %
+{$href} ) {
   print "$key\t$href->{$key}\n";
}
my $tend2  = time;
my $taken2 = $tend2 - $tstart2;
my $taken  = $tend2 - $tstart1;

warn "sort + output  : $taken2 secs\n";
warn "total          : $taken secs\n";
[download]

What makes this problem interesting to me is the requirement to sort the hash in descending order by value:

sort { $href->{$b} <=> $href->{$a} || $a cmp $b } keys %{$href}
[download]

I'm hoping solving this problem in multiple languages will be fun and instructive -- and perhaps give us insight into how performance changes as the number of items increases.

Greetings, all

The following is a glimpse of what's coming for MCE. There are two new modules; MCE::Semaphore and MCE::Simple. I completed the code tonight. Now, I need to finish the docs and more testing before releasing on Meta::CPAN.

MCE Simple

use MCE::Simple -strict, max_workers => 4;

MCE::Simple->init(
    # mce options
    user_begin => sub {
        MCE->say("hello from ", MCE->wid);
    },
    # spawn options
    on_finish => sub {
        my ( $pid, $exit, $ident, $signal, $error, @ret ) = @_;
        say "@_";
    },
);

mce_foreach my $i ( 1..10 ) {
    MCE->say(MCE->wid, ": $i * 2 = ", $i * 2);
}

spawn "Hello", sub { "one" };
spawn "There", sub { "two" };

foreach my $ident (qw/foo baz/) {
    spawn $ident, sub {
        my $text = "something from $$";
    };
}

sync;

# clear or set options
MCE::Simple->init();

sub fib {
    my $n = shift;
    return $n if $n < 2;

    spawn my $x = fib($n - 1);
    spawn my $y = fib($n - 2);

    sync $x;
    sync $y;
 
    return $x + $y;
}

say "fib(20) = ", fib(20);
[download]

Output

$ perl demo.pl 
hello from 1
hello from 2
hello from 3
hello from 4
3: 2 * 2 = 4
4: 1 * 2 = 2
2: 3 * 2 = 6
3: 5 * 2 = 10
4: 6 * 2 = 12
1: 4 * 2 = 8
4: 7 * 2 = 14
3: 8 * 2 = 16
2: 9 * 2 = 18
1: 10 * 2 = 20
10792 0 Hello 0  one
10793 0 There 0  two
10794 0 foo 0  something from 10794
10795 0 baz 0  something from 10795
fib(20) = 6765
[download]

MCE Semaphore

A fast pure-Perl implementation. Testing involves big number. Notice the mce_foreach_s keyword, for processing a sequence of numbers.

use MCE::Simple -strict, max_workers => 16;

use MCE::Semaphore;
use Time::HiRes 'time';

my $start = time;
my $sem = MCE::Semaphore->new(8);

mce_foreach_s ( 1 .. 1_000_000 ) {
    $sem->down;
    $sem->up;
}

printf "%0.3f seconds\n", time - $start;
[download]

Input file

mce_foreach_f ("/path/to/file") {
    MCE->print($_);
}

# what about file handles? no problem...
open my $fh, "<", "/tmp/infile.txt" or die "open error: $!";

mce_foreach_f my $line ( $fh ) {
    MCE->print($line);
}

close $fh;
[download]

Every two weeks, I switch from embedded developer to network and server administrator to keep our network and servers at work up and running. Today, updating our issue/requirement/test tracking software was on the plan. We have four virtual machines, each running one instance of the software. I won't state its name, and I will neither confirm nor deny any guess. But let's say the manufacturer has recently demonstrated in that their idea of forcing their clients to use the cloud variant of their software instead of local servers might not be the best idea. Users don't like having years of work deleted from the cloud servers, without a way to undo that quickly and completely.

Experience from previous updates has taught me to make a full backup of the entire VM before updating. So the day started with shutting down all four VMs and creating copies of their harddisk image files. Just to be sure. The VMs are relatively small, just a bare-bones installation of Debian plus a database plus the bugtracker software, so that four extra copies of the HDD images don't matter much.

I planned the entire day for the update, expecting some trouble with the first VM to learn about the new issues during the update, and then be able to update the three other VMs much faster, knowing what issues to expect. So I was absolutely not surprised that the first update went bonkers.

Act One

The update installer did created some zip files of the existing installation (don't hope to be able to recover from a broken update using those zip files), then removed the entire old version of the bugtracker software and unpacked the new version. "Do you want me to overwrite some.freaking.dll in the program directory?" Sure, why not? If the installer wants to overwrite what was unpacked seconds ago, let it do so. I have a good HDD image. A few moments later, it started the web server and pointed me to http://localhost:someport/. No, that web interface does not work in lynx or links, we are running a server, not a point-and-shoot adventure game. But the web server is really listening on all interfaces, so I can connect using Firefox on my PC. After several minutes of the old "don't blink, you might miss the progress bar moving another pixel" game, the browser shows the well-known "oops, something went wrong" page.

"We can't talk to the database." Well, the old version could. The old version had a database config file stating that we use a really exotic database. You probably never heard of it. It is called MySQL. Right out of the Debian package (so it is actually MariaDB). After some clicking on the eror page, you end at a wiki page of the manufacturer, which tells you to download a MySQL driver from a third party page. Yes, I really know that issue, and I should have thought about it, because it happened with every single update so far. It must be incredible hard to parse the database config file from the updater and instruct the admin right from the updater to download and install that driver BEFORE playing the waiting game. And it must be absolutely impossible just to bundle the driver like the tons of other crap that come with the software.

So, copy the driver file (it really is just a single file!) to /opt/crap/crap/crap/lib/, restart the server, play the waiting game again. "Oops, something went wrong." Yes, sure. "We can't detect the database version." I could not care less. "We just discarded your old startup configuration, here is a link to our wiki how to fix that." Oh well, it's just fine-tuning of how much memory the bugtracker wastes. Defaults are fine for now. "There is an expired license installed, you are only allowed to update to versions that were released before that license expired." What? "Click here to buy a new license, click here to enter the new license code." There is no way to bypass that.

I share the administration of the bugtracker with a coworker. She does the high-level stuff (workflow, addons and so on), I care about OS, database, network, backup, and basic installation. She told me that we don't actually use that license. The license is not for the bugtracker itself, it is for a component that wasn't even installed in the old version. The expired license is just garbage data, we don't use that component, we don't need that component. It once was installed, but nobody bothered to delete the license code.

To make matters worse, there is no way to delete the expired license, or just tell the installer that we are willing not to be able to use the unlicensed component. At this point, you can either pay a lot of money to renew a license for a component that you don't want and don't need, just to get past that error screen, or shut down the VM and copy the backup copy of the HDD image over the actal HDD image. I did the latter.

Act Two

Restart the VM, remove that left-over license code, redo the update installation, this time copying the database driver before starting the webserver. "You were updated". No, the updater managed to do its job of updating the bugtracker. "Oh, and by the way, we are just rebuilding our search index. Because, you know, we can't search in the database." Actually, the last sentence was not displayed. But you have to wait for the index rebuild job has finished before you can continue.

Well, the updater did not manage to do its job. "There are this 20+ apps that won't work for whatever reason." Good, let's see if the bugtracker does work at all. The personalized overview page displays fine, but where is the navigation bar? It's gone. You can't log out. You can't gain admin privileges. You can't navigate anywhere. Let's open an existing issue. "500 Internal Server Error - click here to see a long, useless stack trace and a random number that will identify this problem". Some other attempts of navigating elsewhere also ended in that 500 page. Well, that did not go well.

Half a day has passed, and we just managed to kill the first bugtracker VM twice. Or, to be precise, watch it commit suicide. Guess what? Shutdown, copy the backup once more over the actual HDD image, and retry a third time.

Act Three

My coworker thought that one of that many add-ons that she installed might be responsible for the trouble. (I don't know why we need 20+ addons, we use the core functions, plus an add-on for requirements, plus one add-on for tests, plus one add-on for making the search function work properly.) So she decided to clean up the mess, uninstall everything not needed, including that expired license.

It turns out that not everything uninstalled cleanly. "Something went wrong that you don't need to know. But if you really want to know, here is a link to an assistent that will tell you that we wrote some stack traces to one of the many log files." A 16 MByte log file. 390 kByte of which were created during the hour or so she tried to get rid of some garbage.

Well, shut down the VM, make a second copy of the HDD image just to have a slightly cleaner state to work from. Redo the update, again copying the database driver. After the waiting game, I'm greeted by the same "You were updated" screen, and only three add-ons are inoperable now. A few clicks later, I once again get the overview page. Almost any click gets me either to a much uglier 500 page than before, or to the pretty 500 page. "Click here to download an archive with all relevant data you can mail to our support." Click - "500 Internal Server Error". Yes, you can't even download the crash report archive.

VM suicide number three. After a short discussion, we decided to roll back to the very first backup I created in the morning. Copy the backup once again over the actual HDD image, start the VM again. Nearly eight hours have passed. We did not even try to update the three other VMs, we just started them in their old state.

Epilog

We wasted an entire day trying to update the software. It should be so simple. Run the update installer, add the database driver that the manufacturer does not bundle, watch the system update itself, run the new version. Or, if something is critical and might cause touble, get a good error message from the update installer BEFORE f-ing up the entire system.

It is possible. I know it, because my main job is software development. It takes testing, and during testing and development, you (as the developer) expect things to go horrible wrong. That's why VMs are so great. One click and you are back to a known state that you can fail to update again, and again, and again, until the updater just works or stops before damaging the system. With embedded systems, reverting to a known state is not always that easy, but even there, it is possible to make updates just work or abort before things go wrong.

I don't really want to know why the updater managed to kill our system three times, I just want it to do its job. Luckily, I'm on vacation now, and my coworker will contact the manufacturer of this crappy software. After my vacation, we will see how far she got.

Alexander

You've probably seen the new styling of MetaCPAN by now. One anonymous monk is less than enthralled. It's not all bad, IMHO and will hopefully improve over time. Meanwhile here is the little snippet of userContent.css which I've put together today to restore a little sanity.

Update 6th Oct 2022 with a fix for the search results and similar one-pane pages:

@-moz-document url-prefix(https://metacpan.org/) {
    div.page-content { grid-template-columns: 200px calc(100vw - 200px
+) !important; }
    .no-sidebar div.page-content { grid-template-columns: 1fr !importa
+nt; }
    ul.nav-list { padding: 10px !important; width: 200px !important }
    ul.nav-list>li a, ul.dependencies>li>a { color: #337ab7 !important
+ }
    div.content { padding: 20px !important }
    #index-container { margin-left: 20px !important }
}
[download]

Original attempt was:

@-moz-document url-prefix(https://metacpan.org/) {
    div.page-content { grid-template-columns: 200px calc(100vw - 200px
+) !important; }
    ul.nav-list { padding: 10px !important; width: 200px !important }
    ul.nav-list>li a, ul.dependencies>li>a { color: #337ab7 !important
+ }
    div.content { padding: 20px !important }
    #index-container { margin-left: 20px !important }
}
[download]

This will:

• Reduce the left nav from 300 to 200 pixels in width and reduce the padding on the main content so there is not so much wasted space (Don't ask me why they've gone with a fixed pixel width here to begin with)
• Re-enable the different styling (colour) of links in the nav so you can tell what is a link and what is just info once again

We'll see how much this needs tweaking over the next little while but at least if you are interested in this it saves us all reverse-engineering it independently.

The new layout proposal and discussion is in the issues here.

https://web.archive.org/web/20220930101235/https://metacpan.org/pod/strict

close the wayback popup. Try the hamburger menu (3 lines). Its all so dark. And takes up much space on mobile.

being our halls so quite in these days I'm lazily inviting you to meditate about LWP::UserAgent behaviour returning 500 when LWP can't connect to some URL or when other failures in protocol handlers occur.

Is this breaking HTTP specification? If ever glanced current rfc or not you should know that all 5** status code are server side.

The LWP doumentation is very clear on this:

> There will still be a response object returned when LWP can't connect to the server specified in the URL or when other failures in protocol handlers occur. These internal responses use the standard HTTP status codes, so the responses can't be differentiated by testing the response status code alone. Error responses that LWP generates internally will have the "Client-Warning" header set to the value "Internal response". If you need to differentiate these internal responses from responses that a remote server actually generates, you need to test this header value.

Infact..

use strict;
use warnings;

use LWP::UserAgent;

my $ua = LWP::UserAgent->new();

for my $url ( qw( https://perlmonks.org https://perlmonks.roma.it) ){

    print "\nGET $url\n";
    my $res = $ua->get( $url );

    # ..yes you can $res->status_line to have both combined
    print "code                 :\t", $res->code, "\n";
    print "message              :\t", $res->message, "\n"; 
    print "Client-Warning header:\t", $res->header( "Client-Warning" )
+, "\n";    
    
}

__END__

GET https://perlmonks.org
code                 :  200
message              :  OK
Client-Warning header:

GET https://perlmonks.roma.it
code                 :  500
message              :  Can't connect to perlmonks.roma.it:443
Client-Warning header:  Internal response
[download]

The message returned is already very clear Can't connect.. is oblviously client side: so why the choose of an error of the 5** class?

In the chat LanX suggested 418 I'm a teapot and is fun and new to me, but not usable: teapots are reserved to IANA :)

In the 4** class are defined status codes 401-418 plus 421 422 426 so there is room to have something like: 419 - Can't connect

See also other status numbers used to craft a HTTP::Response

So (and I dont want to blame LWP authors) why they choosed to return 500 setting an header internally to disambiguate it?

What other frameworks do? Quickly trying Mojo::UserAgent I see it uses it's own Mojo::Message::Response and does not return any status code for unexisting urls:

 
use strict;
use warnings;

use Mojo::UserAgent;
my $ua  = Mojo::UserAgent->new;

for my $url ( qw( https://perlmonks.org https://perlmonks.roma.it) ){

    print "\nGET $url\n";
    my $res = $ua->get( $url )->result;

    print "code                 :\t", $res->code, "\n";
    print "message              :\t", $res->message, "\n"; 
    #print "Client-Warning header:\t", $res->header( "Client-Warning" 
+), "\n";    
    
}

__END__

GET https://perlmonks.org
code                 :  200
message              :  OK

GET https://perlmonks.roma.it
Can't connect: Host unknown.  at testLWP500.pl line 10.
[download]

..and this error is defined in Mojo::IOLoop::Client it seems to me a better design, but... wait this is a die behaviour! if you switch URLs in the above code you never reach the second GET.

By other hand curl tell us it is unable to resolve the URL:

curl -I https://perlmonks.roma.it
curl: (6) Could not resolve host: perlmonks.roma.it
[download]

..and it is right.

What do you think about? What other frameworks I missed do?

Is 200 if you post 203 but no 204 will be accepted! :)

L*

Programming in Perl is choices all the way down. An OO standard library would make it a lot easier to write Perl in a way that avoids having to come up with similar or the same solutions to common computing tasks, but, ... sustained object-orientation in Perl is difficult because the concept and mechanisms were bolted onto the language as an afterthought, and because it's optional, so one has to oscillate between this paradigm and others, i.e. some things are objects, most things are not, so when using Perl you have to constantly reaffirm your object-orientation. What do you think?

http://blogs.perl.org/users/al_newkirk/2022/08/introducing-venus-a-new-world-for-perl-5.html

I have bashed String::ShellQuote several times:

• Re^2: preserve quotes after $0 interpolation
• Re^3: system() call mis-directs?
• Re^4: quoting/escaping file names
• Re^2: Passing values from Perl script to shell script

Most times, it was because the module promises to solve a problem that simply disappears completely if you avoid the shell. See The problem of "the" default shell.

Now, ovedpo15 came up with a problem that looks like a good reason to have a module like String::ShellQuote, and choroba proposed String::ShellQuote.

The problem boils down to generate a shell script from perl that will be run by different a user, perhaps on a different computer:

My Perl utility generates a bash script that consists of mkdir/rsync/cp commands. This bash script is later used by users (this means that I don't want to actually run those commands when my utility runs, rather just to generate the script).

And, in an answer to a previous bashing, ikegami stated:

You seem to allege some problem with shell_quote, but none of the linked post identify one. The all seemed centered around the idea of avoiding the shell is better. While true, that's not a problem with shell_quote.

So, let's have a look at the source code of String::ShellQuote version 1.04, dated 2010-06-11.

The module clearly states in "Bugs" that ...

Only Bourne shell quoting is supported.

Bourne is a large family of shells, but not every shell is a bourne shell. Also, not every default shell is a bourne shell. See https://www.in-ulm.de/~mascheck/various/shells/. Quite obviously, neither command.com from DOS and Windows nor cmd.exe from Windows are even vaguely similar to a bourne shell. The Almquist shell variants are very similar to bourne, but not exactly: https://www.in-ulm.de/~mascheck/various/ash/ The korn shells obviously aren't bourne shells, either.

So, as stated by the author, you should not expect the result values of the various functions to be compatible with anything but bourne shells.

With that out of the way, let's assume some bourne shell.

A 7th edition Bourne shell surely is a bourne shell, right?

There is a script that tries to find the version of your bourne compatible shell: https://www.in-ulm.de/~mascheck/various/whatshell/whatshell.sh.html. Did you notice something? There is also a commented version of that script at https://www.in-ulm.de/~mascheck/various/whatshell/whatshell.sh.comments.html. The very first explaining comment is this:

    : '7th edition Bourne shell aka the V7 shell did not know # as com
+ment sign, yet.'
    : 'Workaround: the argument to the : null command can be considere
+d a comment,'
    : 'protect it, because the shell would have to parse it otherwise.
+'
[download]

So, shell_comment_quote() should better use the null command followed by a single-quoted string so that the output works with the bourne shell.

This is the documentation:

shell_comment_quote quotes the string so that it can safely be included in a shell-style comment (the current algorithm is that a sharp character is placed after any newlines in the string).

And this is the code:

sub shell_comment_quote {
    return '' unless @_;
    unless (@_ == 1) {
        croak "Too many arguments to shell_comment_quote "
                    . "(got " . @_ . " expected 1)";
    }
    local $_ = shift;
    s/\n/\n#/g;
    return $_;
}
[download]

It does what is documented, but not every bourne shell will accept the output as comment. Oops #1.

There are two similar functions wrapping the quoting backend function:

sub shell_quote {
    my ($rerr, $s) = _shell_quote_backend @_;
 
    if (@$rerr) {
        my %seen;
        @$rerr = grep { !$seen{$_}++ } @$rerr;
        my $s = join '', map { "shell_quote(): $_\n" } @$rerr;
        chomp $s;
        croak $s;
    }
    return $s;
}
[download]

and

 
sub shell_quote_best_effort {
    my ($rerr, $s) = _shell_quote_backend @_;
 
    return $s;
}
[download]

The backend function returns a reference to an error array and the quoted string. shell_quote() removes repeated error messages, and finally croak()s. The only reason for this overhead I can think of is to get a list of all errors at once instead of getting just the first error. shell_quote_best_effort() just ignores all errors and returns whatever survived the backend function. If errors occured, that may be plain wrong. At least, this behaviour is documented:

This is like shell_quote, excpet [sic!] if the string can't be safely quoted it does the best it can and returns the result, instead of dying.

Now, what errors may be returned by the backend function?

sub _shell_quote_backend {
    my @in = @_;
    my @err = ();

# ...

    return \@err, '' unless @in;

# ...

        if (s/\x00//g) {
            push @err, "No way to quote string containing null (\\000)
+ bytes";
        }

# ...
 
    return \@err, $ret;
}
[download]

Yes, that's all. There is only one possible error. It does not like ASCII NUL, because ASCII NUL can not be passed as argument to programs. And because it does not like them, they are simply removed.

Whenever shell_quote() throws an error, at least one of its arguments contained at least one NUL character. shell_quote_best_effort(), in the same situation, just silently damages your data. Oops #2.

In all other cases, shell_quote_best_effort() behaves exactly like shell_quote().

Now, let's look at the quoting:

shell_quote(), which calls _shell_quote_backend(), is documented as following:

shell_quote quotes strings so they can be passed through the shell. Each string is quoted so that the shell will pass it along as a single argument and without further interpretation. If no strings are given an empty string is returned.

This is the code:

sub _shell_quote_backend {
    my @in = @_;
    my @err = ();
 
    if (0) {
        require RS::Handy;
        print RS::Handy::data_dump(\@in);
    }
 
    return \@err, '' unless @in;
 
    my $ret = '';
    my $saw_non_equal = 0;
    foreach (@in) {
        if (!defined $_ or $_ eq '') {
            $_ = "''";
            next;
        }
 
        if (s/\x00//g) {
            push @err, "No way to quote string containing null (\\000)
+ bytes";
        }
 
        my $escape = 0;
 
        # = needs quoting when it's the first element (or part of a
        # series of such elements), as in command position it's a
        # program-local environment setting
 
        if (/=/) {
            if (!$saw_non_equal) {
                $escape = 1;
            }
        }
        else {
            $saw_non_equal = 1;
        }
 
        if (m|[^\w!%+,\-./:=@^]|) {
            $escape = 1;
        }
 
        if ($escape
                || (!$saw_non_equal && /=/)) {
 
            # ' -> '\''
            s/'/'\\''/g;
 
            # make multiple ' in a row look simpler
            # '\'''\'''\'' -> '"'''"'
            s|((?:'\\''){2,})|q{'"} . (q{'} x (length($1) / 4)) . q{"'
+}|ge;
 
            $_ = "'$_'";
            s/^''//;
            s/''$//;
        }
    }
    continue {
        $ret .= "$_ ";
    }
 
    chop $ret;
    return \@err, $ret;
}
[download]

Right at the start of the foreach loop, an undefined parameter is treated like an empty string and simply returns ''. Note that next jumps to the continue block at the end of the foreach loop. Personally, I would not accept an undefined value, because probably something went wrong in the caller if we get undefined parameters.

Following that, NUL characters are killed, and data is damaged at the same time. See above. Personally, I would throw an error right here, NUL characters are a sure sign that something went wrong in the caller, and it makes no sense to continue.

The next step following the first comment in the forech loop is explained in that comment. A feature rarely known to beginners is that you can set environment variables for just the invoked program by prefixing the program with a list of key-value pairs. FOO=1 BAR=2 baz answer=42 invokes baz with the environment variables FOO and BAR set to 1 and 2, and a single argument answer=42. If you want to invoke a program named FOO=1 instead, and pass it the arguments BAR=2, baz, and answer=42, you need to quote at least the first equal sign.

The flag variables in the first if-then-else: $escape is reset for each parameter, $saw_non_equal is set as soon as a parameter does not contain an equal sign, and stays set. If an equal sign is found, and all previous parameters (if any) also contained equal signs, $escape is set, which forces quoting. This is not strictly needed: If the first parameter contains an equal sign and is quoted, it is taken as program name, and everything following will be read as arguments. So it would be sufficient to check the first parameter for an equal sign. On the other hand, it also does not hurt to quote every string that contains an equal sign, and it would make the code much simpler.

The whitelist matching if: If the parameter contains a character that is (quoting the output of YAPE::Regex::Explain) any character except: word characters (a-z, A-Z, 0-9, _), '!', '%', '+', ',', '\-', '.', '/', ':', '=', '@', '^', the $escape flag is set. The intention seems to be to avoid quoting if not strictly needed. I'm not sure if all of those characters in the whilelist are harmless. At least in bash (which is a bourne shell), at least the '!' does have a special meaning in the first position:

>bash --version
GNU bash, version 4.3.48(1)-release (x86_64-slackware-linux-gnu)
Copyright (C) 2013 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gp
+l.html>

This is free software; you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
>echo with some arguments !
with some arguments !
>foo with some arguments !
-bash: foo: command not found
>'!' foo
-bash: !: command not found
>! foo
-bash: foo: command not found
>
[download]

Note: the last example fails to find the "foo" command, not the "!" command. So "!" should better not be in that whitelist. Oops #3.

The last if in the foreach loop: You want to escape if the $escape flag is set. Sure. But you also want to escape if the $saw_non_equal flag is not set, i.e. all previous parameters, if any, contained an equal sign, and at the same time, the current parameter also contains an equal sign. Do you remember this condition? A few lines above, the $escape flag was already set, depending on exactly this condition. This second condition is completely redundant. Belts and braces, or lost in code?

The escaping: Singe quotes are replaced with the sequence '\'', which will end a single-quoted string, then add a single quote (quoted by the backslash), and finally begins a new single-quoted string. Ignore the next, long subsitution for now. $_ = "'$_'"; puts the partly-escaped string in a pair of single quotes. The next two substitutions s/^''//; and s/''$//; remove a leading resp. trailing empty single-quoted string. This may happen if the original parameter begins resp. ends with a single quote.

The long substitution replaces a sequence of at least two escaped single quotes ('\'') by '", followed by a bare single quote for each orignal single quote, followed by "'. This works almost like '\'', ending a single quoted string, then adding a double quoted string of single quotes, and finally starting a new single quoted string. For an original parameter of two single quotes, this finally results in "''" instead of \'\', with every further single quote, the double quoted string will be shorter that the bashslashed string ("'''" instead of \'\'\').

Joining the quoted strings: The foreach loop replaces the elements of @in with the quoted string in $_ ($_ is aliased to each element of @in). The continue block appends each quoted string and a space to $ret. Finally, chop $ret removes the last space. Is a simple join(' ',@in) too obvious?

Combining Oops #3 and the suppressed quoting of equal signs:

>bash --version
GNU bash, version 4.3.48(1)-release (x86_64-slackware-linux-gnu)
Copyright (C) 2013 Free Software Foundation, Inc.
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gp
+l.html>

This is free software; you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
>perl -MString::ShellQuote=shell_quote -E 'say shell_quote("!","FOO=BA
+R","baz")'
! FOO=BAR baz
>! FOO=BAR baz
-bash: baz: command not found
>'!' FOO=BAR baz
-bash: !: command not found
>! 'FOO=BAR' baz
-bash: FOO=BAR: command not found
>
[download]

In ! FOO=BAR baz, the bash treats baz as the executable, as indicated by the error message, and FOO=BAR as extra environment for the executable.

In shell_quote("!","FOO=BAR","baz"), ! should be the executable, simply because it is the first argument. Oops #3 prevents that it is quoted. Because the first parameter to shell_quote() does not contain an equal sign, escaping of equal signs is disabled for the remaining parameters. Oops #4.

Summay:

String::ShellQuote does not even work properly for bourne shells.

Oops #1: Assumes every bourne shell accepts # for comments. Most of them do, but the ancient V7 bourne shell does not. Oh well. Document it as limitation and ship it.

Oops #2: Silent damaging of data. IMHO not acceptable.

Oops #3: Not quoting a character that will be interpreted by at least one a bourne shell (bash) if not quoted. IMHO not acceptable.

Oops #4: Oops #3 may cause more missing quoting due to overly complex escaping descision. IMHO not acceptable.

Alexander

My Perl journey began 48 hours ago. My Mac now hosts v 5.36.0 in HOME/localperl. I have discovered cpanm and used it to effortlessly install perltidy and perlcritic into HOME/perl5. What I thought was an easy system halted with attempts to install Padre and ptkdb debugger. Both installations appeared to go well with countless OKs on the way…then at the last test fail.

I think I’m right in saying neither will in fact install on 64bit Macs. But - if this is the case - why does the installation begin. Surely cpanm knows what system it is trying to install into and should stop the process immediately with a polite message.

Padre is unlikely to be a loss - I now have vscode set up for perl and it recognises v 5.36.0, perltidy and perlcritic. Red squiggles appear when I forget - so far deliberately - to end a line with a ‘;’. It is likely that my debug tactic will be to print variables at various stages until the problem is found. This is usually easier than a formal debugger anyway.

The next stage of my journey will be working through Beginning Perl and Beginner Perl Maven. So far I’ve only dipped into them. The associated vids on the Perl Maven course are excellent introductions.

I suspect I will soon be seeking advice from Perl Monks - so many thanks in advance.