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

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
MD5::Digest addfile() w/ tied filehandle
No replies — Read more | Post response
by jdv
on Aug 29, 2015 at 23:24

    I'm observing an odd interaction of my module with MD5::Digest that I haven't been able to figure out.

    I'm implementing a read/write interface to a gzip variant using tied filehandles, with full seek/read/readline/tell support. I'm in the testing phase and nearly all of the tests I'm throwing at it seem to be working (basically performing exactly the same combinations of seek, read, <>, etc, on both my tied filehandle object (with the compressed file loaded) and a regular Perl filehandle opened on the uncompressed version, and comparing the output).

    The one exception at this point is when I try to provide my tied filehandle to MD5::Digest's addfile() method. This doesn't work:

    my $fh = B2B::BGZF::Reader->new_filehandle( $fn_bgzf ); my $hex = Digest::MD5->new()->addfile($fh)->hexdigest; print $hex, "\n"; # prints d41d8cd98f00b204e9800998ecf8427e

    The test returns almost immediately and it appears the hash returned is that of an empty string, so clearly the file is not actually being read. However, this works as expected:

    my $fh = B2B::BGZF::Reader->new_filehandle( $fn_bgzf ); my $d = Digest::MD5->new(); my $buf = ''; $d->add($buf) while ( read $fh, $buf, 4096 ); my $hex = $d->hexdigest; print $hex, "\n"; # prints the expected sum

    It also works fine if I run the original code but substitute the pure-Perl module (although painfully slowly):

    my $fh = B2B::BGZF::Reader->new_filehandle( $fn_bgzf ); my $hex = Digest::Perl::MD5->new()->addfile($fh)->hexdigest; print $hex, "\n"; # prints the expected sum

    I additionally tried it with Digest::SHA, and that works fine too:

    my $fh = B2B::BGZF::Reader->new_filehandle( $fn_bgzf ); my $hex = Digest::SHA->new(1)->addfile($fh)->hexdigest; print $hex, "\n"; # prints the expected sum

    Basically, I have only been able to observe the issue when using my module with the XS implementation of Digest::MD5. Debugging is difficult because I'm not sure what code is actually being called (apparently not the addfile() method of Digest::base or any other actual perl code I can find on my system). I have no problem just using the explicit read()/add() form with Digest::MD5, but if this is an indication of a subtle bug in my code I'd like to work it out - I'm just not sure how to do so.

    Any help with understanding what Digest::MD5::addfile() is actually calling under the hood or what might be going on here would be greatly appreciated.

