I was asked to evaluate the lcpan script from the App-lcpan distribution for $work.

I thought I'd just share its amazing dependency graph. ☺️

Improvement: See "Re: Decoding @ARGV [Was: uparse - Parse Unicode strings]" for an improved version of the code; mostly thanks to ++jo37 and the subthread starting with "Re: uparse - Parse Unicode strings" and continued in "Decoding @ARGV [Was: uparse - Parse Unicode strings]".

In the last month or so, we've had a number of threads where emoji were discussed. Some notable examples: "Larger profile pic than 80KB?"; "Perl Secret Operator Emojis"; and "Emojis for Perl Monk names".

Many emoji have embedded characters which are difficult, or impossible, to see; for example, zero-width joiners, variation selectors, skin tone modifiers. In some cases, glyphs are so similar that it's difficult to tell them apart; e.g. 🧑 & 👨.

I wrote uparse to split emoji, strings containing emoji, and in fact any strings with Unicode characters, into their component characters.

#!/usr/bin/env perl

BEGIN {
    if ($] < 5.007003) {
        warn "$0 requires Perl v5.7.3 or later.\n";
        exit;
    }

    unless (@ARGV) {
        warn "Usage: $0 string [string ...]\n";
        exit;
    }
}

use 5.007003;
use strict;
use warnings;
use open IO => qw{:encoding(UTF-8) :std};
use constant {
    SEP1 => '=' x 60 . "\n",
    SEP2 => '-' x 60 . "\n",
    FMT => "%s\tU+%-6X %s\n",
    NO_PRINT => "\N{REPLACEMENT CHARACTER}",
};

use Encode 'decode';
use Unicode::UCD 'charinfo';

for my $raw_str (@ARGV) {
    my $str = decode('UTF-8', $raw_str);
    print "\n", SEP1;
    print "String: '$str'\n";
    print SEP1;

    for my $char (split //, $str) {
        my $code_point = ord $char;
        my $char_info = charinfo($code_point);

        if (! defined $char_info) {
            $char_info->{name} = "<unknown> Perl $^V supports Unicode 
+"
                               . Unicode::UCD::UnicodeVersion();
        }

        printf FMT, ($char =~ /^\p{Print}$/ ? $char : NO_PRINT),
                    $code_point, $char_info->{name};
    }

    print SEP2;
}
[download]

Here's a number of example runs. All use <pre> blocks; a very few didn't need this but I chose to go with consistency.

Works with ASCII (aka Unicode: C0 Controls and Basic Latin)

$ uparse X XY "X        Z"

============================================================
String: 'X'
============================================================
X       U+58     LATIN CAPITAL LETTER X
------------------------------------------------------------

============================================================
String: 'XY'
============================================================
X       U+58     LATIN CAPITAL LETTER X
Y       U+59     LATIN CAPITAL LETTER Y
------------------------------------------------------------

============================================================
String: 'X      Z'
============================================================
X       U+58     LATIN CAPITAL LETTER X
�       U+9      <control>
Z       U+5A     LATIN CAPITAL LETTER Z
------------------------------------------------------------

The two similar emoji heads (mentioned above)

$ uparse 🧑 👨

============================================================
String: '🧑'
============================================================
🧑      U+1F9D1  ADULT
------------------------------------------------------------

============================================================
String: '👨'
============================================================
👨      U+1F468  MAN
------------------------------------------------------------

A complex ZWJ sequence

$ uparse 👨🏽‍✈️

============================================================
String: '👨🏽‍✈️'
============================================================
👨      U+1F468  MAN
🏽      U+1F3FD  EMOJI MODIFIER FITZPATRICK TYPE-4
        U+200D   ZERO WIDTH JOINER
✈       U+2708   AIRPLANE
        U+FE0F   VARIATION SELECTOR-16
------------------------------------------------------------

Maps

$ uparse 🇨🇭

============================================================
String: '🇨🇭'
============================================================
🇨       U+1F1E8  REGIONAL INDICATOR SYMBOL LETTER C
🇭       U+1F1ED  REGIONAL INDICATOR SYMBOL LETTER H
------------------------------------------------------------

