http://qs321.pair.com?node_id=479

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. Post a new question!

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.

User Questions
writing to filter giving me back GLOB(x)GLOB(x)...
1 direct reply — Read more / Contribute
by perl-diddler
on Jan 17, 2021 at 00:21
    Have a mail filter that's worked / evolved for years, maybe 1st version around 1990 or there abouts.

    Latest change is I need to filter out some google-clutter -- but instead of doing that last as I was, I find spamassassin is finding one of their hosts "offensive" (in a black list), so I need to run the de-googer before running SA.

    Before ran SA 1st, so the SA-client just read the msg from STDIN and I read SA's stamped version using an open of spamc with an output pipe that I read from.

    Now, I have to read the incoming msg 1st, filter-it, then send it to SA(spamc), and then read spamc's "stamped" (w/the spamassassin markup) from the client. The fact that I need to write to the client and read from it at the same time has me needing at least 1 explicit pipe and a fork.

    I might as well post the first bit of code here -- this is a mockup of the flow control to show my "algorithm". The mockup is a condensation of about 80 lines, which I can post if needed.

    01   sub get_Spamc_msg($) {
    02     my $de_cluttered_msg = shift;
    03 
    04     pipe $from_spamc, $spamc_out;
    05 
    06     if ( ($stat=fork()) == 0) { # child will write msg to spamc
    07       close $from_spamc;        # parent will read from this
    08       open(\*STDOUT, ">&", $spamc_out)
    09       open (my $spamc_h , "|-", "$Spamc -u law")
    10       print $spamc_h for @$de_cluttered_msg;
    11       close($spamc_h)
    12       exit 0;                   # exit child
    13     } elsif ( $stat > 0 ) {     # this is parent
    14       close $spamc_out;         # parent won't be writing to this
    15     }
    16     ...
    17     my @lines=<$from_spamc>;    # expects array to catch. (chked on entry)
    18     @lines
    19   }
    20   ...
    21   @msg=get_Spamc_msg(\@filtered)
    22 
    23   die P("No message? USE_SPAMC=%s, message too small:  msg=@msg\n", 
    24           $USE_SPAMC) if $#msg < 2;
    25 ----
    26 output: 
    27 No message? USE_SPAMC=1, message too small:  msg=GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)GLOB(0xb1b940)...
    
    This is what I'm doing now...the message is passed in an ARRAY-ptr at the beginning. Then create a pipe that is intended to be the output of spamc on the out-end + read by the main process (parent) from a child.

    So next I fork -- child closes the 'from_spamc' end of the pipe so only parent holds it. I then dup spamc_out into STDOUT. I originally had it without the '\*' - gave same output - so made no difference, but staring at the examples in perlfunc(open), that seems to be the right syntax for that.

    Then I open a pipe for writing to spamc from the child, then print my decluttered msg in line 10 to the child, then close that file handle and then child exits.

    Continuing in the parent, it closes the child side of the pipe so it only has the input handle from the pipe. From that input handle ($from_spamc), I grab the output into the "@lines" array and return that. Back in the main line at #21, @msg receives the output from the 'get_spamc_msg' sub, but I'm getting back a bunch of GLOB(0xb1b940) -- one for each line in the message. I.e. instead of the msg, I get GLOB'd. Indeed, Trying to look at @lines in 17-18 above, the parent is only seeing the globs as 1 line.

    So I have some I/O criss-crossed, but it looks correct. I'm wondering if I'm really seeing the STDOUT from the spamc child or wondering if perl has played with the output of spamc in the open statement (ln#09).

    Since I'm not certain if perl is playing with other than spamc's input handle, my next step is to move to another pipe and fork to do explicitly what perl should be doing in the "|-", $Spamc...

    For fun, tried it with 'cat' instead of spamc -- got the same.

    Anyone see what I'm doing wrong here? I mean it's not like its rocket science is it?...*sigh*

    Thanks in advance...

Is a here-doc a good way to retrieve data file contents for testing?
3 direct replies — Read more / Contribute
by Lotus1
on Jan 16, 2021 at 20:35

    I found from reading in perlop a suggestion to use chomp() to get rid of the extra newline at the end of my here-doc. For testing purposes I would like my test function to return exactly what the file contains. This is the first time I have noticed or cared about this so I thought I would share what I learned.

    I'm working on my first module to upload to CPAN and I plan to put this function in a module in 't/lib'. Is there a nicer way to handle retrieving this? I could just make the function slurp the json file and return it. I've been looking at other modules but haven't found a good example yet. Thanks.

    use warnings; use strict; use Test::More tests => 1; print "-------\n"; print json_q(); print "-------\n"; print json_here(); print "-------\n"; is(json_q(), json_here(), "should be the same"); sub json_q { q( "Type": 0, "Width": 504, "X": 18, "Y": 18 } ] }); } sub json_here { chomp(my $json = <<'END_JSON'); "Type": 0, "Width": 504, "X": 18, "Y": 18 } ] } END_JSON $json }

    The output looks like:

    1..1 ------- "Type": 0, "Width": 504, "X": 18, "Y": 18 } ] }------- "Type": 0, "Width": 504, "X": 18, "Y": 18 } ] }------- ok 1 - should be the same
