Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

The Monastery Gates

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

Donations gladly accepted

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

New Questions
Attaching a balloon message to text on the Text widget
1 direct reply — Read more / Contribute
by Anonymous Monk
on Jan 17, 2018 at 05:22

    Hi Monks

    I am trying to attach a Balloon to a text (word) in a Text widget. I am not quite sure this is possible, as it seems to me that it is possible to attach it only to a widget. I am able to highlight the word (in this example in red), but how can I attach a Balloon to it? Any idea?

    use strict; use warnings; use Tk; use Tk::Text; use Tk::Balloon; my $mw = tkinit(); my $text = $mw->Text()->pack(); $text->insert('end',"This is a red text\n"); $text->tagAdd('red_text',"1.10","1.13"); $text->insert('end',"This is a black text\n"); $text->tagConfigure('red_text', -foreground => 'red'); my $balloon = $text->Balloon(); $balloon ->attach($text , -balloonmsg => "hello", -initwait=>10); $mw->MainLoop();
1 direct reply — Read more / Contribute
by 3dbc
on Jan 16, 2018 at 16:18
    Hi perl Monks,

    Unfortunately we all don't have the privilege of working on linux or solaris all the time but still love to use perl to do everything! personally I hate powershell especially when window$ people tell me to use it instead of perl, vbscript is cumbersome, and batch files just plain suck most of the time because they aren't very extendable, robust or creative. There's a lot of published powershell scripts on this topic which read from a csv file that has hostnames and user id / passwords, which I could easily build into this, but just wanted to get something out there because a google search on "perl windows reboot" script returns nothing...

    I wrote a quick and dirty reboot script, planning to expand it a bit more to parse log files, make net service calls, ping ip address to confirm each server is up before moving to the next depending on the underlying software dependencies which created the need for this in the first place, but trying to build in some basic error handling, which will help me expand this further. On my first go, I received a hickup from one of the servers complaining about:

    The handle is invalid. Error communicating with PsExec service on Blah.Blah.Blah
    When I logged onto the server I saw a whole bunch of dll errors, which usually happens after windows patches have been deployed but the server wasn't rebooted, so therefore psexec call didn't work...

    I want to be able to process this output and if I don't get the response:

    cmd started on Blah.Blah.Blah with process ID 4428.

    then I want to terminate the program. I'm calling the command with a
    print for qx|$externalExe 2>&1|;
    How do I process this output within the perl script to exit gracefully (or try alternative methods) when an error is encountered? Perhaps I'm not totally understanding this 2>&1 part of my qx, can I read this output within the script?

    Sample Code:
    #!/usr/bin/perl use strict; use warnings; my @servers = qw( Blah.Blah.Blah Blah1.Blah.Blah Blah2.Blah.Blah Blah3.Blah.Blah Blah4.Blah.Blah ); foreach (@servers){ my $externalExe = qq(psexec.exe \\\\$_ ); $externalExe .= q(-u BLAH\foo -p secret -i -d cmd /c shutdown /r /f /t + 0); print "\n\nStarting external program...\n"; print for qx|$externalExe 2>&1|; # Executes the program, and prints it +'s output print "Program $externalExe run completed.\n"; sleep 360; }
    - 3dbc
Recognizing pattern in 2D grid
3 direct replies — Read more / Contribute
by pwagyi
on Jan 15, 2018 at 21:42
    Greeting monks!

    I am facing a problem in recognizing a pattern in 2 dimensional grid. 2D grid is represented by hash of hash (X,Y coordinate as key, and value). I need to recognize some patterns like (horizontal, vertical, or diagonal) example data (x,y coordinate and value (a,b,c,..))

    recognize( pattern => 'horizontal', min => 3); # recognize 3 or more +consecutive horizontal pattern recognize( pattern => 'vertical', min => 5); |a|a|b|a|c| |a|a|c|e|f| |e|f|a|1|b|