Handles codepoints not yet assigned; or not supported with certain Perl versions

$ uparse `perl -C -e 'print "X\x{1fa7c}X"'`

============================================================
String: 'X🩼X'
============================================================
X       U+58     LATIN CAPITAL LETTER X
🩼      U+1FA7C  CRUTCH
X       U+58     LATIN CAPITAL LETTER X
------------------------------------------------------------

$ uparse `perl -C -e 'print "X\x{1fa7c}X"'`

============================================================
String: 'X🩼X'
============================================================
X       U+58     LATIN CAPITAL LETTER X
�       U+1FA7C  <unknown> Perl v5.30.0 supports Unicode 12.1.0
X       U+58     LATIN CAPITAL LETTER X
------------------------------------------------------------

$ uparse `perl -C -e 'print "X\x{1fa7d}X"'`

============================================================
String: 'X🩽X'
============================================================
X       U+58     LATIN CAPITAL LETTER X
�       U+1FA7D  <unknown> Perl v5.39.3 supports Unicode 15.0.0
X       U+58     LATIN CAPITAL LETTER X
------------------------------------------------------------

Enjoy!

G'day All,

I'm intending to propose export tags for the builtin pragma. I'd appreciate any comments you may have about this. Thankyou.

A Brief History of the 'builtin' Pragma

• First introduced as an experimental pragma in Perl v5.36.0. See:
  • perl5360delta: builtin functions (experimental)
  • v5.36.0: builtin - Perl pragma to import built-in utility functions
• Still experimental in Perl v5.38.0. See:
  • v5.38.0: builtin - Perl pragma to import built-in utility functions
• In the development version of Perl v5.39.2, the experimental status was removed from many of the builtin pragma functions. See:
  • v5.39.2: builtin - Perl pragma to import built-in utility functions

My Usage of the 'builtin' Pragma

When released, I often play around with experimental features; however, I never use them in production-grade code. I did the same with the builtin pragma and found many to be useful: in some cases, I also found the import lists to be quite unwieldy.

When Perl v5.40.0 is released, presumably sometime next year, I will probably start using many of the stable functions provided by the builtin pragma in production-grade code. I would like easier to use import lists; accordingly, I'm proposing a number of export tags.

Proposed Export Tags for the 'builtin' Pragma

:bool

Exports: true, false, is_bool.

:weak

Exports: weaken, unweaken, is_weak.

:ref

Exports: blessed, refaddr, reftype.

:round

Exports: ceil, floor.

:stable

Exports all stable (i.e. non-experimental) functions.

:all

Exports all functions.

G'day All,

I've been playing around with Term::ANSIColor recently. I found the named colours to be very limited. The rgbRGB format provides additional colours but the codes are not particularly intuitive. Then I found rNNNgNNNbNNN; at first, I thought I'd need a different terminal but it turns out that it works just fine on my xterm.

I'm quite familiar with the hex notation #rrggbb, but less so with the decimal equivalents; so I wrote myself a helper program: rgb_palette. I thought I'd share; but there are a few things you'd probably want to know up-front.

• Obviously, you'll need a true color (aka direct-color) terminal.
• Change the shebang line if it doesn't fit your setup.
• Install IO::Prompter.
• The code, as is, has "use v5.36;". You can downgrade this but, if you do, deal with the subroutine signatures (either turn off experimental warnings or rewrite the two short subroutines, e.g. "sub fg ($r, $g, $b) { ..." --> "sub fg { my ($r, $g, $b) = @_; ..."). Also, add in whatever pragmata you're no longer getting for free.
• I use a black background. You may need to fiddle with some of the text colours if you use something else.
• I initially had the hex values on each of the coloured swatches in either black or white. I found this distracting; change the commented code in fg() if you want to put it back that way. As it stands, the foreground and background colours are the same making the text invisible but the swatch colour more prominent. I just double-click on a swatch; middle-click to paste; then "Enter" to get the rNNNgNNNbNNN conversion.
• I've aimed to get a lot of colours without needing a giant screen. You'll need 100 columns and scrolling will almost certainly be necessary. You can also type in your own hex codes if you want: the output shows a swatch of the input value as well as the rNNNgNNNbNNN code.