Text::Summarizer fails on Windows 10
2 direct replies — Read more / Contribute
by Anonymous Monk
on Jan 16, 2021 at 13:21

    Hello

    I am trying to install on Windows 10, Strawberryperl v5.28.1, the module Text::Summarizer. I get the following - for my knowledge - strange error. Do you know what can I do to solve this issue?

    cpanm Text::Summarizer --> Working on Text::Summarizer Fetching http://www.cpan.org/authors/id/F/FA/FAELIN/Text-Summarizer-2. +01.tar.gz ... OK Could not create directory 'C:\Users\TE\.cpanm\work\1610820965.16324\T +ext-Summarizer-2.01\Corpus\written\newspaper:newswire' for 'Text-Summ +arizer-2.01/Corpus/written/newspaper:newswire': mkdir C:\Users\TE\.cp +anm\work\1610820965.16324\Text-Summarizer-2.01\Corpus\written\newspap +er:.: Invalid argument; Die Syntax f│r den Dateinamen, Verzeichnisnam +en oder die Datentr§gerbezeichnung ist falsch at C:/Strawberry/perl/l +ib/Archive/Tar.pm line 819. at C:\Strawberry\perl\bin\cpanm.bat line 132. Could not extract 'Text-Summarizer-2.01/Corpus/written/newspaper:newsw +ire' at C:\Strawberry\perl\bin\cpanm.bat line 132. ==> Found dependencies: Module::Build Found Module::Build 0.4231 which doesn't satisfy 2.01. ! Installing the dependencies failed: Installed version (0.4224) of Mo +dule::Build is not in range '2.01' ! Bailing out the installation for Text-Summarizer-2.01.
mysteries of regex substring matching
4 direct replies — Read more / Contribute
by smile4me
on Jan 15, 2021 at 16:42

    We all know that "In list context, a regex match returns a list of captured substrings." And, we also know "Numeric quantifiers express the number of times an atom may match. {n} means that a match must occur exactly n times." So can the numeric quantifier work with the captured substrings?

    perl -E '$s = q[AAD34017837201D98AAED18778DEF993]; say length($s), " ", $s; @m = $s =~ /(....)(....)(....)(....)(.+)/; say "", join("-",@m);' # 32 AAD34017837201D98AAED18778DEF993 # AAD3-4017-8372-01D9-8AAED18778DEF993

    In contrast, the following regex uses a numeric quantifier but does not work as above:

    perl -E '$s = q[AAD34017837201D98AAED18778DEF993]; say length($s), " ", $s; @m = $s =~ /(....){4}(.+)/; say "", join("-",@m);' # 32 AAD34017837201D98AAED18778DEF993 # 01D9-8AAED18778DEF993

    So, is there a way to use capture groups to match multiple times like separate groups does in the first example?

How to display Tk window without waiting for user input
5 direct replies — Read more / Contribute
by Special_K
on Jan 15, 2021 at 15:56

    I am working on a script whose logic is essentially as follows:

    #!/usr/bin/perl -w use strict; use Tk; my $status = 0; my $prev_status = 0; my $mw = MainWindow->new(); $mw->withdraw(); while (1) { my $status = check_for_status(); if ($status != $prev_status) { # need to notify user but don't wait for click $mw->messageBox( -title => 'status changed', -message => 'status changed', -type => 'OK', -icon => 'info', ); } $prev_status = $status; }

    I would like the window to display and also have the program keep executing, but currently the program waits for the user to click "OK". The windows are only intended to notify the user that the status variable has changed and no action is taken based on clicking OK to close the windows. I was not able to find a Tk window type that does not have some sort of dialog button that causes execution to wait for the user to click them.

    I also considered somehow using fork() to spawn off each dialog window as a separate process, but exec() expects a system call. Is there an equivalent to exec() that accepts a block of perl code that I can use to spawn off each dialog window and have execution continue within the main loop? Status changes are relatively infrequent so I don't expect the computer to be swamped with open dialog boxes.

