Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot

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
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'

Sorting based on any column
5 direct replies — Read more / Contribute
by Anonymous Monk
on May 19, 2015 at 05:57

    Trying to create a Subroutine to sort array based on any column numerically when my array is having both characters and numercis Below code doesnt seem to work

    #!/usr/bin/perl $objd=sprintf "%10.0f %10.0f %10.0f %10.0f %10.0f", "15","4","5","6"," +7"; $objd2=sprintf "%10.0f %10.0f %10.0f %10.0f %10.0f", "8","9","10","11" +,"12"; push @numbers,$objd; push @numbers,$objd2; sub sort_array { @unsorted_array = @{$_[0]}; $col_2sort = $_[1]; ## Implementing Schwartzian Transform algorithm to sort in fas +test way @sorted_array= map { # Get original line back $_->[0] } sort { # Compare input fields $b->[$col_2sort] <=> $a->[$col_2sort] } map { # Turn each line into [original line, input +field] [ $_, (split " ", $_)[$col_2sort] ] } @unsorted_array; } printf "UN-Sorted Array\n"; foreach my $line ( @numbers ) { printf "$line\n"; } @sorted_array= sort_array(\@numbers,2); printf "\n\n\n"; printf "Sorrted Array\n"; foreach my $line ( @sorted_array ) { printf "$line\n"; }
Inheritance without defining the object on inherited module
4 direct replies — Read more / Contribute
by thanos1983
on May 18, 2015 at 04:28

    Dear Monks,

    I am new to the OO programming in general and also in Perl. I found this tutorials Object Oriented Programming in PERL that I am following and trying to understand how to use Inheritance.

    I have a created a similar code example from the tutorial, but I can not figure out how to call a method from another module without having to define the object inside the module.

    Sample of code to replicate my problem:

    The error that I am getting when I execute the code:

    Global symbol "$object" requires explicit package name at +line 10. Compilation failed in require at line 2. BEGIN failed--compilation aborted at line 2.

    How can I call the method, without the need to define the object again! I assume there is a way since I am using inheritance.

    Thanks in advance for time and effort trying to answer my simple question.

    Seeking for Perl wisdom...on the process of learning...not there...yet!
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: (9)
As of 2015-05-24 12:13 GMT
Find Nodes?
    Voting Booth?

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

    Results (472 votes), past polls