Alright, that's enough blathering, here's the code:

#!/usr/bin/env perl

use v5.36;

use IO::Prompter [
    -style => 'bold blue',
    -echostyle => 'bold magenta',
];
use Term::ANSIColor 5.00;

my @nums_under_255 = qw{0 26 51 77 102 127 153 179 204 230 243};

say '';

for my $r (@nums_under_255, 255) {
    for my $g (@nums_under_255, 255) {
        print '  ';

        for my $b (@nums_under_255) {
            print colored(text("r${r}g${g}b${b}"), join(' on_', fg($r,
+ $g, $b), "r${r}g${g}b${b}"));
        }

        say colored(text("r${r}g${g}b255"), join(' on_', fg($r, $g, 25
+5), "r${r}g${g}b255"));
    }
}

say '';

my $rgb;

while (1) {
    $rgb = prompt 'Convert hex to decimal rgb (or just hit "Enter" to 
+quit): ', -return => '';
    # Fix for MSWin -- see https://rt.cpan.org/Public/Bug/Display.html
+?id=118255
    $rgb =~ s/\R\z//;

    unless (length $rgb) {
        say '';
        last;
    }

    if ($rgb =~ /^([0-9a-fA-F]{2})([0-9a-fA-F]{2})([0-9a-fA-F]{2})$/) 
+{
        my $ansi_rgb = sprintf 'r%dg%db%d', map hex, $1, $2, $3;
        print colored(' --> [', 'bold white');
        print colored(' ' x 8, "$ansi_rgb on_$ansi_rgb");
        print colored('] --> ', 'bold white');
        say colored($ansi_rgb, 'bold cyan');
    }
    else {
        say colored("\nERROR: '", 'r255g0b0 on_r51g51b51'),
            colored($rgb, 'r255g255b0 on_r51g51b51'),
            colored(
                "' is invalid. Six hexadecimal characters are expected
+; such as in the table above.",
                'r255g0b0 on_r51g51b51'
            );
    }
}

sub fg ($r, $g, $b) {
    #return $r + 2 * $g + $b > 204 ? 'black' : 'white';
    return "r${r}g${g}b${b}";
}

sub text ($str) {
    return sprintf ' %02x%02x%02x ', $str =~ /^r(\d+)g(\d+)b(\d+)$/;
}
[download]

Enjoy!

Updates: Some people encountered problems, so I've made changes.

• Term::ANSIColor introduced support for 24-bit colour in v5.00 (see Changes). I wasn't aware of this. I've changed "use Term::ANSIColor;" to "use Term::ANSIColor 5.00;". Thanks ++pryrt for reporting this.
• For MSWin users, there's a bug in IO::Prompter. Again, thanks ++pryrt for reporting this. As a workaround, I've added:

      # Fix for MSWin -- see https://rt.cpan.org/Public/Bug/Display.html
  +?id=118255
      $rgb =~ s/\R\z//;
  [download]

• Also for MSWin users, there's been some discussion, in a number of responses, about whether the module Win32::Console::ANSI, or the registry setting VirtualTerminalLevel, is required for this code to work. Not being in a position to test this, I can't comment further.

Charlie Watts died today at the age of 80. A sad event, but obviously a good innings.

At first, I thought this probably had little relevance here. Then I thought of the many hours that I had coding with the Rolling Stones playing in the background: Charlie brought what they said was the engine to the Stones; he also brought that same engine to my coding.

He was a great man and had a great life: R.I.P.

G'day All,

I'm continuing my project to create interactive maps for RPGs with Tk generally and, for the main part, Tk::Canvas. I wrote a bit about that in "Tk::Canvas createGroup() Undocumented"; this CUFP post has nothing to do with the issue in that SoPW post; there is some backgound information and (very early, now substantially matured) code which may be of interest. The test code there to create creeks is related to the current work creating paths.

