Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

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
getting content of an https website
1 direct reply — Read more / Contribute
by Datz_cozee75
on Aug 31, 2015 at 18:49

    I'm having a facebook discussion with a friend from high school who claimed that the word 'enemy' appeared on a webpage, and I wanted to prove that he was making it up and thought to do so with perl. I seem to be unable to get the content of the page and thought I'd ask for a work-around here:

    use strict; use warnings; use feature 'say'; use LWP::Simple; my $url = ''; my $content = get $url; die "Couldn't get $url" unless defined $content; if($content =~ m/enemy/i) { say "enemy found"; } else say $content; }


    Couldn't get  at line 8.

    I suspect that my problem is that https is different than http, but I see no work-around on cpan for LWP::Simple. Am I using the right tool? If so, how do I use it correctly? Thanks for your comment.

DBI/Oracle Nested SELECT query
3 direct replies — Read more / Contribute
by terroirman
on Aug 31, 2015 at 17:45

    I've been looking all around without finding. Here's my question : is this possible to do a nested query with DBI/oracle ?

    Here's my query :


    This is executed instantly in my Oracle client (toad). But in a script, that just hangs there forever. Basically, it doesn't get to the fetchall_arrayref statement.

    $odstthandle = $dbttods->prepare($qry) or die $dbttods->errstr; $odstthandle->execute() or die $odstthandle->errstr; $billets = $odstthandle->fetchall_arrayref or die $odstthandle->errstr +;

    Is that even possible to do ? If so any way to troubleshoot whats taking so long ? If not, any alternative than DBI ?

    Thanks for your time !

exit this way
2 direct replies — Read more / Contribute
by ExReg
on Aug 31, 2015 at 17:29
    I am adding several perl scripts and modules to an existing set of perl tools. When they looked over my latest script, they said that I should have an exit statement at the end, before all the subs. I do not see the need for exit if the script completes normally. Comments?
Generate a signed SOAP request
2 direct replies — Read more / Contribute
by machacapopa
on Aug 31, 2015 at 16:48

    Hi all, I've been searching all over the place for some examples on how to generate a digitally signed SOAP request header. I've added an example of what my generated request should look like. Any help, pointers, or link to examples would be greatly appreciated.

    <?xml version="1.0" encoding="UTF-8"?> <soapenv:Envelope xmlns:soapenv=" +ope/" xmlns:v1="some name space"> <soapenv:Header> <wsse:Security xmlns:wsse=" +/01/oasis-200401-wss-wssecurity-secext-1.0.xsd" xmlns:wsu="http://doc +xsd"> <wsse:BinarySecurityToken EncodingType="http://docs.oasis- +4Binary" ValueType=" +01-wss-x509-token-profile-1.0#X509v3" wsu:Id="X509-38899A2DEAAE0A0A63 +1438825555">MIIFazCCBFOgAwIBAgITBnGseFYWOGKEGKVHi/3Ww90xvzANBgkqhkiG9 +w0BAQsFADCBtTELMAkGA1UEBhMCVVMxETAPBgNVBAgTCElsbGlub2lzMRAwDgYDVQQHEw +dDaGljYWdvMSEwHwYDVQQKExhUcn</wsse:BinarySecurityToken> <ds:Signature xmlns:ds=" +" Id="SIG-38899A2DEA412885"> <ds:SignedInfo> <ds:CanonicalizationMethod Algorithm="http://www.w"> <ec:InclusiveNamespaces xmlns:ec="http://www.w" PrefixList="soapenv v1"/> </ds:CanonicalizationMethod> <ds:SignatureMethod Algorithm=" +000/09/xmldsig#rsa-sha1"/> <ds:Reference URI="#id-38899A2DEAAE0A0A654653"> <ds:Transforms> <ds:Transform Algorithm=" +/2001/10/xml-exc-c14n#"> <ec:InclusiveNamespaces xmlns:ec="http +://" PrefixList="v1"/> </ds:Transform> </ds:Transforms> <ds:DigestMethod Algorithm=" +2000/09/xmldsig#sha1"/> <ds:DigestValue>eGnt5SFabhhjgkjhg24</ds:Digest +Value> </ds:Reference> </ds:SignedInfo> <ds:SignatureValue>E81kRkC92PFjxn5rr6UB8Ul1BOiaSLRNySs +2qfAZxScXgjxjhgY7xmSCcxAs</ds:SignatureValue> <ds:KeyInfo Id="KI-38899A2DEAAE0A0A631316532131535"> <wsse:SecurityTokenReference wsu:Id="STR-38899A2DE +AAE0A0A63313156165"> <wsse:Reference URI="#X509-38899A2DEAAE0A06541 +651515" ValueType=" +1-wss-x509-token-profile-1.0#X509v3"/> </wsse:SecurityTokenReference> </ds:KeyInfo> </ds:Signature> </wsse:Security> </soapenv:Header> <soapenv:Body xmlns:wsu=" +sis-200401-wss-wssecurity-utility-1.0.xsd" wsu:Id="id-38899A2DEAAE0A0 +A631438865165165165"> <v1:Request> <v1:transactionId>SCSP00000054412256</v1:transactionId> <v1:deviceid>001234567452</v1:deviceid> <v1:cSRComments>blah</v1:cSRComments> <v1:suppressProvisioning>blah</v1:suppressProvisioning> <v1:reasonCode>blah</v1:reasonCode> <v1:source>OEM</v1:source> <v1:overrideURL/> </v1:Request> </soapenv:Body> </soapenv:Envelope>
How do I select first string of a two dimensional array to compare to other values?
9 direct replies — Read more / Contribute
by joi1369
on Aug 30, 2015 at 19:07

    I have an array after splitting a text document into three different columns. I'm trying to retrieve the first value in the first column to compare against other values in that column and then print out that initial value but, when I use the following code, it prints all of the first column. I've tried several different methods of doing this but I think I'm just not understanding something. The code is below and any help is greatly appreciated. Thanks in advance! Input-

    1424621700, 2015-02-22 16:15:00, 4294.700 1424621760, 2015-02-22 16:16:00, 4289.700 1424621820, 2015-02-22 16:17:00, 4299.800 1424621880, 2015-02-22 16:18:00, 4302.800 1424621940, 2015-02-22 16:19:00, 4296.900 1424622000, 2015-02-22 16:20:00, 4301.000 1424622060, 2015-02-22 16:21:00, 4300.300


    #!/usr/bin/perl use strict; use warnings; my $file = $ARGV[0]; open (RAW, "./$file") or die "Can't open $file for read: $!"; open (OUT, ">./OUTPUT_$file") or die "Can't open Output_$file: $!"; while(<RAW>) { my $line = $_; chop($line); next if ($line =~ /!/); my @splits = split (',', $line); my $first_value = @splits[0]; print "$first_value\n"; }

    Wanted output-

inverting keys in a 2-D Hash
3 direct replies — Read more / Contribute
by melmoth
on Aug 30, 2015 at 09:32
    Hi I have a 2D hash of arrays like: $HASH{keyA}{keyB} = [1,2,3,4]; and want to turn it into this: $HASH{keyB}{keyA} = [1,2,3,4]; and was wondering what the cleanest way to this is. thnaks!
Digest::MD5 addfile() w/ tied filehandle
1 direct reply — Read more / Contribute
by jdv
on Aug 29, 2015 at 23:24

    I'm observing an odd interaction of my module with Digest::MD5 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 Digest::MD5'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 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
    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

    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/ 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.


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.

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 wandering the Monastery: (9)
As of 2015-09-01 08:00 GMT
Find Nodes?
    Voting Booth?

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

    Results (368 votes), past polls