Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

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
Recognizing pattern in 2D grid
2 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.
3 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
3 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!

Hide DBI password in scripts
7 direct replies — Read more / Contribute
by danielgr
on Jan 12, 2018 at 15:37

    We are using a shared Linux account to run database scripts and CGI programs. I thought of the following method of hiding the $password in a script, but was not able to google its viability:

    1. $password is obfuscated in a compiled C program that breaks up the password so it won't be visible via "strings".
    2. The C program will only return the password to registered calling programs or scripts - and checks the registered inode value to ensure it was not altered.

    Some code fragments follow to show how some of this information is gathered from C:

    parentpid = (int) getppid(); printf("%d\n", parentpid); sprintf(a,"cat /proc/%d/cmdline;echo", parentpid); sprintf(b,"cat /proc/%d/comm;echo", parentpid);

    Most of the posts I've seen say it is impossible to achieve unbreakable security in this respect. However, I was wondering if anyone has tried this technique or similar for Perl scripts?

Convert LWP Cookies to Netscape for Firefox import
2 direct replies — Read more / Contribute
by bliako
on Jan 11, 2018 at 15:29
    Esteemed Monks,

    I have a question regarding the HTTP cookies of an LWP object. In particular I want to save them in three different formats (LWP, Netscape, Microsoft) after LWP fetches a page.

    So far, I have told LWP to keep cookies as thus:
    my $ua = LWP::UserAgent->new(); $ua->cookie_jar(HTTP::Cookies->new());
    Then I tell it to save cookies:
    Path::Tiny::path("cookies.LWP.txt")->spew(join("\n", $ua->cookie_jar() +->as_string));

    (LWP uses what is called 'SetCookies3' cookies)

    But I now need to save the same cookies in Netscape format too so that I can import it in Firefox. And also in Microsoft format for import in IE (Oh Lord, set a guard upon my lips! ... θου, Κύριε, φυλακήν τω στόματί μου).

    I am wondering whether I can do it the way I dreamed last night in my sleep:
    my $NC = HTTP::Cookies::Netscape->new($ua->cookie_jar()); my $MC = HTTP::Cookies::Microsoft->new($ua->cookie_jar()); Path::Tiny::path("cookies.Netscape.txt")->spew($NC->as_string); Path::Tiny::path("cookies.Microsoft.txt")->spew($MC->as_string);

    Alas no. (HTTP::Cookies::Netscape also fails to read an LWP cookie file.)

    Is there code out there who can convert LWPCookie->Netscape and LWPCookie->Microsoft?

    brotherly regards,


New Meditations
Repeating a substitution
4 direct replies — Read more / Contribute
by choroba
on Jan 09, 2018 at 05:39
    Inspired by Stack Overflow, again.

    A user asked for a (awk or similar) one-liner that would replace a separator by a different one in a file, but only the first N separators should be replaced.

    For small Ns, it's easiest to repeat the substitution:

    perl -pe 's/,/|/;s/,/|/;s/,/|/'

    But, what should one do when they want to replace the first 10 separators?

    My first idea was to use a for loop:

    perl -pe 's/,/|/ for 1 .. 10' # Oops!

    Unfortunately, it doesn't work, as the for creates another local $_ and the substitution happens to the numbers, not the input.

    So, my next idea was to use a counter with /e:

    perl -pe 's/,/$i++<10 ? "|" : ","/ge'

    It works, but is ugly and hard to explain to someone not familiar with Perl.

    Another way is to tie the two $_ variables together by aliasing the outer $_ by the inner one:

    perl -pe 's/,/|/ for $_, $_'
    Again, this works only for small number of substitutions.

    But, we can generalize a list of the same things: we can use the x operator in list context! It's short, readable, and follows the DRY principle:

    perl -pe 's/,/|/ for ($_) x 10'

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
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 chanting in the Monastery: (6)
As of 2018-01-16 08:31 GMT
Find Nodes?
    Voting Booth?
    How did you see in the new year?

    Results (175 votes). Check out past polls.