I had created the basic paths, put nicely curved bends in them, and so on. All of this looked good except for where the paths terminated upon entering a glade, meadow, or whatever: all I had at the ends was solid lines; what I wanted was for these to gradually peter out. The sections for this needed to be solid (opaque) where the main path ended and gradually fade to nothingness (transparent) as the terrain moved away from the path. In addition, this gradient needed to have direction to match the direction of the path where it terminated.

I made one futile attempt to do this manually in Gimp: the result looked horrible. I decided to let Perl do it for me. Here's the result which I knocked up this afternoon.

When doing some tests for "Emoji can be hard to see on the command line", I typed in an incorrect character for a Unicode® code point and was presented with a clock face. That reminded me of something I've been meaning to do for quite some time, so here it is.

The basic idea is to have a progress spinner that is a little more visually appealing than the usual text versions which cycle through "| / - \".

There are two versions: one with clock faces and one with phases of the moon. I've provided all of the code points, so that's one job anyone wanting to use this doesn't need to do. The code points for the clock faces are not sequential, so I've provided the order from 12:00 to 11:30; again, another fiddly job taken care of. The logic is simple and probably well-known to many; but, if not, that's done as well.

I've specified 'use 5.018;'. All of the characters were introduced in Unicode® v6.0 (determined via Unicode::UCD::charprops_all()). You may actually get away with 'use 5.014;'. I chose 5.18 based on the deltas (my emphasis throughout):

• 5.12: "Perl 5.12 comes with Unicode 5.2"
• 5.14: "Unicode Version 6.0 is now supported (mostly)"
• 5.16: "Supports (almost) Unicode 6.1"
• 5.18: "Perl now supports Unicode 6.2."

The following script is barebones and is really only intended as an example demo. Anyone wishing to use this will likely want additional output text — e.g. percentages, "done X of Y", and the like — so I saw no point in trying to guess such requirements.

#!/usr/bin/env perl

use 5.018;
use warnings;
use open qw{:std :encoding(UTF-8)};

use Time::HiRes 'usleep';

{
    my @code_points = qw{
        1f55b 1f567 1f550 1f55c 1f551 1f55d 1f552 1f55e
        1f553 1f55f 1f554 1f560 1f555 1f561 1f556 1f562
        1f557 1f563 1f558 1f564 1f559 1f565 1f55a 1f566
    };
    my @chars = map chr hex, @code_points;
    my $total = @chars;
    my $index = $total;

    for (1 .. 50) {
        local $| = 1;
        $index %= $total;
        print "\b\b", $chars[$index++];
        usleep 250_000;
    }

    print "\n";
}

{
    my @code_points = qw{
        1f311 1f312 1f313 1f314 1f315 1f316 1f317 1f318
    };
    my @chars = map chr hex, @code_points;
    my $total = @chars;
    my $index = $total;

    for (1 .. 25) {
        local $| = 1;
        $index %= $total;
        print "\b\b", $chars[$index++];
        usleep 500_000;
    }

    print "\n";
}
[download]

I have been seeing the following, for the past 18 months, every time I use the cpan utility:

$ cpan
Terminal does not support AddHistory.

To fix that, maybe try>  install Term::ReadLine::Perl

cpan shell -- CPAN exploration and modules installation (v2.28)
Enter 'h' for help.

cpan[1]>
[download]

I looked into that briefly (and unsuccessfully) several times; in general, whatever I wanted to install via cpan was more important than AddHistory, which I only use infrequently anyway, so it ended up on my TODO list.

I tried with the suggested module, Term::ReadLine::Perl, as well as a variety of others including: Term::ReadLine::Perl5, Term::ReadLine::Gnu, and Term::ReadLine::Tiny. These all failed, the most common problem being the process hanging when the Term::ReadKey dependency was being installed. Actually, installation of Term::ReadLine::Tiny worked fine but it didn't provide AddHistory.

