Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

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
strangeness with prototypes and 'logical defined or'?
3 direct replies — Read more / Contribute
by ed_hoch
on May 25, 2015 at 06:49

    on 5.16.2, why does

    perl -ce 'sub foo (&) {} foo {;} || 7'

    work just fine, while

    perl -ce 'sub foo (&) {} foo {;} // 7'

    gives compilation errors? this doesn't seem like a shell-escaping issue; if I copy it into a separate file, the same thing holds.



Appending a single Scalar after a match
2 direct replies — Read more / Contribute
by SavannahLion
on May 25, 2015 at 04:36

    So I found myself updating an old script (parses oodles of HTML files). and unknowingly introduced a subtle bug.
    Here is a condensed version of the original code. The match is irrelevant.

    my $k = ''; # A bunch of junk happens to this scalar before this point my $t = "\ttest \n \n"; ($k) = $t =~ /^\s*(.*?)\s*$/g; print $k ."\n";

    Without thinking, I made a subtle change.
    my $k = ''; # A bunch of junk happens to this scalar before this point my $t = "\ttest \n \n"; ($k) .= $t =~ /^\s*(.*?)\s*$/g; print $k ."\n";

    A '1' kept getting shoved into $k. Goes without saying that I spend hours chasing this new bug down until I realized I was trying to use a list in a scalar context. So after much cursing I went and fixed the bug like thus.
    my $k = ''; # A bunch of junk happens to this scalar before this point my $t = "\ttest \n \n"; $t =~ /^\s*(.*?)\s*$/g; ($k) .= $1; print $k ."\n";

    After a fashion, I got to thinking. Is there a way to get it back to a one liner again and still append the value of $1 to $k? I tried several variations on the original but can't seem to work out a solution. My thought was something along the lines of:
    my $k = ''; # A bunch of junk happens to this scalar before this point my $t = "\ttest \n \n"; ($k) .= $($t =~ /^\s*(.*?)\s*$/g)[0]; print $k ."\n";

    I tried several variations but I can't quite seem to get it right. My gut says it should be feasible, but my brain can't quite put it together
    Any ideas?

Another 64-bit Perl bug. Is it fixed post 5.18?
4 direct replies — Read more / Contribute
by BrowserUk
on May 24, 2015 at 07:38

    The regex engine silently fails to process strings longer than 2**31 bytes on 64-bits perl's upto and including v5.18.4:

    $x = "the quick brown fox\n"; $x x= 107374182; print length $x;; 2147483640 + ### 8 bytes less than 2^31. $n=0; ++$n while $x =~ m[^.*$]mg; print $n;; + ### finds all the lines. 107374182 $x .= "the straw that broke the camel's back\n"; print length $x;; + ### Add another line that pushes the length a few bytes over 2^ +31 2147483678 $n=0; ++$n while $x =~ m[^.*$]mg; print $n;; + ### and it silently fails to find any of them. 0

    Before I raise a perlbug, does this fail on later perls? Does it fail on non-windows perls?

    If its been fixed already, which version did the fix happen?


    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority". I'm with torvalds on this
    In the absence of evidence, opinion is indistinguishable from prejudice. Agile (and TDD) debunked
Threads From Hell #2: How To Search A Very Huge File [SOLVED]
4 direct replies — Read more / Contribute
by karlgoethebier
on May 23, 2015 at 16:04

    Hi all,

    for learning purposes i started to think about how to parse search a very huge file using the multithreading capabilities of Perl.

    As i like trivial examples, i started out with something trivial and created some huge file at first:

    karls-mac-mini:monks karl$ ls -hl very_huge.file -rw-r--r-- 1 karl karl 2,0G 23 Mai 19:38 very_huge.file karls-mac-mini:monks karl$ tail very_huge.file Lorem ipsum kizuaheli Lorem ipsum kizuaheli Lorem ipsum kizuaheli Lorem ipsum kizuaheli Lorem ipsum kizuaheli Lorem ipsum kizuaheli Lorem ipsum kizuaheli Lorem ipsum kizuaheli Lorem ipsum kizuaheli nose cuke karl karls-mac-mini:monks karl$ wc -l very_huge.file 100000001 very_huge.file

    By RTFM i figured out this using MCE::Grep:

    #!/usr/bin/env perl use strict; use warnings; use MCE::Grep; use Data::Dump; use Time::HiRes qw (time); MCE::Grep::init( { max_workers => 4 } ); my $start = time; open( my $fh, '<', 'very_huge.file' ); my @result = mce_grep { /karl/ } $fh; close $fh; printf "Took %.3f seconds\n", time - $start; dd \@result; __END__ karls-mac-mini:monks karl$ ./ Took 29.690 seconds ["nose cuke karl\n"]

    Good old grep performs very much better easily:

    karls-mac-mini:monks karl$ time grep karl very_huge.file nose cuke karl real 0m2.563s user 0m2.176s sys 0m0.309s

    I don't know if this trivial exercise is peinlich parallel, but i'm wondering how to:

    • do this "by hand" (without using MCE::Grep)
    • ...and improve the performance

    Thank you very much for any hint and best regards,


    Edit: Striked out nonsense.

    Ouch! Perhaps more RTFM would have helped:

    PID Prozessname Benutzer % CPU Physikal. Speic Virt. S +peicher 1065 perl karl 12,7 10,3 MB 2, +33 GB 1068 perl karl 83,7 3,9 MB 2, +33 GB 1069 perl karl 84,6 3,9 MB 2, +33 GB 1070 perl karl 83,5 3,9 MB 2, +33 GB 1071 perl karl 84,0 3,9 MB 2, +33 GB

    Edit 2: Renamed the thread


    «The Crux of the Biscuit is the Apostrophe»

