Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
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. 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
[SOLVED] Using eval: $@ isn't returning the error I expect
5 direct replies — Read more / Contribute
by doctormelodious
on Feb 19, 2020 at 17:38

    EDIT: SOLVED! The eval was not only formatted incorrectly, it needed to be in a BEGIN block, due to the nature of the module's use by the host server. Thanks for all the help!

    ----

    Greetings,

    The host server where our intracompany site lives requires this on one of our CGI scripts:

    use cPanelUserConfig;

    My local machine is running its own Apache server, and I use it to test code. However, it doesn't have cPanelUserConfig installed. It's a pain to have to remember to comment that line out when I'm testing locally and then uncomment it before I upload it to the host server. So I tried this:

    eval{"use cPanelUserConfig;"}; unless($@){use cPanelUserConfig}

    The problem is that, even though that Perl module is not installed, $@ is empty, so the "use cPanelUserConfig" tries to execute and the script dies.

    Any suggestions for making this work?

    Thanks!

Executing CGI/web form directives in regex substitution without pages of code
3 direct replies — Read more / Contribute
by Polyglot
on Feb 19, 2020 at 15:03

    I have a database being edited via a web form which needs to allow user-specified substitutions. By providing checkboxes in the form for things like "Match at start of line", "Match at end of line", "Case insensitive", etc., along with the values for the actual text to search for and to replace with, I can provide PERL with a regular expression (regex/regexp) substitution to run against the text in the database. However, I have been unable to use it, and was forced to create pages of code to accommodate all of the possible options, as is shown further below.

    What I would like is something more like this:

    $substitute = qq|s~$sv$ch$ww$searchQuery$ww$ch$ev~$replacement~g$in;|; $line =~ $substitute;

    . . . Where $sv would be a "^" if the user had requested the match to start at the beginning of the line, or be blank ("") otherwise, $ev would optionally be the "$" for end of line matching, etc. When I tried this approach, however, it failed. So I ended up doing the following instead:

    sub processReplacements { my $regexM = shift @_; #TERM(S) TO MATCH my $regexR = shift @_; #REPLACEMENT TERM my $regexI = shift @_; #FLAG FOR CASE-INSENSITVE SUBSTITUTION my $sv = shift @_; # $sv => START, E.G. /^(.*)/; my $ev = shift @_; # $ev => END, E.G. /(.*)$/; my $ww = shift @_; # $ww => WHOLE-WORD, E.G. /\b(.*)\b/; my $ch = shift @_; # $ch => DELIMIT CHARS, # E.G. /[.,:;!?'"](.*)[.,:;!?'"]/; my @data = @_; # INCOMING ARRAY my @changed = (); # OUTGOING ARRAY my $line = ''; my $linehead = ''; my $sourceline = ''; $regexM = decode("utf8", $regexM); $regexR = decode("utf8", $regexR); foreach $line (@data) { chomp $line; $line =~ s/\s+$//; $line =~ s/((?:\d+\t)+)//; $linehead = $1; #KEEP A COPY OF ORIGINAL FOR LATER COMPARISON $sourceline = $line; if ($regexI) { #CASE INSENSITIVE if ($sv) { #START VERSE if ($ev) { #END VERSE if ($ww) { #WHOLE WORD if ($ch) { #CHAR DELIMITERS $line =~ s~^[$ch]$regexM[$ch]\b$~$regexR~gie; } else { #NO CHAR DELIMITS $line =~ s~^$regexM\b$~$regexR~gie; } } else { #NOT WHOLE if ($ch) { #CHAR DELIMITERS $line =~ s~^[$ch]$regexM[$ch]$~$regexR~gie; } else { #NO CHAR DELIMITS $line =~ s~^$regexM$~$regexR~gie; } } } else { #NOT END VERSE if ($ww) { #WHOLE WORD if ($ch) { #CHAR DELIMITERS $line =~ s~^\b[$ch]$regexM[$ch]\b~$regexR~gie; } else { #NO CHAR DELIMITS $line =~ s~^$regexM\b~$regexR~gie; } } else { #NOT WHOLE if ($ch) { #CHAR DELIMITERS $line =~ s~^[$ch]$regexM[$ch]~$regexR~gie; } else { #NO CHAR DELIMITS $line =~ s~^$regexM~$regexR~gie; } } } } else { #NOT START if ($ev) { #END VERSE if ($ww) { #WHOLE WORD if ($ch) { #CHAR DELIMITERS $line =~ s~\b[$ch]$regexM[$ch]\b$~$regexR~gie; } else { #NO CHAR DELIMITS $line =~ s~\b$regexM\b$~$regexR~gie; } } else { #NOT WHOLE if ($ch) { #CHAR DELIMITERS $line =~ s~[$ch]$regexM[$ch]$~$regexR~gie; } else { #NO CHAR DELIMITS $line =~ s~$regexM$~$regexR~gie; } } } else { #NOT END VERSE if ($ww) { #WHOLE WORD if ($ch) { #CHAR DELIMITERS $line =~ s~\b[$ch]$regexM[$ch]\b~$regexR~gie; } else { #NO CHAR DELIMITS $line =~ s~\b$regexM\b~$regexR~gie; } } else { #NOT WHOLE if ($ch) { #CHAR DELIMITERS $line =~ s~[$ch]$regexM[$ch]~$regexR~gie; } else { #NO CHAR DELIMITS $line =~ s~$regexM~$regexR~gie; } } } } } else { #CASE SENSITIVE if ($sv) { #START VERSE if ($ev) { #END VERSE if ($ww) { #WHOLE WORD if ($ch) { #CHAR DELIMITERS $line =~ s~^\b[$ch]$regexM[$ch]\b$~$regexR~ge; } else { #NO CHAR DELIMITS $line =~ s~^\b$regexM\b$~$regexR~ge; } } else { #NOT WHOLE if ($ch) { #CHAR DELIMITERS $line =~ s~^[$ch]$regexM[$ch]$~$regexR~ge; } else { #NO CHAR DELIMITS $line =~ s~^$regexM$~$regexR~ge; } } } else { #NOT END if ($ww) { #WHOLE WORD if ($ch) { #CHAR DELIMITERS $line =~ s~^\b[$ch]$regexM[$ch]\b~$regexR~ge; } else { #NO CHAR DELIMITS $line =~ s~^\b$regexM\b~$regexR~ge; } } else { #NOT WHOLE if ($ch) { #CHAR DELIMITERS $line =~ s~^[$ch]$regexM[$ch]~$regexR~ge; } else { #NO CHAR DELIMITS $line =~ s~^$regexM~$regexR~ge; } } } } else { #NOT START if ($ev) { #END VERSE if ($ww) { #WHOLE WORD if ($ch) { #CHAR DELIMITERS $line =~ s~\b[$ch]$regexM[$ch]\b$~$regexR~ge; } else { #NO CHAR DELIMITS $line =~ s~\b$regexM\b$~$regexR~ge; } } else { #NOT WHOLE if ($ch) { #CHAR DELIMITERS $line =~ s~[$ch]$regexM[$ch]$~$regexR~ge; } else { #NO CHAR DELIMITS $line =~ s~$regexM$~$regexR~ge; } } } else { #NOT END if ($ww) { #WHOLE WORD if ($ch) { #CHAR DELIMITERS $line =~ s~\b[$ch]$regexM[$ch]\b~$regexR~ge; } else { #NO CHAR DELIMITS $line =~ s~\b$regexM\b~$regexR~ge; } } else { #NOT WHOLE if ($ch) { #CHAR DELIMITERS $line =~ s~[$ch]$regexM[$ch]~$regexR~ge; } else { #NO CHAR DELIMITS $line =~ s~$regexM~$regexR~ge; } } } } } if ($line ne $sourceline) { push @changed, "$linehead$sourceline\t$line\n"; }; $line = $linehead.$line; } return @changed; } # END SUB processReplacements

    To me, that doesn't seem very Perlish. It is certainly far more unwieldy to work with. Can this whole subroutine be replaced with just a few lines as per my first attempt?

    Blessings,

    ~Polyglot~

Using Parallel::ForkManager on multiple files using backtick operators for multiple files being processed simulnaneously
2 direct replies — Read more / Contribute
by symgryph
on Feb 19, 2020 at 13:30
    I have some code that essentailly runs a bash script sequentially, and was trying to multiprocess the managed children of the program. Aka, I use perl to run program x on y # of files. I use it as an orchestrator. When I try to run on multiple files, I get two running processes with the same filename, instead of two processes running on two different filenames. I am not sure on how to make my code multi-process aware, and need some help. Here is my code.
    #!/usr/bin/env perl -w use Parallel::ForkManager; my $filename = 'all.txt'; my $failuresfilename="failed.tsv"; open (my $target, "<", $filename) or die "Cannot open < $filename: $!" +; open (my $failures, ">", $failuresfilename) or die "Cannot open > $fai +luresfilename: $!"; sub readinFile { @lines = <$target>; } sub execute { $multiprocess = Parallel::ForkManager->new(2); TARGETS: foreach $processme (@lines) { $multiprocess->start and next TARGETS; chomp $processme; $command="cfn_nag_scan -o json --input-path $processme > $processm +e_.cfnag.json"; `$command`; $multiprocess->finish; } } sub findFailures { @files=`find ./ -iname "*cfnag*"`; $jqcommand='jq --raw-output \'.[] | select (.file_results.failure_co +unt > 0) |[.filename, .file_results.failure_count] |@tsv\''; foreach (@files) { chomp; s/\/\//\//g; @a=`cat $_ |$jqcommand`; print $failures @a; } } readinFile(); execute(); #findFailures(); close $failures; close $failuresfilename;
    The subroutine in question is 'execute'. Any help would be appreciated. My input is a bunch of filenames that come from the 'find' command (in this case things I want to scan with cfn_nag). The system sub-executes cfn_nag_scan from the filenames array, which in turn system's the cfn_nag which outputs a bunch of 'scan' result files. Perl is more of a dispatcher than a processor of data.
    "Two Wheels good, Four wheels bad."
Error: when joining two hashes
4 direct replies — Read more / Contribute
by Sami_R
on Feb 19, 2020 at 05:23
    Morning Monks,

    I have two hash and trying to join into one hash

    #!/usr/bin/perl -w use strict; use warnings; my $VAR1 = { 'Total' => { 'month1' => 0, 'month2' => 0, 'month3' => 0, 'month4' => 0, 'month5' => 0, 'month6' => 0, 'month7' => 0, 'month8' => 0, 'month9' => 0, 'month10' => 0, 'month11' => 0, 'month13' => 0, 'month14' => 0, 'month15' => 0, 'month16' => 0 }, 'Tom' => { 'month1' => 17, 'month2' => 1, 'month3' => 15, 'month4' => 0, 'month5' => 3, 'month6' => 30, 'month7' => 33, 'month8' => 0, 'month9' => 0, 'month10' => 0, 'month11' => 0, 'month12' => 0, 'month13' => 0, 'month14' => 0, 'month15' => 0 } }; my $VAR2 = [ { 'Total' => { 'week1' => 0, 'week2' => 0, 'week3' => 0 }, 'Harry' => { 'week1' => 0, 'week2' => 5, 'week3' => 5 } } ]; my %joined_FS; $joined_FS{$_} ||= {( %{$VAR1->{$_}||{}}, %{$VAR2->{$_}||{}} )} fo +r keys(%$VAR1), keys(%$VAR2); #This example was given by PerlMonks print Dumper(\%joined_FS);
    #Error: Not a HASH reference at perl_script_work2.pl line 2441. # Looks like your test exited with 255 just after 2.

    Expected Output:

    $VAR1 = { 'Tom' => { 'month1' => 17, 'month2' => 1, 'month3' => 15, 'month4' => 0, 'month5' => 3, 'month6' => 30, 'month7' => 33, 'month8' => 0, 'month9' => 0, 'month10' => 0, 'month11' => 0, 'month12' => 0, 'month13' => 0, 'month14' => 0, 'month15' => 0 }, 'Total' => { 'month1' => 0, 'month2' => 0, 'month3' => 0, 'month4' => 0, 'month5' => 0, 'month6' => 0, 'month7' => 0, 'month8' => 0, 'month9' => 0, 'month10' => 0, 'month11' => 0, 'month13' => 0, 'month14' => 0, 'month15' => 0, 'month16' => 0, 'week1' => 0, 'week2' => 0, 'week3' => 0 }, 'Harry' => { 'week1' => 0, 'week2' => 5, 'week3' => 5 } };

    Please give me directions to fix this, many thanks.

Optimizing a CHI-based data throttler
4 direct replies — Read more / Contribute
by perlancar
on Feb 19, 2020 at 00:53

    I'm experimenting on using CHI as the backend of a Data::Throttler-like module. The speed is not great: my module is becoming linearly slower as the max_items parameter is increased: it's about 3 times slower than Data::Throttler with max_items=100, and 20 times slower with max_items=1000. Any idea on how to close the gap, or is my endeavor with CHI in this case a lost cause?

    package Data::Throttler_CHI; use strict; use warnings; sub new { my ($package, %args) = @_; bless \%args, $package; } my $counter = 0; sub try_push { my $self = shift; my $now = time(); $counter++; $counter = 0 if $counter == 2e31; # wraparound 32bit int $self->{cache}->set("$now|$counter", 1, $self->{interval}); # Y228 +6! my @keys0 = $self->{cache}->get_keys; my @keys; for my $key (@keys0) { my ($key_time, $key_serial) = split /\|/, $key, 2; if ($key_time >= $now - $self->{interval}) { push @keys, $key; } } # these drivers return expired keys: Memory. so we need to purge t +hese keys my $do_purge = rand() < 0.05; # probabilistic $self->{cache}->purge if $do_purge && @keys < @keys0; return @keys <= $self->{max_items} ? 1:0; } 1;

    More complete code with documentation and tests is on CPAN: Data::Throttler_CHI.

Percentage of MS Windows Perl Users
6 direct replies — Read more / Contribute
by thechartist
on Feb 18, 2020 at 21:24

    I'm interested in improving the reliability of CPAN modules on systems that do not get all that much attention, and MSWin32 seems to be one of them.

    I have been studying the various CPAN testing documents, as well as checking out the CPAN testers log file, that gives the 1000 most recent reports.

    This is off-the-cuff and not rigorous, but a quick check for "Linux" gives me around 600 of test results, "BSD" around 360, and "MSWin32" around 40. This suggests to me (making certain assumptions that the testing population represents the broad user population) -- that only about 4% of Perl users are on Windows.

    Do those estimates seem at all accurate? Thanks for the guidance.

scp file from windows10 to unix server
5 direct replies — Read more / Contribute
by vinoth.ree
on Feb 18, 2020 at 07:01
    Hi Monks,

    I have been trying to use C:/Windows/System32/OpenSSH/scp.exe command to copy a file from windows10 to unix server. But I always get error,

    system cannot find the path specified.

    I have generated rsa key and copied into authorised_keys file at unix server. So no password required.

    my $src_cmd = "C:/Windows/System32/OpenSSH/scp ". $src_file. " vinot +hg\@$server:".$target_path; print("Source copy cmd: $src_cmd\n"); my $output = qx($src_cmd); my $status = $? >> 8 ; if( $status ){ print("Error: $output\n"); return 0 }

    It prints,

    Source copy cmd: C:/Windows/System32/OpenSSH/scp D:/dev/eee/src/sample +.dat vinothg@ipaddress:/home/vinothg/src/20200218124538501.dat The system cannot find the path specified.

    even I tried with sing backward slash(\) and double(\\)slash, but getting the same error. But when I copy and run the above command in windows cmd prompt it copies the files correctly without any issues.

    I have been asked to use this scp command instead of installing perl modules.


    All is well. I learn by answering your questions...
"print" of nonexistent element is actually altering a hash
5 direct replies — Read more / Contribute
by larrymenard
on Feb 17, 2020 at 13:11
    Monks, your responses to others have been very helpful to me for many years. Now however it is time to post my own question.

    I am creating a multi-dimensional hash and then printing a non-existent key in that hash. Curiously (at least to me), that "print" is actually altering the hash, adding an invalid (for lack of a better word) key.

    #!/usr/bin/perl use strict; use Data::Dumper; my %hash; $hash{'key1'}{'key2'} = 'value'; print "\nDump of \%hash (1):\n"; print Dumper \%hash; # This print statement is actually altering the hash print "\n\"$hash{'key0'}{'key1'}{'key2'}\"\n"; print "\nDump of \%hash (2):\n"; print Dumper \%hash;
    The result is:
    Dump of %dtoHash (1): $VAR1 = { 'key1' => { 'key2' => 'value' } }; "" Dump of %dtoHash (2): $VAR1 = { 'key1' => { 'key2' => 'value' }, 'key0' => { 'key1' => {} } };

    The "print" statement is the only thing that can possibly be altering the hash. Indeed, comment it out and the 2nd dump is normal.

    I have reproduced this on multiple versions of perl 5, up to and including 5.26.3 (on CentOS 8).

    Why is the "print" statement altering the hash?

    Any explanation (or even better, advice on how to avoid it) would be much appreciated.

    Thanks in advance.

Preventing IO::Socket::SSL caching so that I can get a utility to compile (on windows :/)
3 direct replies — Read more / Contribute
by tomgracey
on Feb 17, 2020 at 12:22

    Hello Monks

    It's been a long time since I posted on Perl Monks - it feels good to be back!

    On to my problem...

    So I know what you're going to say: why oh why are you trying to compile Perl scripts on Windows? I certainly feel the same as I've been tearing what little remains of my hair out on this on and off for a few weeks now. (I haven't been working on this one problem the whole time I should add - that would be a bit extreme!)

    Previously I was able to compile my utility without issue. I am not sure whether module updates have caused the problem or something else has changed in the setup of the (virtual) machine I'm using for the compile process. However, the error messages do make the problem fairly obvious (I think). They say things like:

    Can't load 'C:\Users\Tom\AppData\Local\Temp\par-5530185324\cache-(lots of digits)\(more digits).xs.dll for module Net::SSLeay...'

    To be clear this is after compile has completed, and when I am trying to run the executable that was produced - and when I'm running it on a different Windows machine)

    I believe it is ultimately due to one of the SSL related modules (IO::Socket::SSL, LWP::Protocol::https, Net::SSLeay etc) basically caching. The compiler (I'm using pp = the Par Packer) goes ahead and compiles a fixed reference to the cache file in the temp directory. Then the same file can't be found on a different machine.

    So at the top level - in my script - I'm using WWW::Mechanize. I guess if I was using IO::Socket::SSL directly, I might be able to do something to influence caching, since I note the docs on this module have a lot of references to a "session_cache". I presume this is the problem. However, I'm confused how I can persuade it to forget about caching, given I don't have a direct interface to it. Perhaps there is an environment variable I can set, or global constants? I have spent a fair amount of time looking over the code in those modules and even putting print/die statements in there, but without much luck. Trial and error is a bit tedious because it involves compiling then transferring to a different machine, only to see the same error pop up.

    Very often when I get to this level of frustration it's down to me having missed something obvious that a new set of eyes will find quickly - hence my question on Perl Monks.

    I'm using Strawberry Perl 5.6 (32 bit) and compiling on a virtual (box) machine with Windows 7, and I installed all the relevant modules with the cpan shell (if that helps).

    Any thoughts would really be appreciated

    Thanks!

IO::Socket tutorial
2 direct replies — Read more / Contribute
by BernieC
on Feb 17, 2020 at 10:55
    I'm converting a program that uses sockets like file descriptors {it does a <$ssh> to read a line. UGH} to using sockets properly. And I can't find a clear tutorial. I know the command to send data in my new regime is send($socket, <stuff>, flags). But I've tried to chase down what the flags are. perldoc unhelpfully just says "Takes the same flags as the system call of the same name.". First off, that seems to presume that you have a unix handy to check on the system call. Second, what I found was
    $ man 2 send No manual entry for send in section 2
    so I have no clue what the flags do, but the tutorials seem to all give a value of 0. ??

    But my real interest in the switchover is to get reads to time out. I have a pokey host I connect to; sometimes {annoyingly regularly} the server seems to balk and my program just hangs, dead in the water, on the <$server>. So what I'd like to do is use the socket timeout mechanism to let my program continue. I see that there's a Timeout parameter that unhelpfully just says "Timeout value for various operations". ?? Units?? {I'd have guessed milliseconds, but IO::Socket says it is in seconds, which makes sense} which operations?? what happens when the timeout value is reached??

    Also, my incoming data is line-at-a-time and so the <$ssh> is perfect for what I need. Is there an equivalent way to do that with IO::Socket? I guess I could recv a character at a time until I got a newline.


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.
  • Log In?
    Username:
    Password:

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

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (3)
    As of 2020-02-21 22:48 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      What numbers are you going to focus on primarily in 2020?










      Results (97 votes). Check out past polls.

      Notices?