I spent some hours this morning looking into this and eventually came up with a solution. My basic Perl setup is: Win10 - Cygwin - Perlbrew - Perl 5.32.0. If you're experiencing the same problem, this solution may work for you: I can't make any guarantees as I don't have other systems on which to test this.

The only thing that worked was a completely manual installation.

Download https://cpan.metacpan.org/authors/id/J/JS/JSTOWE/TermReadKey-2.38.tar.gz then run the familiar incantation:

$ tar zxvf TermReadKey-2.38.tar.gz
$ cd TermReadKey-2.38
$ perl Makefile.PL
$ make
$ make test
$ make install
[download]

Download https://cpan.metacpan.org/authors/id/H/HA/HAYASHI/Term-ReadLine-Gnu-1.37.tar.gz then a very similar incantation:

$ tar zxvf Term-ReadLine-Gnu-1.37.tar.gz
$ cd Term-ReadLine-Gnu-1.37
$ perl Makefile.PL
$ make
$ make test
$ make install
[download]

Now I get:

$ cpan

cpan shell -- CPAN exploration and modules installation (v2.28)
Enter 'h' for help.

cpan[1]>
[download]

and moving through the command history and editing is now possible.

If you were experiencing similar problems with a different setup to me — and found this worked as is, worked after some modification, or failed abysmally — please leave a note for the next reader.

I'm currently working on a module which uses Tkx. I came across something tricky involving appending bindings. It took a while to work out and, in the process, I ran a lot of tests: the results were quite surprising. I've posted this here in case anyone else finds themselves in a similar position: hopefully, it might save them some time and effort.

Tkx is a thin wrapper around Tcl. Its documentation is minimal: it just links to the Tcl documentation and leaves you to work out how to use it. In this instance, I was looking at the bind command documentation for information on appending a binding. I've linked to all of it, here's the relevant parts for this specific post:

NAME

bind — Arrange for X events to invoke Tcl scripts

SYNOPSIS

bind tag ?sequence? ?+??script?

INTRODUCTION

... If script is prefixed with a "+", then it is appended to any existing binding for sequence; ...

That's all it says about appending bindings. I investigated this; ran some tests; and was somewhat surprised at the outcome. The module I'm currently working on now contains this documentation:

Appending Bindings

When appending bindings, using the ?+??script? format, the plus (+) isn't a separate argument. Any of the following syntax variations are valid (subname works for normal named subroutines as well as lexical subroutines).

See Update below.

    '+' . sub { ... }
    '+' . \&subname
    '+' . [\&subname]
    '+' . [\&subname, @args]
    ['+' . \&subname]
    ['+' . \&subname, @args]
    '+' . $coderef
    '+' . [$coderef]
    '+' . [$coderef, @args]
    ['+' . $coderef]
    ['+' . $coderef, @args]
[download]

The surprising part was all the different ways of concatenating a string ('+') with an anonymous coderef, a named coderef, and an anonymous arrayref, without the code blowing up in my face.

This may also be useful to those using related modules, like Tcl::Tk and Tcl::pTk; although, I could be completely wrong on that (I have little knowledge of these beyond knowing of their existence).

Update: Despite successfully running two dozen or so tests on all those syntax formats, none of them appear to be actually functional. My apologies to anyone who's been trying to get them to work.

I've spent a bit of time looking into this. I can append one binding using either

... '+' . Tkx::i::interp->create_tcl_sub( CODEREF ) ...
[download]

or

my $interp = Tkx::i::interp();
... '+' . $interp->create_tcl_sub( CODEREF ) ...
[download]

And that works for CODEREF as any of these three:

sub { ... }
\&subname
$coderef
[download]

