Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw

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
next and last within subs
4 direct replies — Read more / Contribute
by xorl
on Jul 11, 2014 at 14:54

    I'm looping through the contents of an array.

    Before each iteration of the loop is completed, I want a couple of things done (increment a count, print some debug info, and a few other things). There are a number of conditions that cause the loop to move on to the next one early so my though is to put these into a subroutine and call that. However, one of these things is:

    if ($x > $stop) { last; } elsif ($y ne $text) { foobar(); } else { next; }

    So of course I get the warning "Exiting subroutine via last" (or next)

    Is there a good way of doing this without having to put that snippet of code into every place where I need to move the loop forward?

Comparing array of aligned sequences
2 direct replies — Read more / Contribute
by newtoperlprog
on Jul 11, 2014 at 12:06

    Dear all, I am new to perl and trying to learn the various concepts related to the language. I am trying to parse a aligned dna sequences and printing when each position the alphabets are same. If there is a mismatch then it should skip that and print the next consnsus sequence in new line. Here I am posting the code and sample file. Any help will be greatly appreciated. Thank you all

    #!/usr/bin/perl use warnings; use strict; my $seqcount; my $pos; my $arrlen; my @arr = (); open (B, "temp.dat"); while (my $line=<B>) { chomp $line; $seqcount++; $line =~ s/\s//g; my @temp = split (//, $line); $arrlen = scalar(@temp); for ($pos=0;$pos<=scalar(@temp);$pos++) { $arr[$seqcount][$pos] = $temp[$pos]; } } my $max_position = 0; $max_position = $arrlen if($arrlen > $max_position); for ($pos=0;$pos<=$max_position;$pos++) { for (my $s=1;$s<=$seqcount;$s++) { if ($arr[$s][$pos] ne $arr[$seqcount][$pos]) { print "\n"; next; } else { print "$arr[$s][$pos]"; } } }
    temp.dat atggctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctg +aatcctgcggacgacccctctcgtggtcgcttggggctctgccgccctcttctccgcctgccgttccgg +c atagctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctg +aatcctgcggacgacccctctcgtggtcgtttggggctctgccgccctcttctccgcctgccgttcagg +c atggctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctg +aatcctgcggacgacccctctcgtggtcgcttggggctctgccgccctcttctccgcctgccgttccgg +c atggctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctg +aatcctgcggacgacccctctcgtggtcgcttggggctctaccgccctcttctccgcctgccgttccgg +c
    Desired output at gctgctaggctgtgctgccaactggatcctgcgcgggacgtcctttgtctacgtcccgtcggcgctgaat +cctgcggacgacccctctcgtggtcg ttggggctct ccgccctcttctccgcctgccgttc ggc
Reversing Arabic String direction
6 direct replies — Read more / Contribute
by wael_ahmed
on Jul 10, 2014 at 17:20
    Hi all, I have an Arabic string that contains both letters and digits. The problem is that the string appears reversed, I tried using the reverse function but it reverses both the letters and digits while I need to reverse the letters only. Please help with this issue.
[Win32] Overriding dmake's $(AS)
1 direct reply — Read more / Contribute
by syphilis
on Jul 10, 2014 at 08:25

    What follows is a re-hash of a question I asked on the makemaker mailing list a couple of weeks ago (and received no reply):

    I use the one build of dmake for a variety of perls (both 32-bit and 64-bit) that have been built with different mingw compilers.

    For some of those perls, $(CC) needs to be set to 'gcc', for others it needs to be set to 'x86_64-w64-mingw32-gcc'.
    Similarly $(AR) can be either 'ar' or 'x86_64-w64-mingw32-ar' ... and $(AS) either 'as' or 'x86_64-w64-mingw32-as'.

    Both $(CC) and $(AR) always get set correctly for the particular perl/compiler. I think this is owing to the influence of ExtUtils::MakeMaker .... right ?

    But $(AS) always gets set to 'as'. Could EU::MM be modified to influence this setting ?
    Which particular EU::MM module(s) should I be looking at in order to come up with a patch ?

    dmake's contains the following 2 lines:
    AS *:= as
    AR *:= ar

    Basically, I just want to extend the process that sets $(AR) correctly to apply also to $(AS).