Math::BigFloat bnok() question
3 direct replies — Read more / Contribute
by azheid
on Aug 27, 2015 at 14:15

    I have an issue that I think is probably a simple one. I do not know how to use Math::BigFloat::bnok(). I get the following error message "Can't call method "Math::BigInt::bnok" without a package or object reference at hexamer_rarity_codonusage.pl line 67."

    Despite reading the Math::BigFloat page and extensive googling, the solution seems beyond my ability to comprehend. Please help. I will post the files that this code uses if necessary, just ask.

    #!/usr/bin/perl use Getopt::Long; use Math::BigFloat; use Math::BigInt; my $codon_fname="codons.txt"; my $n_amer_fname="codon_pair.txt"; my $codon_usage_fname=""; my $mfactor=100; my $codon_usage_per=100; GetOptions( "c=s" => \$codon_usage_fname, ) or die ("Error in command line arguments\n"); open(CODON,'<',$codon_fname)||die "No $codon_fname file available\n"; my %codon_counts; while (my $line=<CODON>){ chomp $line; $codon_counts{$line}= 0 ; } close CODON; open(NAMER,'<',$n_amer_fname)||die "No $n_amer_fname file available\n" +; my @namer; while (my $line=<NAMER>){ chomp $line; push @namer, $line; } close NAMER; my %cd_lookup; open(CLT,'<',$codon_usage_fname)||die "Cannot find codon score lookup +table file $codon_usage_fname\n"; while(my $line=<CLT>){ chomp $line; my @array=split(/\t/,$line); $cd_lookup{$array[0]}=$array[1]; } close CLT; Math::BigFloat->accuracy(40); my $x=Math::BigFloat->new(40); my $y=Math::BigFloat->new(40); my $z=Math::BigFloat->new(40); my $d=Math::BigFloat->new(40); for(my $i=0;$i<@namer;++$i){ my $pvalue=0; my @choose_numerator_array; my %cchash=%codon_counts; for(my $j=0;$j<length($namer[$i])-2;++$j){ ++$cchash{substr($namer[$i],$j,3)}; } foreach my $codon(%cchash){ if($cchash{$codon}){ $x=$cchash{$codon}; $y=$cd_lookup{$codon}*$mfactor; $z=$y->Math::BigInt::bnok($x); push @choose_numerator_array,$z->copy(); } } $x=$choose_numerator_array[0]; for(my $j=1;$j<scalar(@choose_numerator_array);++$j){ $y=$choose_numerator_array[$j]; $x=$x*$y; } $y=$codon_usage_per*$mfactor; $z=scalar(@choose_numerator_array); $d=$y*$z; $x=$x/$d; print $namer[$i],"\t",$x,"\n"; }

    If any future perl users want the answer to how I solved this problem, below is the functional code

    #!/usr/bin/perl use Getopt::Long; use Math::BigFloat; use Math::BigInt; my $codon_fname="codons.txt"; my $n_amer_fname="codon_pair.txt"; my $codon_usage_fname=""; my $mfactor=100; my $codon_usage_per=100; GetOptions( "c=s" => \$codon_usage_fname, ) or die ("Error in command line arguments\n"); open(CODON,'<',$codon_fname)||die "No $codon_fname file available\n"; my %codon_counts; while (my $line=<CODON>){ chomp $line; $codon_counts{$line}= 0 ; } close CODON; open(NAMER,'<',$n_amer_fname)||die "No $n_amer_fname file available\n" +; my @namer; while (my $line=<NAMER>){ chomp $line; push @namer, $line; } close NAMER; my %cd_lookup; open(CLT,'<',$codon_usage_fname)||die "Cannot find codon score lookup +table file $codon_usage_fname\n"; while(my $line=<CLT>){ chomp $line; my @array=split(/\t/,$line); $cd_lookup{$array[0]}=$array[1]; } close CLT; use bignum; my $x,$y,$z,$a,$b,$c; #Math::BigFloat->accuracy(40); #$x=Math::BigInt->new($x); #$y=Math::BigInt->new($y); #$z=Math::BigInt->new($z); #$a=Math::BigFloat->new($a); #$b=Math::BigFloat->new($b); #$c=Math::BigFloat->new($c); for(my $i=0;$i<@namer;++$i){ my @choose_numerator_array; my %cchash=%codon_counts; my $count=0; for(my $j=0;$j<length($namer[$i])-2;++$j){ ++$cchash{substr($namer[$i],$j,3)}; ++$count; } foreach my $codon(%cchash){ if($cchash{$codon}){ $x=$cchash{$codon}; $y=$cd_lookup{$codon}*$mfactor; $z=binomial($y,$x); push @choose_numerator_array,$z->copy(); } } $b=$choose_numerator_array[0]; for(my $j=1;$j<scalar(@choose_numerator_array);++$j){ $a=$choose_numerator_array[$j]; $b=$b*$a; } $y=$codon_usage_per*$mfactor; $a=&binomial($y,$count); $c=$b/$a; print $namer[$i],"\t",$c,"\n"; } sub binomial { use bigint; my ($r, $n, $k) = (1, @_); for (1 .. $k) { $r *= $n--; $r /= $_ } $r; }