Perl Variables storage location and scope question.
6 direct replies — Read more / Contribute
by pritesh
on Jan 15, 2018 at 15:42

    Respected Monks,

    I wanted to confirm if a variable delcared in a file is accessible and can be modified throughout the file, even inside a function, and that seems to be true.

    pritesh@mintpad ~ $ more use strict; use warnings; my $val = 10; print "Outside the functions \$val is $val stored at ", \$val, "\n"; sub first { $val = 200; print "In the first function \$val is $val stored at ", \$val, "\n +"; } sub second { $val = 100; print "In the second function \$val is $val stored at ", \$val, "\ +n"; } first(); print "After first function, before second function, \$val is $val st +ored at ", \$val, "\n"; second(); print "After second function, \$val is $val stored at ", \$val, "\n"; pritesh@mintpad ~ $

    The output is as expected.

    pritesh@mintpad ~ $ perl Outside the functions $val is 10 stored at SCALAR(0x1c307c8) In the first function $val is 200 stored at SCALAR(0x1c307c8) After first function, before second function, $val is 200 stored at S +CALAR(0x1c307c8) In the second function $val is 100 stored at SCALAR(0x1c307c8) After second function, $val is 100 stored at SCALAR(0x1c307c8) pritesh@mintpad ~ $

    Now, what I don't get is, if within the function, I declare the $val as my $val (lexical scope), no warning message is shown. Nothing like "masking earlier declaration of $val". It just treats it as if it were a different variable.

    pritesh@mintpad ~ $ more use strict; use warnings; my $val = 10; print "Outside the functions \$val is $val stored at ", \$val, "\n"; sub first { my $val = 200; print "In the first function \$val is $val stored at ", \$val, "\n +"; } sub second { my $val = 100; print "In the second function \$val is $val stored at ", \$val, "\ +n"; } first(); print "After first function, before second function, \$val is $val st +ored at ", \$val, "\n"; second(); print "After second function, \$val is $val stored at ", \$val, "\n";

    The output is:

    pritesh@mintpad ~ $ perl Outside the functions $val is 10 stored at SCALAR(0xb2d7c8) In the first function $val is 200 stored at SCALAR(0xb2d888) After first function, before second function, $val is 10 stored at SC +ALAR(0xb2d7c8) In the second function $val is 100 stored at SCALAR(0xb2e290) After second function, $val is 10 stored at SCALAR(0xb2d7c8) pritesh@mintpad ~ $

    I am confused. I thought that the second time I would get an error, but then it appears that, each my $var has scope limited to it's function or outside of the function. But if that's the case, I should have gotten an error the first time, stating "the variable requires explicit package name. Did you forget to declare my $var?" or something like that for the $val inside the function(s). I think I am missing something obvious here. Kindly help.

Bare BLOCK vrs. grep BLOCK
6 direct replies — Read more / Contribute
by powerin
on Jan 15, 2018 at 14:59
    Hi Monks,

    I'd like to make a return from subroutine by the code running in a BLOCK.

    I noticed how grep is working in the question:

    sub working { my @a = (1); grep { print "grep\n"; return 'leave' } @a; print "Still here #1\n"; } working; __DATA__ grep

    So, "Still here #1" is never shown.

    grep is a Perl function, but I'd like to get such behaviour in a BLOCK of my own subroutine. Below is my example:

    sub mygrep (&@) { my $code = shift; my @result; foreach $_ (@_) { push(@result, $_) if &$code; } @result; } sub notworking { my @a = (1); mygrep { print "mygrep\n"; return 'leave' } @a; print "Still here #2\n"; } notworking; __DATA__ mygrep Still here #2

    And this is nothing like original grep makes.

    So, the question is: How to run a code in BLOCK passed to a subroutine and call return in a caller?

SOAP::Lite and default namespaces
2 direct replies — Read more / Contribute
by DreamT
on Jan 15, 2018 at 06:17
    (Here comes YET ANOTHER SOAP::Lite question ;) )
    By default(?), SOAP::Lite produces a couple of namespaces, "soap:encodingStyle" and "xmlns:soapenc". Is it possible to remove them? I know how to alter them and how to add new namespaces, but not how to remove existing ones.
    (Have tried to find an answer in one of the existing threads, but without luck).