However, whenever I attempt to append a second (or third) binding, none of the appended bindings work; although, the original binding works as expected. The only feedback I get looks like the following (there's no line numbers or other useful information):

Error: invalid command name "::perl::CODE(0x7ffef5dd34d8)"
[download]

So again, my apologies to anyone who rushed off to try what I originally posted. I will spend some more time on this: I'll let you know if that proves fruitful.

G'day All,

I use a scripting language, called NWScript, for some CRPG development that I do from time to time.

I wrote the following Perl script to syntax-highlight NWScript code for HTML rendering:

#!/usr/bin/env perl

use 5.014;
use warnings;

{
    my %entity_for = qw{& &amp; < &lt; > &gt;};
    sub chars_to_ents { $_[0] =~ s/([&<>])/$entity_for{$1}/gr }
}

my @plain_captures = qw{white_space remainder};
my @highlight_captures = qw{operator variable function constant statem
+ent
                            datatype comment string integer float prag
+ma};

my $re = qr{
    (?>
        (?<white_space>
            \s+
        )
    |
        (?<comment>
            (?>
                \/\* (?: . (?! \*\/ ) )*+ (?: . (?= \*\/ ) )?+ \*\/
            |
                \/\/ [^\n]* $
            )
        )
    |
        (?<pragma>
            (?>
                [#]include \s+ " \w+ " \s* $
            |
                [#]define \s+ \w+ \s+ \w+ \s* $
            )
        )
    |
        (?<string>
            " (?: [^"\\]++ | \\. )*+ "
        )
    |
        (?<float>
            \b \d+ \. \d+ f? \b
        )
    |
        (?<integer>
            \b \d+ \b
        )
    |
        (?<constant>
            \b [A-Z0-9_]+ \b
        )
    |
        (?<datatype>
            \b (?>
                action | const | effect | event | float | int
                | itemproperty | location | object | string
                | struct \s+ \w+ | talent | vector | void
            ) \b
        )
    |
        (?<statement>
            \b (?>
                break | continue | do | for | if | else
                | return | switch | case | default | while
            ) \b
        )
    |
        (?<function>
            \b [A-Za-z_] \w* (?= \s*\( )
        )
    |
        (?<variable>
            \b [A-Za-z_] \w* \b
        )
    |
        (?<operator>
            (?>
                \>\>\>\= | \>\>\> | \>\>\= | \<\<\= | \>\> | \<\< | \+
+\+ | \-\-
                | \&\= | \|\= | \^\= | \*\= | \/\= | \%\= | \+\= | \-\
+=
                | \=\= | \!\= | \<\= | \>\= | \&\& | \|\|
                | \< | \> | \! | \& | \| | \^ | \~ | \* | \/ | \% | \+
+ | \- | \=
                | \? | \: | \; | \. | \{ | \} | \( | \) | \, | \@
            )
        )
    |
        (?<remainder>
            .*?
        )
    )
}msx;

my $init_code = do { local $/; <> };

say '<pre class="syntax-highlight">';

MATCH:
while ($init_code =~ /$re/g) {
    for my $plain_capture (@plain_captures) {
        if (exists $+{$plain_capture}) {
            print $+{$plain_capture};
            next MATCH;
        }
    }

    for my $highlight_capture (@highlight_captures) {
        if (exists $+{$highlight_capture}) {
            print '<span class="', $highlight_capture, '">',
                    chars_to_ents($+{$highlight_capture}), '</span>';
            next MATCH;
        }
    }
}

say '</pre>';

exit;
[download]

NWScript uses a C-like syntax. I'm aware that a few monks use NWScript; however, I'd guess most don't and have probably never heard of it. So, purely to provide an example that's looks a little more familiar to most, here's a slightly fudged (just the #include pragma) hello.c:

/* hello.c */

#include "stdio"

main()
{
    printf("hello, world\n");
}
[download]

And here's the output after running that through my script:

<pre class="syntax-highlight">
<span class="comment">/* hello.c */</span>

<span class="pragma">#include "stdio"
</span>
<span class="function">main</span><span class="operator">(</span><span
+ class="operator">)</span>
<span class="operator">{</span>
    <span class="function">printf</span><span class="operator">(</span
+><span class="string">"hello, world\n"</span><span class="operator">)
+</span><span class="operator">;</span>
<span class="operator">}</span>
</pre>
[download]

For anyone wishing to use this script, here's the CSS I use (in the Spoiler):