PERL Tk label(-textvariable))
2 direct replies — Read more / Contribute
by State_Space
on Aug 26, 2015 at 13:55
    Hello, I wrote a PERL TK program that creates 3 Labels with text variables inside frames. A snippet is below. I use other frames for other things.
    my $red; my $green; my $blue; my $mw = MainWindow->new; $mw->title(); my $right_frame = $mw->Label->pack(); my $variable_frame = $right_frame->Label->pack(); my $red_frame = $variable_frame->Label(-textvariable =>\$red)->pack(); my $green_frame = $variable_frame->Label(-textvariable => \$green)->pa +ck(); my $blue_frame = $variable_frame->Label(-textvariable => \$blue)->pack +(); $variable_frame->Label(-text =>"------")->pack();
    I removed what was inside pack();, so the code was single lined.
    I then proceed to scan a file and update the variables red, green, and blue. When updating the frame.
    $red_frame->update; $greeen_frame->update; $blue_frame->update;

    The last updated variable shows up, but the previously updated ones disappear. So from the code above blue would be visible but red and green labels would be blank, in the GUI. How can I have all variables showing in the GUI?

    Some psuedo code:
    Create GUI
    LOOP
    scan new document
    find $red
    update gui
    find $green
    update gui
    $find $blue
    update gui
    END Loop
    I would like my variables updating as soon as the change and not wait till they're all found at the end to update in the GUI. The last Label as well containing no textvariable just a string "------" goes blank when the loop resets.