Detecting for HTTP pages code changes
3 direct replies — Read more / Contribute
by dotowwxo
on Jan 14, 2018 at 21:30
    Hello Monks,

    Currently, I have a script that curls for HTTP code (200,404 etc.) from a list of websites and check for HTTP code error 404, if the webpage returns HTTP code error 404, it will call another script to send out an email. However, the flaw in this script is that the script is constantly running 24/7, each cycle of the script is about 15 minutes. Every 15 minutes, if the website is still down (HTTP code 404), it will send out email. This means that I receive an email every 15 minutes if the webpage is still down. However, this is not what I want as I only want to receive 1 email when the webpage switches from a 200 webpage to a 404 webpage. Is there a way where I can enhance this and reduce the 404 error?

    Due to confidential issues, I cannot disclose the script, however, this is a short example in my script that I used to check for HTTP code check on the script:
    my $HTTPCode =`curl -s -w "%{http_code}" -o /dev/null https://$THIS_UR +L 2>&1`; #this is the line i used to retrieve the http_code if($HTTP Code == 404){ #Send email }
    What I want to achieve is instead of checking for HTTP code error 404, is there a way to detect if there's a page change from a 200 webpage to 404 webpage, send email. And if the webpage is already in a 404 state, do not send email.. I know this is a very vague question because I cannot provide my script to all of you.. but any suggestion in theory is good too. Thank you in advance
Capturing groups where the ending is optional
3 direct replies — Read more / Contribute
by cwm9
on Jan 14, 2018 at 18:34
    I'm trying to split a line into two groups. The first group is a complete unknown, except that it will not contain a specific string. The second group starts with that same string and includes everything after it which may or may not be present. Example: suppose 'right' is the specific string in question. Here's an example of the desired input vs output:
    left \1=left \2= right \1= \2=right rightabc \1= \2=rightabc leftright \1=left \2=right leftrightabc \1=left \2=rightabc
    Here's what I've tried so far. This version is overly greedy -- it won't give up eating group 2 into group 1.
    s/(.*)(right)?/\1 <> \2/ echo "left"|perl -ne 'print if s/(.*)(right)?/\1 <> \2/' + left <> echo "right"|perl -ne 'print if s/(.*)(right)?/\1 <> \2/' + right <> echo "leftright"|perl -ne 'print if s/(.*)(right)?/\1 <> \2/' + leftright <>
    This version splits properly, but /2 is the same as /1 when there is no /2:
    s/(.*(?=right.*)|(.*))/\ echo "left"|perl -ne 'print if s/(.*(?=right.*)|(.*))/\1 <> \2/' + left <> left echo "right"|perl -ne 'print if s/(.*(?=right.*)|(.*))/\1 <> \2/' + <> right echo "leftright"|perl -ne 'print if s/(.*(?=right.*)|(.*))/\1 <> \2/' + left <> right
