Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much

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
Kill a serial of jobs with a button click in Perl/TK
1 direct reply — 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!
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 perusing the Monastery: (7)
As of 2015-05-22 11:58 GMT
Find Nodes?
    Voting Booth?

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

    Results (456 votes), past polls