Inet socket to inet socket communication
2 direct replies — Read more / Contribute
by QuillMeantTen
on Aug 26, 2015 at 12:27

    Greetings,
    after much trial and error I am almost done with the basic functionality of a messaging daemon summoner. Idea behind it is to make communication transparent (through filehandles) to other scripts and let the messaging daemon handle things (such as taking input from a network socket and putting output on an unix socket or in a named pipe)

    I am now testing the following functionality :

    • listen for messages on one port
    • copy said message to another port

    I have one test script that forks, the father sending messages and the child on the receiving end.
    Trouble is, the first message is sent and received correctly. The second message is received by the messenger daemon but never relayed to the child. I think the issue is somewhere in the following code :

    specificaly in the "network_socket" cases.
    After reading around I have found out that I very probably misunderstand the way one should use sockets, or named pipes for that matter. Here is an example of the kind of things I do to get hash structures transmitted (that's the code for the receiving end, the handle is for a named pipe)

    and now the testing code : here is the receiving process (listening to localhost:1066)

    and the writing process

    You might notice that both of these processes, even the writing one connect to a peer and not the other way around.
    I'm not sure if its a good idea but I felt more comfortable with having the messaging daemon summoner deal with things such as setting up the sockets, and to "keep it in the family" giving their handles to his little messenger daemons...

    here is the code that creates both sockets :

    I am eager to better my coding style too so if you have any suggestions toward making my code more readable/maintainable or at least less eye-gouging I will be most grateful.

Catalyst::Dispatcher - usage of expand_actions
1 direct reply — Read more / Contribute
by mkchris
on Aug 26, 2015 at 11:39

    Hi everyone

    I'm writing a Catalyst app and currently trying to generate a breadcrumbs script (Catalyst::Plugin::Breadcrumbs has been helpful in pointing me in the right direction, but doesn't quite do what I want and in any case doesn't seem to have been touched since 2006).

    I'm using chained actions and one or two of my controllers have multiple links in the chain; therefore I think I need to expand these actions from $c->request->action in order to get proper breadcrumbs - however I don't seem to be doing this correctly; as far as I can tell, I should be able to call $c->dispatcher->expand_action, but putting the result of this into a debug statement to see the result yielded an error:

    The code: $c->log->debug( $c->dispatcher->expand_action( $c->request->action ) );

    Errors with:
    'Can't call method "attributes" without a package or object reference at D:/WAMP/Perl/site/lib/Catalyst/DispatchType/Chained.pm line 458' (yeah, Windows, don't hate me - developing on my work laptop, it'll be on CentOS eventually! :-) )

    I am sure I'm probably doing something really stupid like passing the wrong value into the expand_action sub, but I can't think what else may actually need to go in there, as far as I can tell it takes a Catalyst action.

    Many thanks in advance for any assistance you may be able to give.

    Chris

Breaking from a foreach loop, returning to position
6 direct replies — Read more / Contribute
by Anonymous Monk
on Aug 26, 2015 at 10:46

    So, I'm running into some trouble thinking of how to temporarily leave a for loop, only to return to it later. Ideally I'd like to return to the spot where I left off. I feel like there's some logic I'm missing somewhere.

    To start, let's say I have:
    -------

    #some stuff foreach (@array) { $spot_in_array = $_; #some stuff if(CONDITION_MET){ #temporarily leave foreach } }

    In the if statement, how would I leave the foreach loop without leaving permanently? I thought of using last but I know that wouldn't get me back into the loop. The reason why I added that $spot = $_; is because, I think I'm on the right track here, I may be able to use a for loop that starts at $spot and ends at the last index of @array. How I'd do this kind of stumps me. Would I start with a foreach loop at all? Or do I set $spot to the first item, and iterate through a for loop, in a nested while loop that returns every time if(!CONDITION_MET) happens, kind of like an on/off switch.

    I've only picked up and been working with Perl for a few weeks, so there's a lot I still don't know. Any help would be greatly appreciated. Thanks.

Strange Params::Validate Error
3 direct replies — Read more / Contribute
by Stringer
on Aug 26, 2015 at 09:40
    While working with the DateTime module, I'm getting a very odd and frustrating error back from the Params::Validate module:
    The 'locale' parameter (undef) to DateTime::new was an 'undef', which +is not one of the allowed types: scalar object at /usr/lib/perl5/site_perl/5.8.5/Params/ValidatePP.pm line 634 Params::Validate::__ANON__('The \'locale\' parameter (undef) to Da +teTime::new was an \'un...') called at /usr/lib/perl5/site_perl/5.8.5 +/Params/ValidatePP.pm line 485 Params::Validate::_validate_one_param('undef', 'HASH(0x1039fb0)', +'HASH(0xe04910)', 'The \'locale\' parameter (undef)') called at /usr/ +lib/perl5/site_perl/5.8.5/Params/ValidatePP.pm line 345 Params::Validate::validate('ARRAY(0xa87370)', 'HASH(0xe284a0)') ca +lled at /usr/lib64/perl5/site_perl/5.8.5/x86_64-linux-thread-multi/Da +teTime.pm line 171 DateTime::new('undef', 'year', 2015, 'month', 08, 'day', 24, 'hour +', 17, ...) called at MonitorClass.pm line 80 MonitorClass::MakeDateTime('MonitorClass=HASH(0xf03430)', 2015, 08 +, 24, 17, 36, 47, 144) called at MonitorClass.pm line 196

    This is driving me nuts, as the parameters sent to DateTime->new() are correct, as can be seen in the final line of my error. I'm not even able to reproduce the issue consistently. For the vast majority of cases my code works great but every morning when I get into work I see that it's thrown the above a few times.

    I'm going to try explicitly setting the locale parameter each time I call DateTime->new(); but I'd rather understand what I'm doing wrong here.

    Here's my method that's invoking DateTime->new(); it's ridiculously simple:
    sub MakeDateTime { my $self = shift; my ($Year, $Month, $Day, $Hour, $Minute, $Second, $MilliSecond) = @_ +; my $DateTime = DateTime->new( year => $Year, month => $Month, day => $Day, hour => $Hour, minute => $Minute, second => $Second, nanosecond => ($MilliSecond * 1000000), time_zone => 'America/New_York', locale => 'en_US', ); return $DateTime; }
Text parsing. Processing scopes and subscopes.
6 direct replies — Read more / Contribute
by Lana
on Aug 25, 2015 at 18:34

    Hi Monks!

    I am working on parsing text and making required substitutions inside it. For example, I have a template text and I am using curly braces inside it in places where text may vary depending on input data:

    text text {scope 4 text {scope 2 text {scope 1 text} scope 2 text} scope 4 text {scope 3 text} scope 4 text } text text

    The question is how to process the scopes, subscopes in the order I stated in the example sentence? 1-2-3-4? I mean accessing the most inner one and then moving to the top (most outer) scope.

    What is the best way to do that?

    Thanks! Lana :)

