Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

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
Parsing text string in Perl
3 direct replies — Read more / Contribute
by gbwien
on Sep 01, 2015 at 17:48

    I am trying to get back into Perl and I have a question regarding how best to parse the following

    I have a file which contains many of the following entries

    Time: 1/9/2015-09:01:43.010 Protocol: SMPP ESME: ehttp_rknoe Direction: Outgoing From: To: PDU Type: Full PDU PDU Length: 16 PDU Data: 00000010800000040000005800029a92 Decode Error 0x00000000 Decoded PDU: [ smpp hdr 16 octets ] 00000000: 00 00 00 10 command_length: 16 00000004: 80 00 00 04 command_id: 0x80000004 submit_sm_re +sp 00000008: 00 00 00 58 command_status: 0x00000058 ESME_RTH +ROTTLED 0000000C: 00 02 9A 92 sequence_number: 170642

    I want to parse the complete file in perl and print out time and only those entries that have ESME_RTHROTTLED.

    The file may contain many other entries but I only want to print out this entry

    Thanks tom
Problems with PDF::API2 and TextBlock
1 direct reply — Read more / Contribute
by dougconran
on Sep 01, 2015 at 17:41
    I have an application that uses PDF::API2 (amogst other things to display jpg images) and PDF::TextBlock which has been running without problems on perl5.10.1. However I've just (foolishly, probably) upgraded my server and perl to v5.22.0. I've installed the relevant modules but I'm getting some really weird behaviour. Sometimes the pdf document will print with data and image but as often as not it just prints the initial blank pdf page (which I load from a base pdf doc). After exhaustive testing it would seem that $pdf->image_jpeg is one culprit the other being the TextBlock ->apply method. As far as I'm aware the problem areas work fine in another similar program and sometimes in this one. What's going on and does anyone have any idea how to fix it?
getting content of an https website
3 direct replies — 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
4 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
3 direct replies — 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.

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 browsing the Monastery: (5)
As of 2015-09-02 02:48 GMT
Find Nodes?
    Voting Booth?

    My preferred temperature scale is:

    Results (60 votes), past polls