Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Seekers of Perl Wisdom

( #479=superdoc: print w/ replies, xml ) Need Help??

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
Help De-bugging
4 direct replies — Read more / Contribute
by GeneGeek
on Sep 04, 2015 at 16:16

    Hi! I'm using a script that is not my own and I've run into a bug that is beyond my de-bugging capabilities. Here is a trucated example of a data entry in my data file, notice how there is no 'Sample'

    HAC10188 Name HAC1018 Extension .fsa Dye Green1 Allele Count 298 Size 100 100.5 101 102.1 102.6 103.3 104.1 NChar 297 Allele 0$0 0$0 1$1503 0$0 0$0 0$0

    The script I'm using to analyze this data is giving me the following error:

    Use of uninitialized value $nchar in subtraction (-) at AFLP_replicate_difference_v1.1.pl line 192.

    Here's the bit of code in the script that is giving me trouble, line 192 is the last line:

    my $tax_sample = $data->{$taxon_label}{'Samples'}{$dye}; my $rep_sample = $data->{$rep_label} {'Samples'}{$dye}; my $nchar = ${$tax_sample->{'NChar'}}[0]; # I don't set these row sum variables to zero, because I w +ant them undefined ifthe row is empty. my ($row_sum, $row_sum_abs, $row_sum_sq); my ($cnt00, $cnt01, $cnt10, $cnt11) = (0) x 4; my ($first_site, $last_site) = $use_filtered ? @{$threshol +ds->{$dye}{'indices'}} : (0, $nchar-1);

    $tax_sample and $rep_sample aren't initialized because 'Samples' doesn't exist. I think its the result of an error in the script (authored by the same person that authored the script I'm using here) I used to generate my data file. Its leaving the word 'Samples' out somewhere. I'm just not sure where because I'm not entirely sure what

    my $rep_sample = $data->{$rep_label}  {'Samples'}{$dye};

    is doing. Where should the text 'Samples' be in my data file for this to work?

    I'll post the entire script below if anyone needs that

    This is the subroutine readGTR() from the genotyping_utilities.pm script

appending values based on criteria
5 direct replies — Read more / Contribute
by logeshwaran
on Sep 04, 2015 at 08:36

    Input:
    id|Name|app1|app2
    1|abc|234|231|
    2|xyz|123|215|
    1|abc|265|321|
    3|asd|213|235|

    In the above input if id gets repeated I am appending app1,app2 . And printing it once . My expected output as follows,
    Output:
    id|Name|app1|app2
    1|abc|234,265|231,321|
    2|xyz|123|215|
    3|asd|213|235|

    My Code: #! usr/bin/perl use strict; use warnings; my $basedir = 'E:\Perl\Input\\'; my $file ='doctor.txt'; my $counter = 0; my %RepeatNumber; my $pos=0; open(OUTFILE, '>', 'E:\Perl\Output\DoctorOpFile.csv') || die $!; open(FH, '<', join('', $basedir, $file)) || die $!; my $line = readline(FH); unless ($counter) { chomp $line; print OUTFILE $line; print OUTFILE "\n"; } while ($line = readline(FH)) { chomp $line; my @obj = split('\|',$line); if($RepeatNumber{$obj[0]}++) { my $str1= join("|",$obj[0]); my $str2=join(",",$obj[2],$obj[3]); print OUTFILE join("|",$str1,$str2); print OUTFILE "\n"; } }
Inline::C self-referential struct idioms and memory
2 direct replies — Read more / Contribute
by rutgeraldo
on Sep 04, 2015 at 07:44

    Dear monks,

    I am trying to construct self-referential objects (tree/DAG nodes) using Inline::C. These are the requirements:

    • Every node will have fields for its (zero or one) parent and its (zero or more) children.
    • There will be a typemap so that a node struct type will be the invocant of the methods - i.e. the first argument of the C functions - without having to do the same casting boilerplate in C function bodies every time.
    • Any child nodes, once assigned to a parent, have their refcount incremented, and decremented when the parent goes away. So there needs to be a way to get at the SV* from the struct to fiddle with SvREFCNT*.
    • The parent node, once assigned to a child, does NOT have its refcount incremented. I.e., once a parent goes out of scope, all its descendants (recursively) will also be cleaned up. The idea being that we don't create apparent cycles from perl's perspective.
    • I am very much hoping that the typemap can be reasonably efficient and doesn't necessarily require making new SV*'s and blessing them at every conversion.
    I am hampered by the following challenges:
    • I am an (Inline::)C beginner and am probably operating under bad/incomplete assumptions about memory allocation, struct initialization, and memory cleanup.
    • I am a bit intimidated by all the magic that is applied by typemaps and how they might affect refcounts and struct mortality.
    • I don't fully understand when or why to fiddle with the stack inside XS/Inline::C. Symptom if this is that I've been having "bizarre copy" bugs that I don't quite understand. (These don't occur in the short example below - just pointing out that I really don't know what I'm doing in general.)
    Nonetheless, playing around with the Inline::C cookbook and the results of various google searches is getting me started with just enough knowledge to be dangerous. Below is the simplest case I came up with just for child->parent relationships:

Finding the parent of a text in a file
4 direct replies — Read more / Contribute
by ExperimentsWithPerl
on Sep 04, 2015 at 06:04
    Hello Perl Monks,
    I am utterly new to perl(Just a week old).I am trying to write a program which would compare two configs file and print the difference (wherever found) and also indicating the parents of the differing text.For ex,if my file is
        system
             security
                 management-ip
                     protocol
                            internal
                            shutdown
                            allow
                            entry 1
                                snmp ok
                            exit



    Now suppose the files are differening at "snmp ok"
    so I want the code to print

        system
             security
                 management-ip
                     protocol
                            entry 1
                                snmp ok
    and not the in between ( internal shutdown allow ) as all these 3 have the same parent as entry 1.
    Please help.
HTML5, SSE, flush output '$| = 1' not working as expected
2 direct replies — Read more / Contribute
by ehaase
on Sep 04, 2015 at 03:29
    Serverside script
    #!/usr/bin/perl -w use strict; use CGI; my @tickets = ( [ "GOOG", 533.37 ], [ "MSFT", 47.59 ], [ "IBM", + 162.99 ], [ "AAPL", 114.12 ], [ "MSFT", 47.29 ], [ "GOOG" +, 533.95 ], [ "IBM", 163.78 ], [ "GOOG", 533.55 ], [ "AAPL" +, 113.67 ] ); my $ticketsLength = scalar ( @tickets ); my $lastId = 0; my $q = new CGI ; local $| = 1; print "Content-Type: text/event-stream\n"; print "Cache-Control: no-cache\n"; print "Connection: keep-alive\n\n"; while (1) { sendMessage($lastId, $tickets[$lastId][0], $tickets[$lastId][1]); $lastId++; die() if ($lastId >= $ticketsLength); # Check that lastId is not l +arger than the size of array - if it is larger close connection. sleep(1); } # Function to send data in format "ticket:price". sub sendMessage { my $id = shift(); my $ticket = shift(); my $price = shift(); print "id: $id\n"; print "data: $ticket:$price\n\n"; }
    Browser request
    <!doctype html> <html> <head> <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" +/> <title>Server Sent Events Perl Example - Stock Tickets</title> <script type="text/javascript"> window.onload = function setDataSource() { if (!!window.EventSource) { var source = new EventSource("stocks.htm"); source.addEventListener("message", function(e) { updatePrice(e.data); logMessage(e); }, false); source.addEventListener("open", function(e) { logMessage("OPENED"); }, false); source.addEventListener("error", function(e) { logMessage("ERROR"); if (e.readyState == EventSource.CLOSED) { logMessage("CLOSED"); } }, false); } else { document.getElementById("notSupported").style.display = "b +lock"; } } function updatePrice(data) { var ar = data.split(":"); var ticket = ar[0]; var price = ar[1]; var el = document.getElementById("t_" + ticket); var oldPrice = el.innerHTML; el.innerHTML = price; if (parseFloat(oldPrice) < parseFloat(price)) { el.style.backgroundColor = "lightgreen"; } else { el.style.backgroundColor = "tomato"; } window.setTimeout(function clearBackground() { el.style.backgroundColor = "white"; }, 500); } function logMessage(obj) { var el = document.getElementById("log"); if (typeof obj === "string") { el.innerHTML += obj + "<br>"; } else { el.innerHTML += obj.lastEventId + " - " + obj.data + "<br> +"; } el.scrollTop += 20; } </script> </head> <body> <h1>Server Sent Events Perl Example</h1> <p class="hint"> This is simple Server Sent Events (SSE) example that updates stock + prices when market moves. Data source is predefined array with prices and an update every se +cond. This script is adapted from http://demo.howopensource.com/sse/ </p> <h2>Tickets</h2> <div id="tickets"> <div class="ticket"><div class="name">IBM</div><div class="price" +id="t_IBM">161.57</div></div> <div class="ticket"><div class="name">AAPL</div><div class="price" + id="t_AAPL">114.45</div></div> <div class="ticket"><div class="name">GOOG</div><div class="price" + id="t_GOOG">532.94</div></div> <div class="ticket"><div class="name">MSFT</div><div class="price" + id="t_MSFT">47.12</div></div> </div> <h2>Simple Log Console</h2> <p class="hint"> This is simple log console. It is useful for testing purposes and +to understand better how SSE works. Event id and data are logged for each event. </p> <div id="log"> </div> </body> </html>

    It should update a ticker price every second but all events are updated at the end of the script (it works in general, but flush does not work this way). This is an adaption of a working php-version at http://demo.howopensource.com/sse/

    Environment is a Linux V-Server 2.6.32-042stab092.3 with Apache2.

    The php-Version does work as expected on the this environment.

Translation selection advise
6 direct replies — Read more / Contribute
by johnfl68
on Sep 03, 2015 at 22:30

    Hello, looking for advise. I have some stock phrases that need to show up in different languages. Looking for the best means to do this.

    Language is set with a variable, and then that is used to select which phrase to use at different places to display. There are only about 20 or so phrases that I need, but I keep adding additional languages.

    I started out doing it this way (striped down a bit, but you should get the idea):

    my $language = "fr"; # ar, bs, de, en, es, fr, it, nl, pl, pt, ru, sk, sv, tet, tr, + uk, zh if ( $language eq "en" ) { $windTranslation = "Wind:"; $humidityTranslation = "Humidity:"; } if ( $language eq "de" ) { $windTranslation = "Wind:"; $humidityTranslation = "Feuchtigkeit:"; } if ( $language eq "es" ) { $windTranslation = "Viento:"; $humidityTranslation = "Humedad:"; } if ( $language eq "fr" ) { $windTranslation = "Vent:"; $humidityTranslation = "Humidité:"; } if ( $language eq "nl" ) { $windTranslation = "Wind:"; $humidityTranslation = "Vochtigheid:"; }

    But maybe it would be better to do it like this, as each phrase set would be together and cleaner code:

    my $language = "de"; # ar, bs, de, en, es, fr, it, nl, pl, pt, ru, sk, sv, tet, tr, + uk, zh my %windTranslation = ( 'en' => "Wind:", 'de' => "Wind:", 'es' => "Viento:", 'fr' => "Vent:", 'nl' => "Wind:", ); my %humidityTranslation = ( 'en' => "Humidity:", 'de' => "Feuchtigkeit:", 'es' => "Humedad:", 'fr' => "Humidité:", 'nl' => "Vochtigheid:", ); my $windPhrase = $windTranslation{$language}; my $humidityPhrase = $humidityTranslation{$language};

    Or is there maybe a better way, that I am not thinking of?

    Please let me know your thoughts?

    Thanks!

    John

Makefile.PL Question
3 direct replies — Read more / Contribute
by baxy77bax
on Sep 03, 2015 at 18:29
    hi

    I was wondering how to change the location where my moduls are when installing them. so far i had my source tree structured like this:

    Project -+ |- lib -+ | | -Modul.pm |- t -+ | |- test |-Makefile.PL
    now what I would like is to change the source tree to
    Project -+ |-src-+ | |- lib -+ | | | -Modul.pm | |- apps -+ | |- test |-Makefile.PL
    How to specify this change in my Makefile.pl file. because if i leave it as is no installation is possible.

    baxy

How to pass filepath as a parameter to URL using perl (SOLVED)
3 direct replies — Read more / Contribute
by ash1351
on Sep 03, 2015 at 17:53
    My below query was solved. please refer stackoverflow
    http://stackoverflow.com/questions/32385729/how-to-pass-filepath-as-a-parameter-to-url-using-perl
    I am testing my perl code. I want to pass filepath as a paramter to the URL of the page. The perl code is dependent on this filepath entirely. When i set the filepath inside my perl code. (hard coded path), i am able to execute the perl code without any errors. Here is the variable     my $filename="\\\\sfoaepmdata.dcc.com\\folder\\data.txt";
    If i pass it via URL, it doesnt work as expected. Can anyone suggest how to pass filepath as a variable in the URL ? Here is what all i tried to someohow transfer $filename from url to perl code.
    http://apmqa.dcc.com/cgi-bin/test/editor.pl?filename=\\\\sfoaepmd +ata.dcc.com\\folder\\data.txt http://apmqa.dcc.com/cgi-bin/test/editor.pl?filename=\\sfoaepmdata +.dcc.com\folder\data.txt http://apmqa.dcc.com/cgi-bin/test/editor.pl?filename=//sfoaepmdata +.dcc.com/folder/data.txt http://apmqa.dcc.com/cgi-bin/test/editor.pl?filename=////sfoaepmda +ta.dcc.com//folder//data.txt http://apmqa.dcc.com/cgi-bin/test/editor.pl?filename=file://sfoaep +mdata.dcc.com/folder/data.txt http://apmqa.dcc.com/cgi-bin/test/editor.pl?filename=file:////sfoa +epmdata.dcc.com//folder//data.txt http://apmqa.dcc.com/cgi-bin/test/editor.pl?filename=http:////sfoa +epmdata.dcc.com//folder//data.txt http://apmqa.dcc.com/cgi-bin/test/editor.pl?filename=http://sfoaep +mdata.dcc.com/folder/data.txt
    The above data may seem confusing. But please only read values after ?filename. Can anyone pls suggest. I also tried passing other normal paramters and it worked. for e.g. $account=GEL; the filepath doesnt work.
    http://apmqa.dcc.com/cgi-bin/test/editor.pl?account=GEL
Trouble with Chinese characters
2 direct replies — Read more / Contribute
by dweston
on Sep 03, 2015 at 17:31

    Final edit: After reading the replies I've come to the conclusion that this was the wrong place to go to. I've had more replies about the politics and manners of the monks than an actual discussion about code. If someone responds to this with an explanation or a solution then I hope that this thread will come up in a google search for any beginners that have the same problem I do and serve as a warning. Hello, I've been trying to pass a Chinese character to a JSON hash but it always comes out as "女"

    #!/usr/bin/perl use JSON; #variable declaration my $gender = "Female" #turning english selection to Chinese character if ($gender eq 'Female') { $gender = "&#22899;"; } elsif ($gender eq 'Male') { $gender = "&#30007;"; } elsif ($gender eq 'Decline to state') { $gender = ""; } my $hash_ref = {}; $hash_ref->{'detail_sex'} = $gender; print JSON->new->utf8(1)->pretty(1)->encode($hash_ref);<\code> <p>This is the result I get: { "detail_sex" : "女" } However, when I test another script it comes out perfectly.</p> <code>#!/usr/bin/perl use Digest::MD5 qw(md5 md5_hex md5_base64); use Encode qw(encode_utf8); use JSON; my $userid = 1616589; my $time = 2015811; my $ejob_id = 1908063; # md5 encryption without chinese characters my $md5_hex_sign = md5_hex($userid,$time,$job_id); print "$md5_hex_sign\n"; # seeing if character will print print "let's try encoding and decrypting \n"; print "the character to encrypt.\n"; print "&#22899;\n"; print "unicode print out\n"; print "\x{5973}\n"; my $char = "\x{5973}"; my $sign_char = "&#22899;"; print "unicode stored in \$char variable \n"; print $char, "\n"; print "md5 encryption of said chinese character from \$char with utf8 +encoding\n"; print md5_hex(encode_utf8($char)), "\n"; print "md5 encryption of wide character with utf8 encoding\n"; print md5_hex(encode_utf8("&#22899;")), "\n"; my $sign_gender = md5_hex(encode_utf8($sign_char)); #JSON print "JSON print out\n"; my $hash_ref = {}; $hash_ref->{'gender'} = $char; $hash_ref->{'md5_gender'} = md5_hex(encode_utf8($char)); $hash_ref->{'char_gender'} = md5_hex(encode_utf8("&#22899;")); $hash_ref->{'sign_gender'} = $sign_gender; print JSON->new->utf8(1)->pretty(1)->encode($hash_ref);

    Here is the result: 160a6f4bf9aec1c2d102330716ca8f4e let's try encoding and decrypting the character to encrypt. 女 unicode print out Wide character in print at md5check.pl line 18. 女 unicode stored in $char variable Wide character in print at md5check.pl line 22. 女 md5 encryption of said chinese character from $char with utf8 encoding 87c835a6b1749374a7524a596087b296 md5 encryption of wide character with utf8 encoding 06c82a10da7e297180d696ed92f524c1 JSON print out { "char_gender" : "06c82a10da7e297180d696ed92f524c1", "md5_gender" : "87c835a6b1749374a7524a596087b296", "sign_gender" : "06c82a10da7e297180d696ed92f524c1", "gender" : "女" } Would someone kindly explain to me what is going on?

How to simply terminate all running threads?
2 direct replies — Read more / Contribute
by Anonymous Monk
on Sep 03, 2015 at 15:38
    I have a script that runs a test on a list of test_objects. These tests all run concurrently using threads. Should a test fail at anytime, I would like to stop all other running threads and safely exit out of the program.
    sub test1252 { my @jobs = (); foreach my $test_obj (@objects) { push @jobs, async { my $rc = test($test_obj); if ($rc ne 0) { print "Test Failed for $test_obj\n"; local $SIG{'KILL'} = sub {threads->exit();}; $_->kill('KILL')->join() for @jobs; exit $code_blue; } }; } $_->join for @jobs; }
    I get something like this using 'kill' with the handler
    Perl exited with active threads: 9 running and unjoined 0 finished and unjoined 0 running and detached
    It doesn't appear that all the threads have died upon program exit, so I'm sure I'm not doing something right...

Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • 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 contemplating the Monastery: (4)
    As of 2015-09-05 11:54 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My preferred temperature scale is:










      Results (152 votes), past polls