Parsing and converting Fortran expression [solved]
3 direct replies — Read more / Contribute
by kikuchiyo
on Aug 25, 2015 at 16:09

    I need to parse Fortran expressions and emit their C equivalents, e.g from this:

    .not.foo(1,bar(2)+1,3).and.baz(4,5)

    produce

    ! foo[2][bar[1]][0] && baz[4][3]
    • foo, bar, baz and the like are variable names which have to be preserved.
    • .not., .and., .or. are boolean operators which have to be translated into their C equivalents.
    • Fortran array indices start from 1 while in C they start from 0, so all indices have to be decreased by one. Additionally, the order of indices for multidimensional arrays have to be reversed, and the comma-separated list must be converted to a sequence of [] subscripts.

    Is there something readily usable for this?

How to do atomic file locking?
6 direct replies — Read more / Contribute
by Acapulco
on Aug 25, 2015 at 13:41

    Hello monks,

    I've been reading PM for a while but this is my first time asking. Almost always the answer is already there and I just had to search for it... except in this case.

    I've been reading about file locking in Perl, as I need to avoid concurrency issues while reading and writing a file.

    My general problem is that I have a script that works as a CLI tool, but for certain operations I need to first check the contents of a file and depending on those I either X or Y things. Basically my file contains the state of a part of the system, and if that state is say A I can proceed, but if it's B I can't. The concurrency problem comes from the fact that the CLI can be called multiple times in succession (via scripts, etc) and so they should not have race conditions to check this file. Thus I thought of file locking.

    However the issue I have is that everywhere I look I find flock being used but as far as I can tell, obtaining a lock this way is not atomic, since I first need to actually open the file.

    Please correct me if I'm wrong, but if I first open then flock, isn't there a non-zero probability that this would cause a race condition?

    Is there any way to actually do file locking in an atomic way, so that we open AND flock at the same time (or fail) to avoid this?

    I've also looked into semaphores as an alternative, specifically IPC::Semaphores (since these would be shared between processes right?) but I am also forking a few times inside the script and thus the semaphore variable is going to be shared as well, and that would lead me to some difficulties since I would need to make sure the semaphores are not released inadvertently in the incorrect place (by a child for example).

    Are my assumptions on flock correct or am I missing something here? if the race condition actually exists, how do people work around that? or do they just ignore it since for most use cases maybe this is a non-issue?

    Most CPAN packages are out of the question because I can't really install anything due to policy issues :( and so I was looking for a built-in way to do this.

    Thanks a lot for your help! Acapulco

Create a new operator, get LHS
10 direct replies — Read more / Contribute
by stevieb
on Aug 25, 2015 at 12:02

    In Python, I can do if var in list, where list in Python is the same as an array in Perl.

    I got to thinking, what if I wanted to create an in operator just to play around? How would one get the LHS (in the above case var) so I can use it in whatever implementation I decide to use? Can someone recommend the appropriate documentation to someone who wants to start learning about perl on a little deeper level?

    -stevieb

Login to multiple devices using telnet and issue different commands
2 direct replies — Read more / Contribute
by acondor
on Aug 25, 2015 at 10:35

    Hello, I'm new to Perl, found sample telnet code that would like to modify.

    I have the following:

    ip.list (list of host name and related IP addresses), example:

    HOST1, 10.10.10.101

    HOST2, 10.10.10.102

    etc

    Another file has referencing host and commands:

    commands.list

    HOST1, CommandA

    HOST1, CommandB

    HOST2, CommandC

    HOST3, CommandD

    HOST3, CommandE

    HOST3, CommandF

    etc

    My 1st question is, how to match host name in command file to ip.list file and use the IP address to process?

    Second, if connection is made to HOST1, issue first command, if second command is for the same HOST, then issue second command. If all commands are done for the connected host, close connection, then establish new connection to the next host and repeat.

    #!/usr/bin/perl -w use strict; use Net::Telnet; my $log = './log.txt'; open LOG, ">>$log"; #open log file - append mode open IPS, "<ip.list"; #open ip.list file - read mode while(<IPS>){ my $ip = $_; #current iteration (line) of IPs file $telnet = new Net::Telnet ( Timeout=>10, Errmode=>'die' Prompt => '/# $/i'); $telnet->open($ip); $telnet->login('USERNAME', 'PASSWORD'); if($telnet->cmd('CommandA')){ print LOG "$ip CommandA successful"; }else{ print LOG "$ip Unable to Connect"; } } close LOG; #close files close IPS;