issue with perl debugger when using weak reference
No replies — Read more | Post response
by ssaraogi
on May 22, 2015 at 11:51
    I am using Test::MockModule in one of my unit tests which fails in the debug mode (perl -d <test>) but passes in the normal mode (perl <test>)

    After some debugging, i found it to be a weak reference not getting destroyed in the debug mode.

    I tried searching for similar issues but could not find anything related so far. I am not able to further figure out what the issue is here and needed help.
    What could be the issue here? Is this a known issue?

    Following code reproduces this issue:

    >> ./
    Use of uninitialized value $weak_objref in concatenation (.) or string at line 48.

    >> perl -d ./
    #!/home/utils/perl-5.10/5.10.1-nothreads-64/bin/perl use strict; use warnings FATAL => 'all'; use Scalar::Util qw(weaken); my $package_name = 'Package'; my $method_name = 'method'; my $weak_objref; { # This function creates a weak object reference and returns a code + reference sub create_weak_objref { # create any object my $self = bless {}, $package_name; # make a weak reference to the above created object $weak_objref = $self; weaken( $weak_objref ); # return a code reference which mucks around with the above cr +eated object return sub { # Need following to be able to use the string $resolved_me +thod_name later as symbol reference no strict 'refs'; # Both the following steps needs to be done to be able to +reproduce bug in the debug mode # Skipping any of them or moving any out to the parent met +hod does not reproduce the bug # set any arbitrary data inside the object $self->{_arbit_data} = 1; # update packages symbol table to create method 'method_na +me' my $resolved_method_name = "${package_name}::{${method_nam +e}}"; *{$resolved_method_name} = sub {}; }; }; my $coderef = create_weak_objref(); # call the returned code reference $coderef->(); } # Weak reference should be undefined here - but it does get printed in + the debug mode :( print "$weak_objref\n"; 1;
