Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Seekers of Perl Wisdom
( #479=superdoc: print w/replies, xml ) Need Help??

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask.

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

Post a new question!

User Questions
Make Spreadsheet::ParseXLSX be quiet about errors
1 direct reply — 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") 
};

    [download]

    prints: 

    format error: file is too short 
 at /usr/share/perl5/Archive/Zip/Archive.pm line 1031.
    Archive::Zip::Archive::_findEndOfCentralDirectory(Archive::Zip::Ar
+chive=HASH(0x56216520bf48), IO::File=GLOB(0x562165214f30)) called at 
+/usr/share/perl5/Archive/Zip/Archive.pm 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/Archive.pm line 729
    Archive::Zip::Archive::read(Archive::Zip::Archive=HASH(0x56216520b
+f48), "/tmp/invalid.xlsx") called at /usr/share/perl5/Spreadsheet/Par
+seXLSX.pm 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

    [download]

    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

    [download]

    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="example.me";
$Origin_Host_CER =~ s/(.)/sprintf '%02x', ord $1/seg;       
print "STX2HEX: $Origin_Host_CER\n\n";
print length($Origin_Host_CER)/2;

    [download]

    This will result in: STX2HEX: 6578616d706c652e6d65
    10
    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
    Lucas
RFC: new API for Type::Params
No replies — Read more | Post response 		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;
}

    [download]

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

    [download]

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

    [download]

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

    [download]

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

    [download]

    Comments? Do people think this would be an improvement?

    Hire me at Toby Ink Ltd or Join my OnlyFans
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

    [download]
    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

    [download]
    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;
}

    [download]
    I also tried to use quotemeta: 
    sub escape {         
    my ($path) = @_;                        
    my $new_path = quotemeta($path);
    $new_path =~ s/\\\//\//g;
    return $new_path;
}

    [download]
    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");
}

    [download]
    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

    [download]
    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
    Lucas

    #!/usr/bin/perl -w
use IO::Socket::INET;

$SIG{CHLD} = sub {wait ()};
my $socket = new IO::Socket::INET (
    LocalHost => '0.0.0.0',
    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";
   }
}

    [download]
The perl source directory structure
2 direct replies — Read more / Contribute 		by syphilis
on Aug 16, 2022 at 08:21
    Hi,

    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 ?)

    Cheers,
    Rob
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".
How to color the regex captured groups?
4 direct replies — Read more / Contribute 		by ovedpo15
on Aug 12, 2022 at 12:32
    Hi Monks!
    I have a array of hashes. Each hash contains a rexes rule. Given a path, I'm trying to iterate over the rules and find the first matching rule.
    I'm trying to add a small feature which will help users to debug (since the rexes are user custom) - I want to mark the groups in the given path. For example: 
    # Given path: /a/b/c/d
# Given regex: ^/a/b/([^/]*)/([^\/]*)
# Output: /a/b/\033[1;31mc\033[0m/\033[1;31md\033[0m

    [download]
    In this case I got: /a/b/[RED]c[/RED]/[RED]d[/RED].
    The current code: 
    foreach $regex_href (@rexes)
{
    %regex = %{$regex_href};
    if (@captures = ($path =~ /$regex{'regex'}/)) {
        # Do logic
    }
}

    [download]
    The @captures contains the group values that were captured (c and d in the example). I came a cross with the Term::ANSIColor module which can help me color the string without writing the color codes myself.
    So, what would be the best way to create a variable $output that is basically $path but colored given the captured groups? You can assume that there are always at least two groups.
How do I reference repeated capture groups?
4 direct replies — Read more / Contribute 		by TIOOWTDI
on Aug 12, 2022 at 10:24
    Esteemed monks

    I stumbled over this 2 year old reddit-question from a user "onion" and am not too convinced about the answers given.

    Is using Regexp::Grammars really the only way to do it? Seems like overkill...

    Suppose I have this regular expression: 
    my $re = qr{(\w+)(\s*\d+\s*)*};
How do I get every match matched by the second group?

    [download]
    Using the regular numeric variables only gets me the last value matched, not the whole list: 
    my $re = qr{(\w+)(\s*\d+\s*)*};

my $str = 'a 1 2 3 b 4 5 6';

while ($str =~ /$re/g) {
    say "$&: $1 $2";
}

# output:
# a 1 2 3 : a 3 
# b 4 5 6: b 6

    [download]

    How do I get every number that follows a letter in this example, and not just the last one?

    EDIT

    Bonus question:

    How do I do it if I have named groups? I.e. my $re = qr{(?<letter>\w+)(?<digit>\s*\d+\s*)*};

Comparing time strings from a list of HH:MM:SS times
2 direct replies — Read more / Contribute 		by slugger415
on Aug 10, 2022 at 14:38

    Hello esteemed PerlMonks,

    I have a list of time strings in the HH:MM:SS format. I want to add each to a variable set with localtime and compare it to a timestamp later in the script. I'm having trouble understanding how to add that HH:MM:SS string to the localtime variable.

    #! /usr/bin/perl

use Time::Piece;
use strict;

my(@times) = ("00:05:21","00:08:05","00:10:33");

my $startTime = localtime();

print "Start: ", $startTime, $/;

foreach my $t (@times) {
    sleep 2;
    my $newTime = localtime();
    my $ss = $startTime + $t;     ### this is where I need advice
    if($ss > $newTime){
        print "\$ss is greater.\n";
                ### execute some functions here
    }

    print "Newtime: ", $newTime, $/;
    my $diff = $newTime - $startTime;
    print $diff, $/;

    [download]

    The $diff part works but not the addition of $t, how do I add that time to it? Obviously I need to convert it to something Time::Piece understands.

    Thank you.
 (1-10) of 300 Older entries> 

Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":

  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (3)
As of 2022-08-19 05:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found
    Notices?