Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

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
Why this code is so slow if run in thread?
1 direct reply — Read more / Contribute
by vr
on Dec 11, 2016 at 07:04

    The question is related to PDL: Looking for efficient way to extract sub-images, by finding bounding boxes of "objects". But I don't think it has anything to do with PDL, images, etc. The $str is just a very long string. Using $1 instead of $& doesn't help.

    Perl is 5.20.2 Win32 Strawberry, or 5.24 Win64.

    use strict; use warnings; use 5.020; use threads; use PDL; use PDL::IO::Image; use PDL::Image2D; use Encode qw/ decode /; PDL::no_clone_skip_warning; say "No thread\n---------"; say 'Count: ', scalar @{ test( 'test.png' )}; say "\nThread\n---------"; say 'Count: ', scalar @{ threads-> create( \&test, 'test.png' )-> join + }; sub test { my $fn = shift; my $img = PDL::IO::Image-> new_from_file( $fn ); my $pdl = $img-> pixels_to_pdl-> short; my $s = cc8compt( $pdl == 0 ); my $str = decode 'UTF16LE', ${ $s-> get_dataref }; my ( $w, $h ) = $s-> dims; my @b = map { [ [ $w, 0 ], [ $h, 0 ] ] } 0 .. $s-> max; my $t = time; for my $y ( 0 .. $h - 1 ) { my $s = substr( $str, $y * $w, $w ); while( $s =~ m[[^\0]+]g ) { my $c = ord( $& ); $b[ $c ][ 0 ][ 0 ] = $-[0] if $-[0] < $b[ $c ][ 0 +][ 0 ]; $b[ $c ][ 0 ][ 1 ] = $+[0] - 1 if $+[0] - 1 > $b[ $c ][ 0 +][ 1 ]; $b[ $c ][ 1 ][ 0 ] = $y if $y < $b[ $c ][ 1 +][ 0 ]; $b[ $c ][ 1 ][ 1 ] = $y if $y > $b[ $c ][ 1 +][ 1 ]; } } say 'Time: ', time - $t; shift @b; return \@b; }

    The output:

    No thread --------- Time: 2 Count: 145 Thread --------- Time: 52 Count: 145
Net::SSLeay and secure renegotiation
1 direct reply — Read more / Contribute
by iThunder
on Dec 11, 2016 at 03:34


    I am trying to set renegotation flag (TLS_EMPTY_RENEGOTIATION_INFO_SCSV) with the Net::SSLeay::renegotiate($ssl1) but looks like its not setting. If i send packet using openssl, i can see that extension being set. Is there any other command to achieve this?