Kill a serial of jobs with a button click in Perl/TK
2 direct replies — Read more / Contribute
by Janish
on May 22, 2015 at 02:56

    Hello monks

    Pls help me on this. I have a few of jobs whereby each of them will be triggered in sequential manner when a "RunAll" button is clicked. How do I set another "KillAll" button to kill all the invoked jobs in case I want to abort all the rest of jobs halfway?

    Below is how I invoked my jobs (note: I'm using Tk::ExecuteCommand in my script). Each job is triggered successfully one after another but it only kill job1 in below code for sub KillAll

    Code for "RunAll" button:-

    sub RunAll{ $run_job1_bttn->invoke(); $run_job2_bttn->invoke(); $run_job3_bttn->invoke(); }

    Code for "KillAll" button:-

    sub KillAll { my $msg = $mw->Dialog( -title => "Warning", -buttons => [ "Yes", "Cancel" ], ); $msg->add("Label", -text => "Sure to kill all jobs?", -wraplength => '300', )->pack(); my $killbutton = $msg->Show; if ($killbutton eq "Yes") { $ec_job1->kill_command; $ec_job2->kill_command; $ec_job3->kill_command;#each $ec_job is execute_command callin +g an external script. } }

    Pls suggest a method so that I can kill all running jobs successfully without abort the window. Thank you!

Help me understand this code?
4 direct replies — Read more / Contribute
by ansabhailte
on May 21, 2015 at 16:27
    I'm very new to Perl (coming from Bash/sed/awk) and have been going through Daily Programmer challenges to get acquainted with Perl. I saw a user solution in Perl for a date sorter (yyyy-dd-mm, mm-dd-yyyy, etc reformatted) and am having a hard time figuring out what half of this means. Can anybody walk me through understanding it?
    $m{$_} = ++$i for qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec]; ($a, $t, $f, $b) = qw[([A-Za-z]+) \b(\d\d)\b (\d{4}) (\d{4}|\d\d)]; for (<>) { ($y, $m, $d) = /$f-$t-$t/ ? ($1, $2, $3) : /$t\/$t\/$t/ ? ($3, $1, $2) : /$t#$t#$t/ ? ($2, $1, $3) : /$t\*$t\*$f/ ? ($3, $2, $1) : /$a $t, $b/ ? ($3, $m{$1}, $2) : next; $y += $y < 50 ? 2000 : $y < 100 ? 1900 : 0; printf "%04d-%02d-%02d\n", $y, $m, $d; }
Module::Build::WithXSpp and cc flags
2 direct replies — Read more / Contribute
by psiciliano
on May 20, 2015 at 11:31

    Hi Monks,

    I'm trying to compile a module that uses Module::Build::WithXSpp on Mac OSX Mavericks. More precisely Slic3r-XS.

    When I ran perl Build.PL I get this error: clang: error: unknown argument: --no-merge-constants

    In other modules, like cpan modules I successfully edit make file and run make by hand. But this Build.PL doesn't generates a Makefile.

    Does anyone can tell me how can I remove that option from GCC default parameters on Mac OSX when I try to compile from perl? (Or how use Module::Build::WithXSpp to generate a Makefile to edit this by hand too ...)

    Thanks for your help!
Net::SMTP assistance
1 direct reply — Read more / Contribute
by FFSparky
on May 20, 2015 at 11:22
    Oh Wise Ones,

    I've somehow managed to mess up my PERL environment by i believe installing a newer module. The issue I am fighting is with sending SMTP emails. Where running the same script on one server works and on another it fails.

    With debug enabled the working server shows:

     Net::SMTP>>> Net::SMTP(2.31)
     Net::SMTP>>> Net::Cmd(2.29)
     Net::SMTP>>> Exporter(5.67)
     Net::SMTP>>> IO::Socket::INET(1.31)
     Net::SMTP>>> IO::Socket(1.32)
     Net::SMTP>>> IO::Handle(1.31)
     Net::SMTP=GLOB(0x1d2294c)<<< 220 Microsoft ESMTP MAIL Service ready at Wed, 20 May 2015 08:43:09 -0500

    Where on the server where I updated modules it shows:

     Net::SMTP>>> Net::SMTP(3.06)
     Net::SMTP>>> Net::Cmd(3.06)
     Net::SMTP>>> Exporter(5.67)
     Net::SMTP>>> IO::Socket::INET6(2.69)
     Net::SMTP>>> IO::Socket(1.32)
     Net::SMTP>>> IO::Handle(1.31)
     Net::SMTP: Net::Cmd::_is_closed(): unexpected EOF on command channel: at C:/Dev_Tools/PERL_32Bit/perl/site/lib/Email/Sender/Transport/ line 10 6.

    To the best of my debugging abilities I'm thinking the issue is the new modules is trying to use IPV6:

    Net::SMTP>>> IO::Socket::INET6(2.69)

    Is there a simple way I can force it to instead use IPV4 ?

    Thanks in Advance!

word based levenstein distance path
2 direct replies — Read more / Contribute
by Anonymous Monk
on May 20, 2015 at 08:31

    Hi Perlmonks,

    I use the following perl library for determining the edit transcript between two strings but now I want to do the same based on words and not characters. Is there any way to modify it and gain from that? Please note that I don't need the levenshtein distance but the path.


    sub EditTranscript { my $str = shift; my $str2 = shift; my $dist; my $transcript; for (my $i = 0; $i <= length($str); $i++) { $dist->[$i]->[0] = $i; $transcript->[$i]->[0] = "D"; } for (my $i = 0; $i <= length($str2); $i++) { $dist->[0]->[$i] = $i; $transcript->[0]->[$i] = "I"; } my $cost; for (my $i = 1; $i <= length($str); $i++) { for (my $j = 1; $j <= length($str2); $j++) { if (substr($str,$i-1,1) eq substr($str2,$j-1,1)) { $cost = 0; } else { $cost = 1; } $dist->[$i]->[$j] = Min($dist->[$i-1]->[$j] + 1, $dist->[$i]->[$j-1] + 1, $dist->[$i-1]->[$j-1] + $cost); if ($dist->[$i]->[$j] eq $dist->[$i]->[$j-1] + 1) { $transcript->[$i]->[$j] = "I"; } if ($dist->[$i]->[$j] eq $dist->[$i-1]->[$j]+1) { $transcript->[$i]->[$j] = "D"; } if ($dist->[$i]->[$j] eq $dist->[$i-1]->[$j-1] + $cost) { if ($cost eq 0) { $transcript->[$i]->[$j] = "-"; } else { $transcript->[$i]->[$j] = "S"; } } } } my $st = Traceback($transcript,length($str),length($str2)); $st = scalar reverse $st; return $st; } sub Traceback { my $transcript = shift; my $i = shift; my $j = shift; my $string; while ($i > 0 || $j > 0) { if (defined $transcript->[$i]->[$j]) { $string .= $transcript->[$i]->[$j]; } last if (!defined $transcript->[$i]->[$j]); # to keep us from getting caught in loops if ($transcript->[$i]->[$j] eq "S" || $transcript->[$i]->[$j] +eq "-") { $i-- if ($i > 0); $j-- if ($j > 0); } elsif ($transcript->[$i]->[$j] eq "I") { $j-- if ($j > 0); } else { $i-- if ($i > 0); } } return $string; } sub Min { my @list = @_; @list = sort {$a <=> $b} @list; return shift @list; }
sanitize user input for system() call
3 direct replies — Read more / Contribute
by EnochRoot
on May 19, 2015 at 14:42
    Because Crypt::Eksblowfish::Bcrypt doesn't support the $2y$ bcrypt variant, I'm using htpasswd to do it. Is this function a safe way to sanitize the user input, a password, by using IPC::System::Simple's capturex(@args)? I'll then be storing this in a DB and having apache authenticate off it using AuthBasicProvider dbd in the vhost:
    sub generate_apache_bcrypt_hash { my($plaintext) = @_; my $bcrypt_hash = ''; try { $bcrypt_hash = capturex("/bin/htpasswd","-nbB","''", $plaintext); } catch { print STDERR "generate_apache_bcrypt_hash = '$_'\n" if $DEBUG; }; # remove: # - extra 3 chars at the front # - 1 trailing spaces # - line break $bcrypt_hash = substr $bcrypt_hash,3; chomp($bcrypt_hash); chop($bcrypt_hash); return $bcrypt_hash }
Cross-platform accented character file names sorting
3 direct replies — Read more / Contribute
by perlimpinpin
on May 19, 2015 at 11:49

    Most Reverent Monks,

    The included script reads a directory containing Latin-1 accented characters and displays a correctly sorted list on both Linux and Windows OS, but a few changes are needed:

    - Linux : Uncomment 'use utf8::all', save with the default utf-8 encoding and run.

    - Windows : Comment out 'use utf8::all' (line 8), save with the default iso-8859-1 or ANSI encoding, chcp 1252 on the command line and run.

    To test accented characters, create a subdirectory named 'test' containing several files whose name start with normal uc and lc ascii characters and Latin-1 (Western Europe) accented characters (example: Drives, eval1, Eval2, éval3, Éval4, files, Übermensch, utilities). This is the sorted directory you'll get with ls (Linux) or dir (Windows), or with any graphical file and directory manager.

    use utf8::all; # Comment out for Windows use Unicode::Collate; # No argument: current directory; com. line accepts dir. name. my $dir = ($ARGV[0] ? shift : '.'); opendir(my $dh, $dir) or die "\n\tCannot open directory : $!\n"; my @list = grep {!/^[\.]{1,2}$/} readdir $dh; #^ skips '.' and '..' print "$_\n" for @list; print "\tEnd unsorted\n\n"; my $collator = Unicode::Collate->new(level => 1); my @entries = $collator->sort(@list); print "$_\n" for (@entries); print "\tEnd sorted\n\n";

    Looking for a simpler way, I added the following snippet, which doesn't work:

    [...] use Config; use utf8::all if $Config{osname} eq 'Linux'; # perl adamantly ignores +the condition [...]

    Further, perl cannot chcp on a Windows terminal.

    My question : Is it possible to write a 'universal script' that would automatically detect the OS and act accordingly?

    -0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0 - 0

    Thank you so much, Monks!

    With $^O, I get 'MSWin32' on my Windows 8 (64 bits) machine. So, just add the two following lines to my script:

    use if $^O ne 'MSWin32', 'utf8::all'; system('chcp 1252') if $^O eq 'MSWin32';

    Kludgy, but it does the job on both Linux and Windows, and possibly on Unix and Mac, too. If the user still gets funny characters, he has to manually save his file with the correct encoding, iso-8859-1 or ANSI for Windows or UTF-8 for most other OSes (untested). This is apparently the only thing that Perl cannot do for the unwary user!

    'Confundant omnes , ultimus alienat'

New Meditations
Perl monks vs other sites
1 direct reply — Read more / Contribute
by f77coder
on May 23, 2015 at 23:09
    Hello All,

    I wasn't sure where to post this, so apologies if this is not the place.

    I wanted to say how great Perl Monks is at helping out noobs compared with knuckle dragging neanderthals at place like stack overflow. People here are generally orders of magnitude nicer.

    Cudos to the site.

Log In?

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

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2015-05-26 00:57 GMT
Find Nodes?
    Voting Booth?

    In my home, the TV remote control is ...

    Results (491 votes), past polls