Uninitialized value in division and Illegal division by zero fix
7 direct replies — Read more / Contribute
by To_Bz
on Jul 09, 2014 at 12:57
    I have the following code to get the nucleotide frequency of DNA subfragments.
    my $file1=shift; my @array=('A','T','C','G','AA','AT','AG','AC','TA','TT','TG','TC','GA +','GT','GG','GC','CA','CT','CG','CC','AAA','AAT','AAG','AAC','ATA','A +TT','ATG','ATC','AGA','AGT','AGG','AGC','ACA','ACT','ACG','ACC','TAA' +,'TAT','TAG','TAC','TTA','TTT','TTG','TTC','TGA','TGT','TGG','TGC','T +CA','TCT','TCG','TCC','GAA','GAT','GAG','GAC','GTA','GTT','GTG','GTC' +,'GGA','GGT','GGG','GGC','GCA','GCT','GCG','GCC','CAA','CAT','CAG','C +AC','CTA','CTT','CTG','CTC','CGA','CGT','CGG','CGC','CCA','CCT','CCG' +,'CCC','AAAA','AAAT','AAAG','AAAC','AATA','AATT','AATG','AATC','AAGA' +,'AAGT','AAGG','AAGC','AACA','AACT','AACG','AACC','ATAA','ATAT','ATAG +','ATAC','ATTA','ATTT','ATTG','ATTC','ATGA','ATGT','ATGG','ATGC','ATC +A','ATCT','ATCG','ATCC','AGAA','AGAT','AGAG','AGAC','AGTA','AGTT','AG +TG','AGTC','AGGA','AGGT','AGGG','AGGC','AGCA','AGCT','AGCG','AGCC','A +CAA','ACAT','ACAG','ACAC','ACTA','ACTT','ACTG','ACTC','ACGA','ACGT',' +ACGG','ACGC','ACCA','ACCT','ACCG','ACCC','TAAA','TAAT','TAAG','TAAC', +'TATA','TATT','TATG','TATC','TAGA','TAGT','TAGG','TAGC','TACA','TACT' +,'TACG','TACC','TTAA','TTAT','TTAG','TTAC','TTTA','TTTT','TTTG','TTTC +','TTGA','TTGT','TTGG','TTGC','TTCA','TTCT','TTCG','TTCC','TGAA','TGA +T','TGAG','TGAC','TGTA','TGTT','TGTG','TGTC','TGGA','TGGT','TGGG','TG +GC','TGCA','TGCT','TGCG','TGCC','TCAA','TCAT','TCAG','TCAC','TCTA','T +CTT','TCTG','TCTC','TCGA','TCGT','TCGG','TCGC','TCCA','TCCT','TCCG',' +TCCC','GAAA','GAAT','GAAG','GAAC','GATA','GATT','GATG','GATC','GAGA', +'GAGT','GAGG','GAGC','GACA','GACT','GACG','GACC','GTAA','GTAT','GTAG' +,'GTAC','GTTA','GTTT','GTTG','GTTC','GTGA','GTGT','GTGG','GTGC','GTCA +','GTCT','GTCG','GTCC','GGAA','GGAT','GGAG','GGAC','GGTA','GGTT','GGT +G','GGTC','GGGA','GGGT','GGGG','GGGC','GGCA','GGCT','GGCG','GGCC','GC +AA','GCAT','GCAG','GCAC','GCTA','GCTT','GCTG','GCTC','GCGA','GCGT','G +CGG','GCGC','GCCA','GCCT','GCCG','GCCC','CAAA','CAAT','CAAG','CAAC',' +CATA','CATT','CATG','CATC','CAGA','CAGT','CAGG','CAGC','CACA','CACT', +'CACG','CACC','CTAA','CTAT','CTAG','CTAC','CTTA','CTTT','CTTG','CTTC' +,'CTGA','CTGT','CTGG','CTGC','CTCA','CTCT','CTCG','CTCC','CGAA','CGAT +','CGAG','CGAC','CGTA','CGTT','CGTG','CGTC','CGGA','CGGT','CGGG','CGG +C','CGCA','CGCT','CGCG','CGCC','CCAA','CCAT','CCAG','CCAC','CCTA','CC +TT','CCTG','CCTC','CCGA','CCGT','CCGG','CCGC','CCCA','CCCT','CCCG','C +CCC'); my $name1=""; my $seq1=""; my %counts=(); my %counts_1=(); my %counts_2=(); my %counts_3=(); my %counts_4=(); my %total_mono=(); open (IN, "<$file1") or die ("Couldn't open file $file1\n"); while (my $i=<IN>){ next unless ($i =~ /\w+/); chomp($i); if ($i =~ /^>(\S+)/){ unless ($seq1 eq ""){ $seq1 =~ s/[^ATCG]//g; &process_nuc($seq1, $name1); } $seq1=""; $name1=$1; }else{ $seq1.=uc($i); } } close IN; $seq1 =~ s/[^ATCG]//g; &process_nuc($seq1, $name1); print "Matrix_"; print scalar(@array); for (my $k=0; $k<@array; $k++){ print "\t$array[$k]"; }print "\n"; my %norm_1=(); my %norm_2=(); my %norm_3=(); my %norm_4=(); foreach my $k (keys (%counts)){ print "$k"; 60 my $value=0; 61 $norm_1{'A'}=$counts_1{$k}{'A'}/$total_mono{$k}; 62 $norm_1{'T'}=$counts_1{$k}{'T'}/$total_mono{$k}; 63 $norm_1{'C'}=$counts_1{$k}{'C'}/$total_mono{$k}; 64 $norm_1{'G'}=$counts_1{$k}{'G'}/$total_mono{$k};

    When I executed, I got results and the following error message:

    Use of uninitialized value in division (/) at ./ line 61.

    Illegal division by zero at ./ line 61.

    I tried to use eval BLOCK as recomended in, but it didnīt help that much because I get the same error message. I know that first message is a warning, but how can I know if this affects my results?.

    Also, Iīm not quite sure if the second message is an error or a warning, so I donīt know if this made the script to stop.

    Iīll appreciate the help.

cpan Compiling 32bit by default
1 direct reply — Read more / Contribute
by DanEllison
on Jul 09, 2014 at 10:53

    Earlier I found /usr/bin/perl linked to the 32bit version on a 64bit machine. I got that changed so perl is now running 64bit. However, when I try to install modules using 'cpan', it apparently wants to still compile 32bit.

    If I go into the build directory and execute the "perl Makefile.PL" and "make" myself, it compiles correctly in 64bit. Why does cpan want to compile 32bit?

Task orchestrator or distributed state machine
6 direct replies — Read more / Contribute
by moritz
on Jul 09, 2014 at 09:19

    For a $work project we have to define some workflows where individual pieces (henceforth "tasks") run distributed over several machines, and now the big question is: how do we coordinate them?

    A typical use case is to run task A, and when it's finished (and successful), run tasks B and C in parallel, and when both are done (and successful), run task D.

    The workers will communicate over AMQP (think RabbitMQ).

    But we need a piece of software that controls the flow of all theses tasks, and of course I'd like to write in Perl. What existing software could help with that? I think I want some kind of task orchestrator, like a state machine where you can define transitions, forks and joins.

    On the task scheduling side, so far I've found Minion. It looks promising, but is very light on high-level documentation. Also while it seems to support events on failed and finished jobs, it doesn't offer any further help with the orchestration. Also no AMQP support, but then I didn't find any perl-based task queues/schedulers that use AMQP.

    The state machine side looks pretty bleak. Machine::State and State::Machine both allow only one state, and no joins/forks.

    Can you recommend any modules or tools that will help me with coordinating those tasks?

    Update: It seems like I'm looking for something like TaskFlow, only in Perl.

Managing an asynchronous neverending external program
2 direct replies — Read more / Contribute
by Porax
on Jul 09, 2014 at 05:36

    Hi Monks,

    I am really new to Perl and having some issues I don't really know how to handle. I work in a Windows environment.

    I made a father script that loops to gather configuration information and provide data files to another program. No real problem here, this task was a good first contact with Perl (XML reading and writing, regex...).

    My problem is that this program doesn't end on its own, it has to run for a certain duration(which I get in the conf files) so the standards functions like open(), exec(), or system() can't help here as I need to ask the program to stop (in a clean way) and those will just have my script start to wait. I could have set a timeout but the duration set in the files may change while the program is already running so I have to update it.

    Also I need to start several instances of the external program as new conf files become available and all this may get even more complicated after the first prototype development phase as the instances of the external program will probably have to be distributed across several servers (it is a quite memory consuming app), this will be a problem to be adressed later but it may influence the choice here.

    I have looked for ideas and found some modules that look like they could help me here but I feel a bit overwhelmed by all this information :p

    - Win32::Job

    - POE

    - IPC::Cmd

    Or I could make a "double fork", one to start the program, the other one to process its output files and close it when the time has come (I would need to find the right cmd window (probably thanks to its title) and emulate a click on the cross or a Ctrl-C to end it properly).

    Which one of the above approaches seems the best suited fo my needs (and being reasonably easy to put to use for the confused beginner I am) ? Do you know other modules that could do the job? Do you have any general advice/examples for this situation ?

    Thank you in advance for your wisdom !


Table Extract Header Match
1 direct reply — Read more / Contribute
by perlmuser
on Jul 09, 2014 at 05:22
    I have a simple HTML file .. the contents off which i have included below : ###############
    <table class="gridtable" summary="RegTable"> <tr><th>Address</th><th>Register</th><th>7</th><th>6</th><th>5</th><th +>4</th><th>3</th><th>2</th><th>1</th><th>0</th><th>Reset</th><th>Desc +ription</th></tr> <tr><td>0x00000001</td><td><a href="#RegisterMap:REG0000">REG0000</a>< +/td><td align=center colspan=6> TEMP </td><td align=center > STOP </t +d><td align=center > START </td><td>'h14</td><td>TEMPORARY REG.</td>< +/tr> </table> <table class="gridtable" summary="RegTable"> <tr><th>Address</th><th>Register</th><th>15</th><th>14</th><th>13</th> +<th>12</th><th>11</th><th>10</th><th>9</th><th>8</th><th>7</th><th>6< +/th><th>5</th><th>4</th><th>3</th><th>2</th><th>1</th><th>0</th><th>R +eset</th><th>Description</th></tr> <tr><td>0x00000100</td><td><a href="#FuseMap:FUSE0">FUSE0</a></td><td +align=center colspan=8> F_1 </td><td align=center colspan=8> F_0 </td +><td>'h0000</td><td>FUSE0.</td></tr> </table>
    ########### I basically has two tables I wrote the following perl script to extract the table based on a header match: ###########
    use HTML::TableExtract; my $file = 'temp.html'; @headers = qw( Address Register 15 14 13 12 11 10 9 8 7 6 5); print " \n h:@headers:\n"; $te = new HTML::TableExtract( keep_html=>1,headers => \@headers); $te->parse_file($file); @tcount1 = $te->counts(0); print " tcount1 : @tcount1:\n";
    ######## Basically i could like to extract the second table, but for some reasons the extraction does not seem to work .. If however i remove the last entry in the header list i.e. if i have the header as just
    @headers = qw( Address Register 15 14 13 12 11 10 9 8 7 6);
    It works fine .. but with the header as :
    @headers = qw( Address Register 15 14 13 12 11 10 9 8 7 6 5);
    It does not work .. Not sure if i have done something wrong here .. but can someone help me out .. I could like to have the header as
    @headers = qw( Address Register 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 +);
    for some reasons and not a truncated header .. Any suggestions could be great .. Perl version 5.14.2
Join with x operator
5 direct replies — Read more / Contribute
by sneaky
on Jul 09, 2014 at 04:57
    Hello, currently in learning and I'm following this tutorial: At the bottom of the page there is the following example:
    print "Test 4:\n"; print join("\n", (("hello") x 5)), "\n\n"; print "Test 5:\n"; print join("\n", ("hello" x 5)), "\n\n"; >> Test 4: hello hello hello hello hello Test 5: hellohellohellohellohello
    I do not understand what is happening here. In my mind these should behave the opposite. I have also tried:
    print ("hello" x 5); print "\n"; print (("hello") x 5); >> hellohellohellohellohello hellohellohellohellohello
    So can someone please help me understand the difference in the join operations above?
Help with setting up spamc
2 direct replies — Read more / Contribute
by SteveTheTechie
on Jul 09, 2014 at 00:26

    I may be overthinking this, but here goes.

    I am the current developer for a free template based website system used by over 9000 Toastmasters public speaking clubs worldwide. We handle over 300,000 emails in a given week for clubs using our system.

    All of our server code is in Perl including our email handler. Our email handler supports a wide variety of forwarding email addresses and distribution lists. Up till recently, our main email security approach was to verify club membership. We still want to do that, but we have added the use of SpamAssassin as an additional step targeted at the provided email addresses that are intended for public use.

    I set up SpamAssassin using Mail::SpamAssassin in the email handler, and it basically started dragging the server performance significantly (should have expected that).

    I am trying to get the spamc/spamd combo going for us. We have spamd set up. I am just stumbling over setting up the use of spamc in the email handler code.

    Current SpamAssassin call from email handler (@ line 479 of email handler--*lots* happening before this):
    #Spam Test with SpamAssassin... unless ($SpamChecked || $whitelisted) { my $trigger = $CLUBSITES{'spamthreshold'} || 5.0; my $spamtest = new Mail::SpamAssassin({ 'post_config_text' => "requi +red_score $trigger" }); my $status = $spamtest->check_message_text( $message_received ); if ( $status->is_spam() ) { my $score = $status->get_score(); my $threshold = $status->get_required_score(); my $hits = $status->get_names_of_tests_hit(); my $SpamLogMsg = "Score: $score / $threshold (trigger);\t Positiv +e Tests: $hits"; HandleError("SPAM", $SpamLogMsg, $message_received); } $status->finish(); $spamtest->finish(); $SpamChecked++; }

    I need to send $message_received to spamc and capture its output in a variable (preferably) so I can get the spam score. I know I can just back quote a system command to capture stdout to a variable, but how can I do both the stdout and the stdin handling here? This should be simple, but I am just missing it...

Why don't file handles have sigils?
4 direct replies — Read more / Contribute
by 1s44c
on Jul 08, 2014 at 15:46

    I see a lot of references to how things would be easier if file handles had sigils. Is there some reason why they don't? Using references works great but mixing references with barewords for STDIN/OUT/ERR seems messy.

    I'm sure this has been asked before but I could not find anything in the site search or with google.

New Cool Uses for Perl
commandline ftpssl client with Perl
1 direct reply — Read more / Contribute
by zentara
on Jul 05, 2014 at 12:37
    Recently, all my c-based ftpssl programs stopped working with ssl, namely gftp and lftp. I found that Net::FTPSSL still works great, but it isn't interactive, it allows just automated scripting. So, how to make an interactive session? I first thought of using a gui, but there was no real advantage to the gui, over the commandline, ( not without a huge amount of work ;-) ), so a simple commandline program fit the bill. Here it is. There is a second program below it, which runs it from a pty, in anticipation of channeling it into a Tk or GTk gui; but the gui's seems to have difficulty capturing the tty. If anyone can show how to get the ftpssl tty pty output into a textbox, I would be grateful.

    If you want to experiment on your own machine, Proftd works good when configured with --enable-tls, you can google for instructions.

    I used a little eval trick to pass the commands into the pty.

    Some common commands : list pwd cwd noop nlst mkdir('foo') rmdir('foo') put('somelocalfile', 'remotefile')

    The method set that comes with Net::FTPSSL is simple and easy.

    ftps-z: runs standalone or thru a pty as shown below

    #!/usr/bin/perl use strict; use warnings; use Net::FTPSSL; my $server = ""; my $username = "someuser"; my $passwd = "somepass"; my @ret; my $ftps = Net::FTPSSL->new($server, Encryption => EXP_CRYPT, Debug => 1, # Croak => 1, ) or die "Can't open $server\n$Net::FTPSSL::ERRSTR"; $ftps->login($username, $passwd) or error("Credential error, $ftps->last_message"); # get default listing and pwd @ret = $ftps->list() or error("Command error, $ftps->last_message"); print "####################\n"; print join "\n", @ret,"\n"; print "####################\n"; # get default pwd @ret = $ftps->pwd or error("Command error, $ftps->last_message"); print "####################\n"; print join "\n", @ret,"\n"; print "####################\n"; if( -t STDIN ) { print "tty\n"; } while(1){ print "Hit Control-C to exit ... otherwise:\n"; print "Enter command: \n"; my $com = <STDIN>; chomp $com; if ($com =~ m/quit/){ print "exiting\n";} # needed this eval to get ftps methods to work with pty my @ret = eval "\$ftps->$com"; if($@) { print "@_\n"; } print "####################\n"; print join "\n", @ret,"\n"; print "####################\n"; if ($com =~ m/quit/){ print "exit command received, ftpssl exiting\n"; + print "Control-C to exit pty, or Shift-PageUp to + view log\n"; last; } } print "at end\n"; exit;
    IO-Pty-driver for above ftps-z
    #!/usr/bin/perl -w # Description: Fool a process into # thinking that STDOUT is a terminal, when in fact # basic PTY code from etcshadow use warnings; use strict; use IO::Pty; $SIG{CHLD} = 'IGNORE'; # for when we quit the ftpssl session my $pty = IO::Pty->new; my $slave = $pty->slave; open TTY,"/dev/tty" or die "not connected to a terminal\n"; $pty->clone_winsize_from(\*TTY); close TTY; my $pid = fork(); die "bad fork: $!\n" unless defined $pid; if (!$pid) { open STDOUT,">&=".$pty->fileno() or die $!; exec "./ftps-z"; }else{ $pty->close(); while (defined (my $line = <$slave>)) { print $line; } } while(1){ my $command = <>; print $slave "$command\n"; }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh
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 drinking their drinks and smoking their pipes about the Monastery: (6)
As of 2014-07-12 05:19 GMT
Find Nodes?
    Voting Booth?

    When choosing user names for websites, I prefer to use:

    Results (238 votes), past polls