In-place regex substitution
2 direct replies — Read more / Contribute
by lmocsi
on Dec 09, 2016 at 16:29
    Hi, I'd like to shorten every decimal number in a file, keeping it's structure. How can I do that?
    use strict; my $content = '{ "geometry": { "type": "Polygon", "coordinates": [ [ [ + 19.054804912278406, 47.485785556135411 ], [ 19.057857836771483, 47.4 +87322542030711 ], [ 19.06025597925397, 47.488491565765209 ], [ 19.060 +347248086835, 47.488539642204628 ], [ 19.060463310421543, 47.48457828 +7406251 ], [ 19.054804912278406, 47.485785556135411 ] ] ] } }'; while ($content =~ /(\d\d\.\d*)/g){ my $num = substr($1,0,9); # number is shortened, but how do I use it? }
simple SFTP on windows
2 direct replies — Read more / Contribute
by flieckster
on Dec 09, 2016 at 14:09
    Hello Monks, i'm migrating from Mac to PC, and in doing so i tried to move over Net::SFTP::Foreign, but in doing so i got alot of flack over the IO:Pty install, so i tried Net::SFTP but i can't install Net::SSH::Perl even with trying to force install. is there a good SFTP module out there that sort of just works on PC that should look for? all i need to do is upload image files. thanks!
find module name from the module archive
9 direct replies — Read more / Contribute
by Lotus1
on Dec 09, 2016 at 13:42

    Here is something I hacked quickly to find the module name from the tar-gzip file. I poked around in the makefile and readme files of the archives but didn't see anything consistent I could parse to find the name. Is there a better way? This seems likely to break in future use.

    #!/usr/bin/perl use warnings; use strict; my $module_file = 'Authen-SASL-Perl-NTLM-0.003.tar.gz'; my $module = $module_file; $module =~ s/(.*)-.*/$1/; print "$module_file => $module\n"; $module =~ s/-/::/g; print "$module_file => $module\n"; print "$module ", try_load($module) ? "is":"is not", " installed.\n"; sub try_load { my $mod = shift; eval("use $mod"); if ($@) { return(0); } else { return(1); } } __DATA__ Authen-SASL-Perl-NTLM-0.003.tar.gz => Authen-SASL-Perl-NTLM Authen-SASL-Perl-NTLM-0.003.tar.gz => Authen::SASL::Perl::NTLM Authen::SASL::Perl::NTLM is not installed.
URL search and replace in the files
3 direct replies — Read more / Contribute
by pavan474
on Dec 09, 2016 at 06:12

    Hi All,

    I have requirement to search and replace some URL's existing in files(may be XML's, text files e.t.c.,) with their equivalents

    The URL's are like:

    Equivalent ::

    Now i am taking all these URL's and their equivalents in a hash with key as URL and value as equivalent URL and comparing each file for each URL and replacing

    The issue is i have some other URLS in the files which will satisfy the above condition i.e., for Ex:

    When i go for search and replace of URL it is replacing the above new one(i.e.,ttp:// which shouldn't happen

    Can you guy's please suggest a better approach for this

How to Generate text file by picking up string from other text file line by line
3 direct replies — Read more / Contribute
by snkhadse
on Dec 09, 2016 at 05:32

    How to Generate text file by picking up string from other text file line by line.

    my first file data.txt from where i want to pick string is

    ip mac 00-17-7c-0b-d4-ac c4-17-fe-07-94-33 44-37-e6-ed-34-92 00-e0-4a-0a-2a-0a 00-30-18-a8-8b-ba 90-2b-34-5f-44-38 44-37-e6-ed-ab-a3 and i want to generate file aclallow.conf in format as below, http_access allow mac1 ip1 http_access allow mac2 ip2 http_access allow mac3 ip3 http_access allow mac4 ip4 http_access allow mac5 ip5 and aclip.conf as below acl ip1 src acl ip2 src acl ip3 src acl ip4 src acl ip5 src and aclmac.conf as below acl mac1 arp 00:e0:4c:25:fc:9b acl mac2 arp 00:1F:D0:E0:73:F5 acl mac3 arp 00:25:64:AC:31:17 acl mac4 arp 44:37:e6:ed:d0:ae acl mac5 arp 44:37:e6:ed:34:92 Please help me for this .. Thanks in advance ..

Your wisdom on what to do with Apache 2.2 (eol) + mod_perl on Windows 64
3 direct replies — Read more / Contribute
by RayHunter
on Dec 09, 2016 at 05:31


    I am seeking guidance on what is the righteous path to follow for a system currently running Windows Server 2012 64 bit, Apache 2.2, mod_perl 2.0.8 and Strawberry perl 5.16.3

    I realise that forward motion is required, but the momentum to remain stationary is great, so what is wisdom?

    I read that mod_perl is really for Apache 2.2. Apache 2.2 is good enough, but it's end of life. We really need mod_perl for speed. I really like Strawberry Perl. Windows is a given. So many paths that lead to disaster.

    What to do?

not able to insert data in database using perl DBI
2 direct replies — Read more / Contribute
by sachin raj aryan
on Dec 08, 2016 at 04:03
    my $dir = "tt"; my $date = "dd"; my $brnchid = "kk"; my $path = join "/",$dir,$date; my $dbfile = "xxx.xx.xx.xx"; my $dsn = "dbi:Oracle:host=$dbfile"; my $user = "ma"; my $password = "mama"; my $dbh = DBI->connect('dbi:Oracle:host=xx.xx.xx.xx;sid=orcl;port=1521 +;SERVER=POOLED',$user,$password, { PrintError => 1, RaiseError => 1, AutoCommit => 1, FetchHashKeyName => 'NAME_lc', TraceLevel => 4, }) or die "Canot create Databse Handle: $DBI::errstr() \n"; chdir ($path); open(my $fh,'< nwsa.txt') or die "Could not open file $!"; while (my $row1 = <$fh>) { if ($row1=~/^[AL]/) { my @sachin = split//,$row1; my $f_column = join ("",$sachin[0],$sachin[1],$sachin[2],$ +sachin[3],$sachin[4],$sachin[5],$sachin[6]); my $s_column = join ("",$sachin[7],$sachin[8],$sachin[9],$ +sachin[10],$sachin[11],$sachin[12],$sachin[13],$sachin[14],$sachin[15 +],$sachin[16],$sachin[17],$sachin[18],$sachin[19],$sachin[20],$sachin +[21],$sachin[22],$sachin[23],$sachin[24],$sachin[25],$sachin[26],$sac +hin[27],$sachin[28],$sachin[29],$sachin[30],$sachin[31],$sachin[32],$ +sachin[33],$sachin[34],$sachin[35],$sachin[36],$sachin[37],$sachin[38 +],$sachin[39],$sachin[40],$sachin[41],$sachin[42],$sachin[43],$sachin +[44],$sachin[45],$sachin[46],$sachin[47],$sachin[48],$sachin[49],$sac +hin[50],$sachin[51],$sachin[52],$sachin[53],$sachin[54],$sachin[55],$ +sachin[56],$sachin[57],$sachin[58],$sachin[59],$sachin[60],$sachin[61 +],$sachin[62],$sachin[63],$sachin[64],$sachin[65],$sachin[66],$sachin +[67],$sachin[68],$sachin[69],$sachin[70],$sachin[71],$sachin[72],$sac +hin[73],$sachin[74],$sachin[75],$sachin[76],$sachin[77]); my $trd_column = join("",$sachin[85],$sachin[86],$sachin[8 +7],$sachin[88],$sachin[89],$sachin[90],$sachin[91],$sachin[92],$sachi +n[93],$sachin[94],$sachin[95],$sachin[96],$sachin[97],$sachin[98],$sa +chin[99],$sachin[100],$sachin[101]); my @newdigit=split/[,]+/,$trd_column; my $string = join('', map { "$_" } @n +ewdigit); my $Receipt_Amount=($string*100)/100; print "$Receipt_Amount\n"; my $fourth_column = join("",$sachin[106],$sachin[107],$sac +hin[108],$sachin[109],$sachin[110],$sachin[111],$sachin[112],$sachin[ +113],$sachin[114],$sachin[115],$sachin[116],$sachin[117],$sachin[118] +,$sachin[119],$sachin[120],$sachin[121],$sachin[122],$sachin[123],$sa +chin[124],$sachin[125],$sachin[126]); my @newdigit1=split/[,]+/,$fourth_column; my $string = join('', map { "$_" } @n +ewdigit1); my $Receipt_Amount1=($string*100)/100 +; print "$Receipt_Amount1\n"; print "$f_column,","$s_column,","$Receipt_Amount,","$Recei +pt_Amount1,","$date,","$brnchid \n"; my $sql ="INSERT INTO nwsa (code_id,name_code,inr_col,out_ +col,brnch_id) VALUES (?,?,?,?,?)"; print "$sql\n"; my $sth = $dbh->prepare($sql); $sth = execute($f_column,$s_column,$Receipt_Amount,$Receip +t_Amount1,$brnchid); $sth->finish(); } } $dbh->disconnect(); close ($fh);

    not sure what is wrong in the program.. below is my output

    C:\Users\lala\Desktop\mama> DBI::db=HASH(0x1ae41b4) trace level set to 0x0/4 (DBI @ 0x0/0) in +DBI 1.636- ithread (pid 4464) -> STORE for DBD::Oracle::db (DBI::db=HASH(0x1ae41b4)~INNER 'Fetch +HashKeyNam e' 'NAME_lc') thr#126d844 STORE DBI::db=HASH(0x1ae41b4) 'FetchHashKeyName' => 'NAME_lc' <- STORE= ( 1 ) [1 items] at C:/Strawberry/perl/vendor/lib/ +line 739 v ia at C:\Users\lala\Desktop\mama\ line 16 -> STORE for DBD::Oracle::db (DBI::db=HASH(0x1ae41b4)~INNER 'ora_d +rcp' 1) th r#126d844 <- STORE= ( 1 ) [1 items] at C:/Strawberry/perl/vendor/lib/ +line 739 v ia at C:\Users\lala\Desktop\mama\ line 16 -> connected in DBD::_::db for DBD::Oracle::db (DBI::db=HASH(0x1ae +40c4)~0x1a e41b4 'dbi:Oracle:host=;sid=orcl;port=1521;SERVER=POOLED' ' +mama' ** ** HASH(0x46b1f4)) thr#126d844 <- connected= ( undef ) [1 items] at C:/Strawberry/perl/vendor/lib +/ li ne 746 -> STORE for DBD::Oracle::db (DBI::db=HASH(0x1ae41b4)~INNER 'dbi_c +onnect_clo sure' CODE(0x12829b4)) thr#126d844 STORE DBI::db=HASH(0x1ae41b4) 'dbi_connect_closure' => CODE(0x1282 +9b4) <- STORE= ( 1 ) [1 items] at C:/Strawberry/perl/vendor/lib/ +line 755 v ia at C:\Users\lala\Desktop\mama\ line 16 419041001.46 0 L01A ,CURRENT ACCOUNT + , 419041001.46,0,20161128,00336 INSERT INTO nwsa (code_id,name_code,inr_col,out_col,brnch_id) VALUES ( +?,?,?,?,?) -> prepare for DBD::Oracle::db (DBI::db=HASH(0x1ae40c4)~0x1ae41b4 +'INSERT IN TO nwsa (code_id,name_code,inr_col,out_col,brnch_id) VALUES (?,?,?,?,? +)') thr#12 6d844 dbd_preparse scanned 5 distinct placeholders dbd_st_prepare'd sql INSERT ( auto_lob1, check_sql1) dbd_describe skipped for INSERT <- prepare= ( DBI::st=HASH(0x1ae4e14) ) [1 items] at C:\Users\lala +\Desktop\sa chin\ line 54 Undefined subroutine &main::execute called at C:\Users\lala\Desktop\ma +ma\nwsapa line 55, <$fh> line 11. -> DESTROY for DBD::Oracle::st (DBI::st=HASH(0x1ae4db4)~INNER) thr +#126d844 <- DESTROY= ( undef ) [1 items] at C:\Users\lala\Desktop\mama\nwsa +parsing.p l line 55 via at C:\Users\lala\Desktop\mama\ line 55 -> DESTROY for DBD::Oracle::db (DBI::db=HASH(0x1ae41b4)~INNER) thr +#126d844 <- DESTROY= ( undef ) [1 items] at C:\Users\lala\Desktop\mama\nwsa +parsing.p l line 55 via at C:\Users\lala\Desktop\mama\ line 55 C:\Users\lala\Desktop\mama>
what are some of the most powerful, complex, one-liners?
8 direct replies — Read more / Contribute
by f77coder
on Dec 07, 2016 at 22:57


    in general if people could post some hellishly complicated one-liners, I'd like to have a go at trying to figure them out

    no perl equivalent of fork bombs, thanks

    :(){ :|:& };: or
    bomb() { bomb | bomb & }; bomb

Add your question
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?

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

    How do I use this? | Other CB clients
    Other Users?
    Others contemplating the Monastery: (6)
    As of 2016-12-11 14:16 GMT
    Find Nodes?
      Voting Booth?
      On a regular basis, I'm most likely to spy upon:

      Results (169 votes). Check out past polls.