Out-of-the box Perl version - lowest common denominator
8 direct replies — Read more / Contribute
by kcott
on Jan 15, 2021 at 00:00

    G'day All,

    At $work, we're currently coding to Perl 5.16.0 as a minimum version: our clients are expected to have this version available to be able to run our software.

    We are considering increasing that minimum version. Doing so has been agreed in principle. However, we're scratching our heads a bit, trying to determine what a practical new version might be.

    By out-of-the box, I'm talking about what's available either as a new installation, or through standard updates through package managers. I'm not referring to what's possible by manual builds or using installation software (such as Perlbrew).

    As an example, I've quite recently updated Cygwin, which gives me:

    $ /usr/bin/perl -v | head -2 | tail -1 This is perl 5, version 30, subversion 3 (v5.30.3) built for x86_64-cy +gwin-threads-multi

    I have also installed a few Perl versions using Perlbrew:

    $ perlbrew list perl-5.33.5 * perl-5.32.0 perl-5.30.0

    So my answer to this question would be: "Cygwin: 5.30.3".

    I added "lowest common denominator" because, in practical terms for the current exercise, it's more important to know "ABC Linux: 5.20.0" than "XYZ Linux: 5.32.0".

    Your feedback on this would be very much appreciated. Thanks in advance.

    — Ken

SSL certificate store for a Perlbrew install
2 direct replies — Read more / Contribute
by chrestomanci
on Jan 14, 2021 at 11:48

    Greetings wise brothers, I seek your advice on secret communication an how we can be sure we know who we are talking to.

    Specifically, I am trying to get LWP::UserAgent running inside a locally compiled perlbrew install, to accept a corporate root cert.

    At my company, IT have created a private SSL certificate keypair, and used it to sign the ssl certs on numerous internal servers. They also publish the public half of the SSL cert which (on ubuntu) I have installed in /etc/ssl/certs/ where it is accepted by system perl, firefox, wget etc.

    For some reason the corporate public certificate is not accepted by a perlbrew install of perl 5.10 that I have compiled localy. Do I need to install the corporate root cert somewhere else for perlbrew to accept it?

    Code to reproduce

    use strict; use warnings; use XML::Simple; use LWP::UserAgent; use Data::Dumper; my $url = "https://--- REDACTED ----"; my $parser = new XML::Simple; my $ua = new LWP::UserAgent; # $ua->ssl_opts( verify_hostname => 0 ,SSL_verify_mode => 0x00); my $req = new HTTP::Request('GET', $url); my $resp = $ua->request($req); # print "Result from fetching $url : " . Dumper($resp); if( $resp->is_success() ){ # print "Result content: ". $resp->content; eval{ my $parsed_xml = $parser->XMLin($resp->content, ForceArray => +['publishedfile']); }; if( $@ ){ print "Error parsing XML: $@"; } else { print "File downloaded and XML parsed OK" } } else { die "Error fetching $url : ".$resp->message; }

    This code works fine using Ubuntu's system perl on all the versions of Ubuntu I could find. It also works if I uncomment the $ua->ssl_opts( verify_hostname => 0 ,SSL_verify_mode => 0x00); line, But it fails on line 35 with  Can't connect to REDACTED:443 (certificate verify failed) at scripts/dev/test_ssl_download.pl line 35. if I use perlbrew perl.

    Any ideas?

    NB: I asked this question in chatterbox about an hour ago, but did not get a reply, so I am re-posting as a perl question.

hex numbers
5 direct replies — Read more / Contribute
by LloydRice
on Jan 14, 2021 at 08:25
    I'm trying to do something that is probably stupidly simple, but it's just not working. I have a string with some decimal digits and some uppercase A..F. The string does NOT begin with "0X". I am simply trying to get the hex value into a variable. I've tried various prefixes, sprintf with various formats, pack, unpack, and a few more things. It's just not working ???
