Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
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
Finding the parent of a text in a file
No replies — Read more | Post response
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
1 direct reply — 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
4 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...
Examine two files to delete duplicates
3 direct replies — Read more / Contribute
by Coop197823
on Sep 03, 2015 at 12:33
    I found this bit of code that parse the first column of two text files checks the first column of the first file and then examines the second file to find and remove duplicates. as I am brand new to Perl my question is this: How to I update the code to specify which is the first file to be examined and which is the second file to have duplicates removed? Thank you in advance for the help!
    #!/usr/bin/perl # create names lookup table from first file my %names; while (<>) { (my $col1)= split / /, $_; $names{$col1} = 1; last if eof; } # scan second file while (<>) { print if /^(\S+).*/ && not $names{$1}; }
Perl Tk - getopenFile failure
2 direct replies — Read more / Contribute
by merrymonk
on Sep 03, 2015 at 11:11
    getopenFile (in Perl Tk) has being failing more often in the last few days and has now stopped altogether.
    In the Perl below I:
    1. can see the GUI
    2. can use the button and it appears to go in and out
    3. can see the content of the print statement
    but then nothing happens and all I can see is a small 'waiting' circle which seems to rotate.
    I replaced my version of Perl by one from another laptop where the test perl works. Sadly it still failed.
    The troublesome laptop is using Windows 8.1, the 'good' laptop is using Windows 7 Home Premium.
    I do not know if it related but also I cannot save documents in either Word or Excel.
    Any clues as to what is wrong and it can be cured would be much appreciated!
    use strict "vars"; use Tk; my ($mw); sub org_select { my $filetypes = [ ['Drawing Files', '.drg'], ['All files', '*'] ]; print "\nbefore getOpenFile\n"; my $select_file_full = $mw->getOpenFile( -filetypes => $filetypes); } $mw = MainWindow->new; $mw->Button(-text => 'Select File', -command => \&org_select )->pack; MainLoop;
capturing output of system call inside a thread
4 direct replies — Read more / Contribute
by that_guy
on Sep 03, 2015 at 10:38

    Hello Monks. I've been working on a multithreaded script and have trouble figuring out loggin/printing portion of it.

    Each of the worker threads is essentially independent and can run perl code as well as do system() calls. I was originally using Capture::Tiny module and it worked fine enough except when system calls are involved. Whenever system calls come into play, all output gets jumbled up and mixed up.

    Can this logging approach be done? If not is there another way? If this cannot be done with threads, can this kind of parallel processing/logging be done somehow differently?

    Main script

    #!/usr/local/bin/perl use strict; use warnings; use threads; use Capture::Tiny qw/capture_merged/; use IO::File; use IPC::Run qw/run/; use autodie qw/open close/; use FindBin qw/$RealBin/; my $thread1 = threads->create ( \&worker, 1, 'sub1.log' ); my $thread2 = threads->create ( \&worker, 2, 'sub2.log' ); my $need_to_continue = 1; while ($need_to_continue) { print "MAIN THREAD IS PRINTING\n"; if ( $thread1->is_running() || $thread2->is_running() ) { sleep 3; } else { $need_to_continue = 0; } } $thread1->join(); $thread2->join(); exit 0; ################ sub worker { my $num = shift; my $log_file = shift; open ( my $LFH, '>', $log_file ); capture_merged { inner_worker ( $num ); } stdout=>$LFH,stderr=>$LFH; close $LFH; }; sub inner_worker { my $num = shift; print STDOUT "INFO> Some info from sub $num\n"; print STDERR "WARN> Some warn from sub $num\n"; system ("$RealBin/test_err.pl"); print STDERR "INFO> Some info from sub $num\n"; print STDERR "WARN> Some warn from sub $num\n"; };

    test_err.pl (simulating random program) called using system

    #!/usr/local/bin/perl print "non-error\n"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; print "non-error\n"; print "non-error\n"; print "non-error\n"; sleep(1); print "non-error\n"; print "non-error\n"; print "non-error\n"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; sleep(1); warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; print "non-error\n"; print "non-error\n"; print "non-error\n"; print "non-error\n"; print "non-error\n"; print "non-error\n"; print "non-error\n"; sleep(1); print "non-error\n"; print "non-error\n"; print "non-error\n"; warn "-E- test error"; warn "-E- test error"; warn "-E- test error"; print "non-error\n"; print "non-error\n"; print "non-error\n"; print "non-error\n"; print "non-error\n"; print "non-error\n"; sleep(1); print "non-error\n"; sleep(1);

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 imbibing at the Monastery: (11)
    As of 2015-09-04 12:04 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My preferred temperature scale is:










      Results (135 votes), past polls