New Meditations
Notepad++ Perl Function List with "Classes"
No replies — Read more | Post response
by VinsWorldcom
on Aug 24, 2015 at 12:50

    Windows Monks,

    As follow-on to my previous meditation regarding Notepad++ Integrated Perl Debugging, I've been doing other things with Notepad++ to make it more friendly when I write Perl (of which I've been doing more than usual lately).

    One thing I did was to get Python debugging working the same way as with Perl. In case you're interested, see here: http://vinsworldcom.blogspot.com/2015/08/notepad-dbgp-and-python.html.

    This got me thinking as I looked in the "Function List" window at Python code:

    file.py +[Class]h_main __init__ +[Class]h_base toXML convert main

    Why does the "Function List" window show Python classes, but not Perl by default? Of course by Perl class, I mean 'package <name>'. All I would see was a list of subs. Take the following example program:

    #!perl use strict; use warnings; package MyPkg; sub one { 1; } sub two { 1; } 1; package main; my $p = pre(); print $p . MyPkg->one; sub pre { return "ONE = "; }

    The Notepad++ Function List is:

    file.pl one two pre

    But there are clearly "classes" (read: packages) under which I'd like my subs grouped. Thankfully, Notepad++ allows customization of a file in the Notepad++ top level directory called 'functionList.xml' (documentation: https://notepad-plus-plus.org/features/function-list.html). A quick web search turned up a partial solution and with some more tweaking I finally got it to display:

    file.pl +[Class]MyPkg one two +[Class]main pre

    If there are no "packages", then the original display of just filename with the subs is what is displayed. I even tweaked it a bit to ignore stuff after __END__, so any "sub name" that appears in POD won't be mistakenly added to the Function List. I've tested it by viewing a few of my scripts, some modules and a few "custom" codes to demonstrate different use cases. So far, so good.

    The solution; save a copy of your existing 'functionList.xml' to something like 'functionList.xml.ORIG' (just in case you want to revert back), open the existing 'functionList.xml' file, find the Perl parser lines:

    <parser id="perl_function" displayName="Perl" ... ... </parser>

    and replace the whole lot with:

    <parser id="perl_function" displayName="Perl" commentExpr="(#.*?$|(__E +ND__.*\Z))"> <classRange mainExpr="(?&lt;=^package).*?(?=\npackage|\Z)"> <className> <nameExpr expr="\s\K[^;]+"/> </className> <function mainExpr="^[\s]*(?&lt;!#)[\s]*sub[\s]+[\w]+[\s]*\(?[^\)\ +(]*?\)?[\n\s]*\{"> <functionName> <funcNameExpr expr="(sub[\s]+)?\K[\w]+"/> </functionName> </function> </classRange> <function mainExpr="^[\s]*(?&lt;!#)[\s]*sub[\s]+[\w]+[\s]*\(?[^\)\(] +*?\)?[\n\s]*\{"> <functionName> <nameExpr expr="(?:sub[\s]+)?\K[\w]+"/> </functionName> </function> </parser>
New Cool Uses for Perl
Markov Chain automata class
1 direct reply — Read more / Contribute
by QuillMeantTen
on Aug 24, 2015 at 13:51

    The Following code provides a class to create Markov chain based automata which role is to tell you, after reading a dictionary, whether words you give them are likely to be part of the language they studied.

    I wrote it so I can use it to comb through dns queries logs to find anything that looks like an algorithmicaly generated domain name. have fun :D

    And here is the test file : 100% testcover :)

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (4)
As of 2015-08-30 10:19 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The oldest computer book still on my shelves (or on my digital media) is ...













    Results (348 votes), past polls