Excel::Writer::XLSX; Multi-worksheets formulas disappear on loading
1 direct reply — Read more / Contribute
by Bananorpion
on Jan 14, 2018 at 18:01

    Hello PerlMonks

    After a year far from Perl, I've been drawn to it once again, and for the first time in a while, I've stumbled upon something I can't google my way out.

    Here's the context: the current script I use for work creates a csv file, which is subsequently pasted into a worksheet, in an xlsx file. This works fine, but this week-end I decided to improve it, and to create the Excel file from scratch via the script, removing the human manipulation inbetween. It almost works, barring one detail: some formulas (Every formula referring to cells in another worksheet.) disappear when Microsoft Excel opens the file, with a not-really-helpful error message. The formulas are correct : they are exactly the same I used manually before, and if I input them myself in the newly created file, everything works.

    As it may be obvious, I can't fully assert this is a Perl problem, but this is the track I want to follow first.

    Below is a shortest-I-could version of the code I'm using (With random data and no formats, but the exact same structure regarding the problematic formula), which generates a file with the same error message on loading.

    #!/usr/bin/env perl use v5.010; use warnings; use strict; use Excel::Writer::XLSX; my $out = 'testfile'; my $excel = Excel::Writer::XLSX->new("$out.xlsx"); my $README = $excel->add_worksheet('README'); my $log_table = $excel->add_worksheet($out); # Log table ___________________ $log_table->write_row('A1', ['ColA', 'ColB', 'ColC', 'ColD', 'ColE']); sub randChar { @_ = qw/A B C D E/; return $_[(int rand 4)]; } my $current_line = 2; for (0 .. 9) { $log_table->write_row("A$current_line", [randChar(), randChar(), r +andChar(), randChar(), lc randChar()]); $current_line++; } $log_table->autofilter("A1:K$current_line"); # README ___________________ $current_line = 1; for (qw/a b c d e/) { $README->write_row("A$current_line", [$_, "=NB.SI('$out'!E:E;A$cur +rent_line)"]); $current_line++; } $excel->close();

    Has anyone ever encountered the same error and found how to fix it? I've been browsing the Excel doc, then the Excel::Writer::XLSX module doc, but I can't find anything related, and I prefer to ask for opinions before exploring in-depth how the module creates the files.. (There is no hurry, but I don't like leaving a script unfinished.)

    (If relevant, this has only be tested in Windows 10 OS, since it's supposed to eventually run on a Windows server, I haven't tried it in a Linux OS yet.)

    Thanks in advance for any help. \o/

sorting an array with decimal points
9 direct replies — Read more / Contribute
by levW
on Jan 14, 2018 at 02:51

    HI, need to sort the array with members that look like: Patch_1.0 Patch_2.0 Patch_3.1 Patch_5.0 Patch_4.2 Patch_6.0 Patch_7.0 Patch_8.0 Patch_9.3 Patch_10.2
    Want to get rid of string "Patch_" and compare only by the decimal point numbers.
    The following code does not sort it in perfect order, because of the decimal point :

    sort  { substr($a, 6,2) <=> substr($b, 6,2)} @array

    Would appreciate any ideas.thanks

Setting maximum hunk size in Algorithm::Diff
1 direct reply — Read more / Contribute
by perlancar
on Jan 13, 2018 at 01:33
    Is there a way in the current Algorithm::Diff to limit the hunk size? If there isn't, would it be a good idea to add this ability to the module? One example where I'm wanting it is: I have ~20 lines of text in file1, and the same 20 lines of text in file2 but each with some characters modified. Normally, with the 'diff -u' command and Algorithm::Diff, I'll just have two hunks: remove 20 lines from file1, followed by adding 20 lines from file2. What I want is a unified diff view but one a line-by-line basis, plus word-/character-based color highlighting so I can see for each line which characters are modified.
Why can't I open a file for writing?
3 direct replies — Read more / Contribute
by tdilling
on Jan 12, 2018 at 16:39

    I have used perl pretty extensively in the past for file/text manipulation. So this should be straightforward. My code reads a list of files from a directory into an array (via a glob), then iteratively goes through each one and makes a modified copy in a sub-directory. Straightforward stuff. I've simplified the code down a bit in the example below:

    my $dir = '/some/directory/here'; my @files = <$dir/\d{6}*>; # All the relevant files start with 6 n +umbers, so don't glob others! foreach (@files) { $inputfile = $_; [open $inputfile for reading, this code works fine] .... $outputfile = $inputfile; open NEWFILE, '>', "$dir/subdirectory/$outputfile" | die "Can't +open $dir/subdirectory/$outputfile for writing: $!"; ..... }

    Any thoughts? I get the following error: "Cannot open /some/directory/here/subdirectory/314767_TJD_Appr5000_2017-01-06_13_10_03.txt for writing: at line 48.

    Yes, I know the filename is somewhat long and convoluted, but it is what it is. :-)

    Thanks for your guidance!

Log In?

What's my password?
Create A New User
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (2)
As of 2018-01-17 20:14 GMT
Find Nodes?
    Voting Booth?
    How did you see in the new year?

    Results (205 votes). Check out past polls.