Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

The Monastery Gates

( #131=superdoc: print w/replies, xml ) Need Help??

If you're new here please read PerlMonks FAQ
and Create a new user.

poll ideas quest 2022
Starts at: Jan 01, 2022 at 00:00
Ends at: Dec 31, 2022 at 23:59
Current Status: Active
4 replies by pollsters
    First, read How do I create a Poll?. Then suggest your poll here. Complete ideas are more likely to be used.

    Note that links may be used in choices but not in the title.

Perl News
Stackoverflow blog: Why Perl is still relevant in 2022
on Jul 07, 2022 at 11:28
2 replies by NetWallah
    Girish Venkatachalam has blogged "Why Perl is still relevant in 2022" on July 6, 2022.

    No new info there - it is interesting only because it purports to be positive for perl, is published on SO, and showed up on my Google news feed.

    The author seems to have somewhat dated knowledge of perl and no knowledge of raku.

                    "These opinions are my own, though for a small fee they be yours too."

Admins for RT
on Jul 05, 2022 at 15:02
1 reply by hippo

    TPF is calling for volunteers to assist with the administration of, specifically to help with keeping it free from spam. If you have the necessary time, skill and inclination please consider supporting this.


Make Spreadsheet::ParseXLSX be quiet about errors
2 direct replies — Read more / Contribute
by leszekdubiel
on Aug 18, 2022 at 11:25

    This program:

    #!/usr/bin/perl use Spreadsheet::ParseXLSX; `echo "" >/tmp/invalid.xlsx`; eval { Spreadsheet::ParseXLSX->new->parse("/tmp/invalid.xlsx") };


    format error: file is too short at /usr/share/perl5/Archive/Zip/ line 1031. Archive::Zip::Archive::_findEndOfCentralDirectory(Archive::Zip::Ar +chive=HASH(0x56216520bf48), IO::File=GLOB(0x562165214f30)) called at +/usr/share/perl5/Archive/Zip/ line 761 Archive::Zip::Archive::readFromFileHandle(Archive::Zip::Archive=HA +SH(0x56216520bf48), IO::File=GLOB(0x562165214f30), "/tmp/invalid.xlsx +") called at /usr/share/perl5/Archive/Zip/ line 729 Archive::Zip::Archive::read(Archive::Zip::Archive=HASH(0x56216520b +f48), "/tmp/invalid.xlsx") called at /usr/share/perl5/Spreadsheet/Par line 63 Spreadsheet::ParseXLSX::parse(Spreadsheet::ParseXLSX=HASH(0x562165 +1e94d8), "/tmp/invalid.xlsx") called at ./quiete_xlsx line 8 eval {...} called at ./quiete_xlsx line 7

    How can I grab all erorrs to some variable without polluting stderr?

Align string on a 32-bit boundary with padding
3 direct replies — Read more / Contribute
by Lucas Rey
on Aug 18, 2022 at 05:26
    Dear community, I'm just coding a little diameter avp converion and I need to pad the AVP string. According to RFC 3588, AVP string that do not align on a 32-bit boundary MUST have the necessary padding 00.

    examples (space between values is only to shown better and should be removed on final string):
    e4 99 68 f8 41 ==> e4 99 68 f8 41 00 00 00 40 ==> 40 00 00 00 2a 2e ==> 2a 2e 00 00

    My simple code just takes a string and convert it in hex, but I need to add 00 padding on the right basing on above rules/example:
    $Origin_Host_CER=""; $Origin_Host_CER =~ s/(.)/sprintf '%02x', ord $1/seg; print "STX2HEX: $Origin_Host_CER\n\n"; print length($Origin_Host_CER)/2;

    This will result in: STX2HEX: 6578616d706c652e6d65
    So, final string should have 2 padding: 6578616d706c652e6d650000

    Could someone help me to understand how to do that possibility without use any external module?
    Thank you
RFC: new API for Type::Params
1 direct reply — Read more / Contribute
by tobyink
on Aug 18, 2022 at 03:57

    Firstly, I'm not planning on breaking compatibility with Type::Params. The new API would live under a different namespace, such as Type::Params2.

    The API for Type::Params is currently:

    use feature 'state'; use Type::Params qw( compile compile_named_oo ); use Types::Standard -types; sub function_with_positional_parameters { state $check = compile( ArrayRef, Int, Int ); my ( $list, $start, $end ) = $check->( @_ ); my @slice = @{$list}[ $start .. $end ]; return \@slice; } sub function_with_named_parameters { state $check = compile_named_oo( list => ArrayRef, start => Int, end + => Int ); my ( $arg ) = $check->( @_ ); my @slice = @{$arg->list}[ $arg->start .. $arg->end ]; return \@slice; }

    Alternatively, there's:

    use Type::Params qw( wrap_subs compile_named_oo ); use Types::Standard -types; wrap_subs function_with_positional_parameters => [ ArrayRef, Int, Int +]; sub function_with_positional_parameters { my ( $list, $start, $end ) = @_; my @slice = @{$list}[ $start .. $end ]; return \@slice; } wrap_subs function_with_named_parameters => compile_named_oo( list => ArrayRef, start => Int, end => Int ); sub function_with_named_parameters { my ( $arg ) = @_; my @slice = @{$arg->list}[ $arg->start .. $arg->end ]; return \@slice; }

    My suggested API is:

    use feature 'state'; use Type::Params2; use Types::Standard -types; sub function_with_positional_parameters { state $check = signature( pos => [ ArrayRef, Int, Int ], ); my ( $list, $start, $end ) = $check->( @_ ); my @slice = @{$list}[ $start .. $end ]; return \@slice; } sub function_with_named_parameters { state $check = signature( named => [ list => ArrayRef, start => Int, end => Int ], ); my ( $arg ) = $check->( @_ ); my @slice = @{$arg->list}[ $arg->start .. $arg->end ]; return \@slice; }

    It would also support the inside-out technique:

    use Type::Params2; use Types::Standard -types; signature_for function_with_positional_parameters => ( pos => [ ArrayRef, Int, Int ], ); sub function_with_positional_parameters { my ( $list, $start, $end ) = @_; my @slice = @{$list}[ $start .. $end ]; return \@slice; } signature_for function_with_named_parameters => ( named => [ list => ArrayRef, start => Int, end => Int ], ); sub function_with_named_parameters { my ( $arg ) = @_; my @slice = @{$arg->list}[ $arg->start .. $arg->end ]; return \@slice; }

    There would be a shortcut for methods:

    signature_for method_with_named_parameters => ( method => 1, named => [ list => ArrayRef, start => Int, end => Int ], ); sub method_with_named_parameters { my ( $self, $arg ) = @_; my @slice = @{$arg->list}[ $arg->start .. $arg->end ]; return \@slice; }

    Comments? Do people think this would be an improvement?

Escape special chars in a path
4 direct replies — Read more / Contribute
by ovedpo15
on Aug 17, 2022 at 11:30
    Hi Monks!
    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).
    Given a UNIX path, I need to do two different actions - depending on the path type (dir or file):
    1. If the path is a directory, then just create it using mkdir.
    2. If the path is a file, then just copy the file from the dir directory using rsync or cp (depending if user specified a machine to copy from).
    For example, consider this:
    touch /a/b/c/d1
    In that case, the bash script will look like:
    mkdir -p /tmp/a/b/c cp /a/b/c/d1 /tmp/a/b/c # Or: rsync -a $USER@MACHINE:/a/b/c/d1 /tmp/a/b/c
    The utility works good, unless a path contains "special chars".
    I tried to deal with it by escaping and using quotes but I can't seem to cover all cases.
    By "special chars" I mean chars like ":",";","(",")","_",....
    I tried to use the following to subs:
    sub escape { my ($path) = @_; if ($path =~ /\\/) { $path =~ s/\\/\\\\/g; } if ($path =~ /\$/) { $path =~ s/\$/\\\$/g; } return $path; } sub wrap_with_quotes { my ($path) = @_; if ($path =~ /( |\;|\!)/) { return '"'.$path.'"'; } return $path; }
    I also tried to use quotemeta:
    sub escape { my ($path) = @_; my $new_path = quotemeta($path); $new_path =~ s/\\\//\//g; return $new_path; }
    But it also failed for a lot of cases and it escaped alot of unneeded chars (like ".", "/", etc. - which are valid in paths without escaping).
    The code looks like:
    foreach my $dir (sort(keys(%dirs))) { $dir = escape($dir); $dir = wrap_with_quotes($dir); print("mkdir -p /tmp/$dir\n"); } foreach my $file (sort(keys(%files))) { my $parent_dir = dirname($file); my $abs_path = abs_path($file); $abs_path = escape($abs_path); $abs_path = wrap_with_quotes($abs_path); $parent_dir = escape($parent_dir); $parent_dir = wrap_with_quotes($parent_dir); print("cp $abs_path /tmp/$parent_dir\n"); } foreach my $file (sort(keys(%remote_files))) { my $parent_dir = dirname($file); my $abs_path = abs_path($file); my $host = get_host(); $abs_path = escape($abs_path); $abs_path = wrap_with_quotes($abs_path); $parent_dir = escape($parent_dir); $parent_dir = wrap_with_quotes($parent_dir); print("rsync -a $host$abs_path /tmp/$parent_dir\n"); }
    I of course want to support any kind of path. For example, the special char could contain a "\" before it, and then I need to escape both of them. I built a small test for you to understand what I'm after:
    declare -a special_chars=("!" "@" "#" "$" "%" "^" "_" "-" "=" "+" "[" +"]" "(" ")" "{" "}" "'" ":" "," "." ";" " " "\"" "<" ">") if [ "$1" == 1 ]; then # create playground (before running the bash sc +ript) for special_char in "${special_chars[@]}"; do mkdir -p "/test1/a${special_char}b" touch "/test1/a${special_char}b/data" done else # test playground output (after running the bash script) for special_char in "${special_chars[@]}"; do mkdir -p "/tmp/test1/a${special_char}b" if [ "$?" -ne 0 ]; then exit 1 fi done fi
    If 1 is passed to the script, it will generate directory with one special char (for example: test1/a;b).
    Then I run the generated bash script and then the test script again - if 0 is passed, it will check if the bash script successfully created dirs & copied files into /tmp.
    Hope it makes sense.
    I also noticed that rsync and cp except different escaping. For example, "/test1/a;b/data" works for cp and "/test1/a\;b/data" works for rsync.
    Is there an easy way to handle special chars in path? All I want is to create mkdir/cp/rsync commands in a bash script that so they will later work.
    Please help me to fix the wrap_with_quotes and escape subs or find a better way.
TCP Server using fork to accept multiple requests
3 direct replies — Read more / Contribute
by Lucas Rey
on Aug 17, 2022 at 03:39
    Dear community, I'm trying to create a little server who handles multiple clients connections (at least 10). Below the current code that works perfect using fork. At least it accepts several connections from clients.

    With the below code, I have the following behaviour:
    - Client ask for connection ==> Accepted ==> OK
    - Client sent packet ==> Received and printed ==> OK
    - Client sent another packet ==> Not received ==> NOK

    Most probably, the while cicle will be activated only for each connection request, so that's the reason because I cannot retrieve other packets.

    Could someone help me please to adjust the below code? What I need is establish one (or more) client connection, then client send data continuosly (without disconnection) and server should reply on each packet it receives.

    Thank you

    #!/usr/bin/perl -w use IO::Socket::INET; $SIG{CHLD} = sub {wait ()}; my $socket = new IO::Socket::INET ( LocalHost => '', LocalPort => '5000', Proto => 'tcp', Listen => 5, Reuse => 1); die "cannot create socket $!n" unless $socket; while ($new_sock = $socket->accept()) { $pid = fork(); die "Cannot fork: $!" unless defined($pid); if ($pid == 0) { # This is the fork child $new_sock->recv(my $data, 500); print "$data\n"; } }
The perl source directory structure
2 direct replies — Read more / Contribute
by syphilis
on Aug 16, 2022 at 08:21

    In the perl source, we find various modules in the 'cpan', 'dist' and 'ext' directories.
    What are the rules that determine which of those 3 directories houses which modules ?

    For example, why is it that POSIX is in the 'ext' directory, but threads is in the 'dist' directory ? (Why not the other way round ? Or why aren't they both in the same directory ?)

Nonrepeating characters in an RE
10 direct replies — Read more / Contribute
by BernieC
on Aug 15, 2022 at 19:32
    I have an odd problem that's hurting my head: I'm trying to construct an RE that will only match if the letter in any position does *NOT* match any other character in the string. I'm constructing this RE with a perl program and building the RE from a template. It is the *template* that says "these letters should be distinct" and then I want to run through a few thousand words to pick out the words that "match".

    For example, my "template" might look like this: "abcdefa" and I already have the code that generates (.)?????\1. I can't figure how to make the "?"s say "these guys all have to be distinct".

Problems with String::ShellQuote
1 direct reply — Read more / Contribute
by afoken
on Aug 18, 2022 at 13:53

    I have bashed String::ShellQuote several times:

    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 Quite obviously, neither 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: 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: Did you notice something? There is also a commented version of that script at 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. +'

    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 $_; }

    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; }


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

    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; }

    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; }

    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 < +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 >

    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 < +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 >

    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.


    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.


    Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
My Perl journey begins
6 direct replies — Read more / Contribute
by oldB51
on Aug 17, 2022 at 19:53

    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.

Cool Uses for Perl
'rgb_palette' - Term::ANSIColor Helper
2 direct replies — Read more / Contribute
by kcott
on Aug 15, 2022 at 03:37

    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 +?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+)$/; }


    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 +?id=118255 $rgb =~ s/\R\z//;
    • 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.

    — Ken

Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (4)
As of 2022-08-19 22:34 GMT
Find Nodes?
    Voting Booth?

    No recent polls found