Question regarding Time::Piece and timezones
4 direct replies — Read more / Contribute
by atcroft
on Jan 14, 2021 at 01:02

    The documentation for Time::Piece in 5.30.x states the following:

    Date Parsing
    Time::Piece has a built-in strptime() function (from FreeBSD), allowing you incredibly flexible date parsing routines. For example:
    my $t = Time::Piece->strptime("Sunday 3rd Nov, 1943", "%A %drd %b, %Y"); print $t->strftime("%a, %d %b %Y");
    Outputs:
    Wed, 03 Nov 1943
    (see, it's even smart enough to fix my obvious date bug) For more information see "man strptime", which should be on all unix systems. Alternatively look here: http://www.unix.com/man-page/FreeBSD/3/strftime/

    The link includes the following conversion specifications:

    %a is replaced by national representation of the abbreviated weekday name.
    %d is replaced by the day of the month as a decimal number (01-31).
    %b is replaced by national representation of the abbreviated month name.
    %Y is replaced by the year with century as a decimal number.
    %T is equivalent to ``%H:%M:%S''.
    %H is replaced by the hour (24-hour clock) as a decimal number (00-23).
    %M is replaced by the minute as a decimal number (00-59).
    %S is replaced by the second as a decimal number (00-60).
    %Z is replaced by the time zone name.
    %z is replaced by the time zone offset from UTC; a leading plus sign stands for east of UTC, a minus sign for west of UTC, hours and minutes follow with two digits each and no delimiter between them (common form for RFC 822 date headers).

    The page for strptime on the same site says, "The strptime() function parses the string in the buffer buf according to the string pointed to by format, and fills in the elements of the structure pointed to by timeptr. The resulting values will be relative to the local time zone. Thus, it can be considered the reverse operation of strftime(3)."

    I created the following test code as tp_test.pl:

    #!/usr/bin/perl # vim: set expandtab tabstop=4 shiftwidth=4 softtabstop=4: use strict; use warnings; use Carp; use Time::Piece; $SIG{__WARN__} = sub { Carp::cluck @_; }; $SIG{__DIE__} = sub { Carp::confess @_; }; $| = 1; my $t = localtime; my $pattern = "%a, %d %b %Y %T %Z"; my $str = $t->strftime( $pattern ); print "Time is:\n", $str, "\n"; # Format: Wed, 13 Jan 2021 17:22:23 CST my $u = Time::Piece->strptime( $str, $pattern, ); print "Time is:\n", $u->strftime( $pattern ), "\n";

    I tested the code on the following three (3) platforms:

    • 5.30.1 under MSWin/x86_64 (Strawberry/BerryBrew)
    • 5.30.3 under MSWin/x86_64 (Cygwin64)
    • 5.30.3 under Linux/x86_64
    When I execute the script above, I get the following on all three platforms (differing only by the path to Piece.pm):
    $ perl ./tp_test.pl Time is: Wed, 13 Jan 2021 22:21:49 CST Error parsing time at /usr/lib64/perl5/Time/Piece.pm line 597. at ./tp_test.pl line 11. main::__ANON__("Error parsing time at /usr/lib64/perl5/Time/Piece.pm line 597.\x{a}") called at /usr/lib64/perl5/Time/Piece.pm line 597 Time::Piece::strptime("Time::Piece", "Wed, 13 Jan 2021 22:21:49 CST", "%a, %d %b %Y %T %Z") called at ./tp_test.pl line 23 $

    Expected output:

    $ perl ./tp_test.pl Time is: Wed, 13 Jan 2021 22:21:49 CST Time is: Wed, 13 Jan 2021 22:21:49 CST $

    The behavior also appears to occur if I change my $t = localtime; to my $t = gmtime; as well, where the timezone is then 'UTC'. If it were only occurring under Cygwin and Strawberry, my first guess would be MSWin-related, but since I am seeing it on a Linux system as well, I'm not sure where to look for the cause of the issue.

    Thoughts?

Limit on number of nodes in a Tk::Tree?
3 direct replies — Read more / Contribute
by parv
on Jan 14, 2021 at 00:31

    Is there a limit on number of nodes a Tk::Tree can have? (I had tried to search for this but came up with useless results.) Or, why would a Tk::Tree not completely render a Tk window?

    I was trying to locate very fat directories on MS Windows 10 (modied code at the end), but the Tk window stopped updating after some entries. The output from &buildSubTree ...

    sub buildSubTree { ... #printf qq[Fetching data for %s ...\n], $path; foreach my $dir ( sort readdir $DH ) { ... my $annotation = annotate( $path , $size , $dirs , $files ); warn qq[$annotation], "\n"; $tree->entryconfigure( $node , '-text' => $annotation ); ++$stack->[-1]; } closedir $DH or die qq[Cannot close "$path": $!\n]; pop @$stack; printf( "=== %s\n", annotate( $path, $sizeTotal, $fileCount, $dirCo +unt ) ); return ( $dirCount , $fileCount , $sizeTotal ); }

    ... shows that the program does go through the whole tree of C:/Users/<userid> without much of any issues. There were no obvious Windows error dialogs or error messages from Perl or Tk.

    In the end, I used the text output instead of GUI to find the fat directories.

    I ran the following program with Starwaberry Perl 5.32.0 & Tk 804.035 (with MAX patch applied) in Powershell 7.0.1.


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":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.