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
Disabling runtime warnings in dynamic scope?
1 direct reply — Read more / Contribute
by LanX
on Apr 25, 2018 at 18:26
    On request of a colleague I was playing around with an own implementation of switch as replacement for given/when

    Surprisingly, I can use next within a sub to be able to fall thru to the next case, which leads to a nice syntax.

    use strict; use warnings; use diagnostics; sub switch { no warnings 'exiting'; while (@_) { my ($case, $action) = splice @_,0,2; return $action->($case) if $_ ~~ $case; } } #no warnings 'exiting'; switch [1,2,3] => sub { print "bla" ; next}, 3 => sub { print "bla2" } for (3);

    But I'm getting

    Exiting subroutine via next at d:/Users/RolfLangsdorf/pm/switch.pl lin +e 18 (#1) (W exiting) You are exiting a subroutine by unconventional means, +such as a goto, or a loop control statement.

    Obviously I can't dynamically disable the warning, because it's lexically scoped.

    Uncommenting the #no warnings 'exiting' works, but would be acting for a much wider scope.

    Question:

    Is it possible to disable a certain warning in the dynamic scope?

    Overwriting the warn handler does the trick ...

    local $SIG{__WARN__} = sub { warn "$_[0]" unless $_[0] =~ /^Exiting subroutine via next/ } ;

    ... , but maybe there is a cleaner solution?

    NB: this is experimental code and not meant for production! :)

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Wikisyntax for the Monastery

XS/C, threads, and calling call_sv() with a code ref
2 direct replies — Read more / Contribute
by stevieb
on Apr 25, 2018 at 15:16

    Hello fellow Monks,

    I am experiencing an issue with some C/XS I'm trying to get working. I will explain what I'm trying to do, how I perceive what the code is actually doing and a bit about what's happening. I'll then show the Inline::C code, the output, some gdb debugging output. Unfortunately, unless you have a Raspberry Pi, there's no way you can repro this successfully.

    What I'm trying to do:

    I have an interrupt routine for a GPIO pin on the Pi. This interrupt routine (ISR) is spun off into a separate C++ thread, and to facilitate the ability for the user to use a Perl subroutine as the callback/interrupt handler, I'm trying to pass in a code reference, and have the C/XS execute that sent-in-as-a-param code ref.

    What is the code doing?:

    I set up a function in main called cref_handler(). I then initialize the RPi, configure the appropriate GPIO pin, then set the interrupt on that pin, passing in a reference to the mentioned cref_handler() routine. The interrupt handler (the code the coderef points to) is to run any time the specified pin goes LOW (ie. 0 volts). Both the interrupt setup and the actual interrupt handler that executes the code in the coderef is written in C and passed along to an external library that dumps the ISR into its own thread.

    What the hell is happening?:

    The callback code simply prints to STDOUT. Once the script is run, I may get a few printouts when shorting (ie. turning LOW the pin), sometimes I don't. In all cases, it eventually leads to a SEGFAULT. Sometimes after a microsecond, sometimes after a second or two.

    I'm not an expert C coder by any stretch, so I believe what may be happening is that the threaded interrupt code isn't handling the global C variables I've set up, or perhaps it's the way I'm using some of Perl's internals wrong (eg: PerlInterpreter, PERL_SET_CONTEXT etc), or the way the interruptHandlerCref() XS code is laid out.

    Summary:

    I'd greatly appreciate it if those experienced in these XS/C matters could have a look and see what I'm doing wrong here, if its possible without having to actually run the code (I truly apologize for that inability). I'm thinking it's my inexperience with C, or misunderstanding how the whole background threads thing is handled here.

    Code:

    use warnings; use strict; use RPi::Const qw(:all); use Inline ('C' => 'DATA' => libs => '-lwiringPi -lrt -lwiringPiDev -l +pthread'); my $continue = 1; $SIG{INT} = sub { $continue = 0; }; sub cref_handler { print "cref handler\n"; } my $cref = \&cref_handler; init(); pin_mode(3, INPUT); setInterruptCref(3, EDGE_FALLING, $cref); my $running; while ($continue){ print "running\n" if ! $running; $running = 1; } __DATA__ __C__ #include <wiringPi.h> #include <stdio.h> void init (){ wiringPiSetupGpio(); } PerlInterpreter* mine; SV* perl_callback_cref; void interruptHandlerCref(){ PERL_SET_CONTEXT(mine); dSP; ENTER; SAVETMPS; PUSHMARK(SP); PUTBACK; call_sv(perl_callback_cref, G_DISCARD|G_NOARGS); FREETMPS; LEAVE; } int setInterruptCref(int pin, int edge, SV* callback){ mine = Perl_get_context(); perl_callback_cref = callback; int interrupt = wiringPiISR(pin, edge, &interruptHandlerCref); return interrupt; } void pin_mode (int pin, int mode){ pinMode(pin, mode); }

    Output:

    running cref handler cref handler cref handler running dler running dler Segmentation fault

    I am perplexed as to how the running line is printed numerous times, given that it should only print once, at the onset after everything else is done. This is what leads me to believe something is going very wacky with the threading somehow...

    Debug output (snipped for brevity):

    $ gdb perl GNU gdb (Raspbian 7.12-6) 7.12.0.20161007-git (gdb) r int.pl [New Thread 0x76af7470 (LWP 26138)] running cref handler Thread 1 "perl" received signal SIGSEGV, Segmentation fault. 0x000c09ec in Perl_pp_and () (gdb) bt #0 0x000c09ec in Perl_pp_and () #1 0x000c0434 in Perl_runops_standard () #2 0x000500a4 in perl_run () #3 0x0002ab50 in main ()

    The backtraces are consistently different, fwiw, but mostly they are relatively similar. I can repro several times if necessary if it'll help.

    Cheers,

    -stevieb

Trying to send a nicely formatted email -> GMail
2 direct replies — Read more / Contribute
by chexmix
on Apr 25, 2018 at 11:21
    Hi Monks,

    I'm working on a project where I'm going to need to send a decently-formatted table of things via email -- GMail, unfortunately, which I've found needs special lines for encoding the thing to "quoted-printable" to not destroy the nice formatting I've set up in the script.

    The REAL script will get its data from a database, but I've put the following dummy script together to play with the modules I assume are necessary to get the email sent and look nice.

    ... and it's not working. I get blank emails with subject lines like "ARRAY(0x2730298)". I have futzed and futzed with the script-let below ... maybe a monk smarter than me (most of you) can tell me what I'm doing wrong.

    #!/usr/bin/env perl use IO::All; use Email::MIME; use Email::Sender::Simple qw(sendmail); unlink 'mailtext.txt'; ################################################## # just an experiment with perlform to try and make # a nice output for the dashboard # ################################################ # set some vars so we can have stuff to print # what are we likely gonna wanna print? my $tweet_id = 0; my $tweet_cat = ''; # this is tweet category my $tweet_obj = ''; # this is tweet object: obsid? bibcode? my $tweet_obj_2 = ''; # secondary id - for instance, seq_nbr my $tweet_date = ''; my $tweet_weight = 0; open (MAILTEXT, '>>', 'mailtext.txt'); print(MAILTEXT "Content-Type: text/plain; charset=UTF-8\Content-Transf +er-Encoding: quoted-printable\n"); format TWIT = @<<<<<< @<<<<< @<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<< @<< +<<<<<<<< ^<<<<<<<<< $tweet_id, $tweet_cat, $tweet_obj, $tweet_obj_2, $tweet_date, $tweet_w +eight ---------------------------------------------------------------------- +------------------------ . format TWIT_TOP = ====================================================================== +======================== twit_id twit_cat twit_obj twit_obj_2 dat +e_active twit_weight ====================================================================== +======================== . select(MAILTEXT); $~ = TWIT; $^ = TWIT_TOP; my @id = (50, 51, 52, 53, 54); my @cat = ("BIB", "BIB", "DAT", "PLE", "UNP"); my @obj = ("2014HEAD...1411609Z", "2016SPIE.9905E..45G","20201", "2 +018ApJ...855..100S", "19288"); my @obj_2 = (254, 29, 'X-ray Clusters', 5.1, 502938); my @date = ("02/02/18","03/23/18","03/22/18","03/13/18","03/05/18"); my @weight = (2, 5, 4, 3, 1); my $i = 0; foreach (@id) { $tweet_id = $_; $tweet_cat = $cat[$i]; $tweet_obj = $obj[$i]; $tweet_obj_2 = $obj_2[$i]; $tweet_date = $date[$i]; $tweet_weight = $weight[$i++]; write; } my @parts = ( Email::MIME->create( attributes => { filename => "mailtext.txt", content_type => "text/plain", encoding => "quoted-printable", name => "CDA Twitter Dashboard", }, body => io( "mailtext.txt")->utf8->all, ), ); my $email = Email::MIME->create( header_str => [ From => [ "cdatwitter\@grumble.edu" ], To => [ "gbecker\@grumble.edu" ], Subject => [ "Yes this is for Twitter" ], ], parts => [ @parts ], ); sendmail($email);

    I'm sure the script sucks in many ways, but it's the emailing I'm concerned about here. Any nudges would be most appreciated.

    Thanks,

    Glenn

is Plack really necessary?
2 direct replies — Read more / Contribute
by Anonymous Monk
on Apr 25, 2018 at 10:10
    In a ngnix ,Starman,dancer set-up,where does Plack fit in? is it necessary for nginx to Starman communication? can you have a straight ngnix to dancer connection without Plack or Starman?
This is a useless node
5 direct replies — Read more / Contribute
by shagbark
on Apr 24, 2018 at 22:37

    I asked a question, then realized that there was no point in asking what I was asking.

    So I have deleted it.

    Perlmonks.org does not allow deletion of nodes, so here we are.

(Solved) Search::Elasticsearch date range
2 direct replies — Read more / Contribute
by bfdi533
on Apr 24, 2018 at 18:04

    I have a query I need to run against ElasticSearch and am using Search::Elasticsearch module. The issue is getting the data range correctly in the query on the PERL side as I can make this work from curl without any issues. After much tinkering with format, the following no longer throws errors when executing the code but the date range does not change the number of results returned no matter what I set the date to. This leads me to believe that there is something wrong with the code.

    For what it is worth, I have noticed that if I change the 'gte' to a 'lte' then I get a count of -1 showing no results are being returned. So, something is "working" if I do that ...

    Any hints, changes or suggestions would be much appreciated!

    #!/usr/bin/env perl # global settings use warnings; use strict; $|++; # libraries use Data::Dumper; use Search::Elasticsearch; use Try::Tiny; # global variables my $elk_host1 = '10.0.10.61:9200'; my $elk_host2 = '10.0.10.51:9200'; my $elk_host3 = '10.0.10.52:9200'; my $elk_host4 = '10.0.10.53:9200'; my $elk_user = 'user'; my $elk_pass = 'pass'; my $dt = `date +%F_%T`; chomp $dt; my $latest_dt; print "Starting run at: ".`date`; my $e = Search::Elasticsearch->new( nodes => [ "http://$elk_user:$elk_pass\@$elk_host1" , "http://$elk_user:$elk_pass\@$elk_host2" , "http://$elk_user:$elk_pass\@$elk_host3" , "http://$elk_user:$elk_pass\@$elk_host4" , ] , max_requests => 10000, ); my $results = $e->search ( size => 10000, index => 'api-*', body => { query => { bool => { must => { term => { '_type' => "alarm", }, }, filter => { range => { '@timestamp' => { gte => "2018-04-23 00:00:00", format => "YYYY-MM-DD HH:mm:ss" } } } } } } ); print "Count: ".$#{ $results->{hits}->{hits} }."\n";
Tk main window protocole maximize
3 direct replies — Read more / Contribute
by Anonymous Monk
on Apr 24, 2018 at 14:47

    Is there a protocol to catch when the user maximize the main window? I use the following to catch when the user closes the application, but I can't find any counterpart to catch the maximization (or minimization) of the main window:

    $mw->protocol('WM_DELETE_WINDOW', \&CloseApp);

    Thank you in advance for any suggestion.

Create JSON file in specific format
3 direct replies — Read more / Contribute
by ovedpo15
on Apr 24, 2018 at 11:23
    Hi, I'm a beginner in Perl.
    I would like to use the JSON module in order to create one. In other words, I'm trying to build a function which creates a JSON file:

    Consider the following structure of a JSON file:

    { "time": 123456 "id": 56789 "data": [{"key": "first" , "value": "1" , "format": "1.5.6" , "ver +sion": "5.4"}, {"key": "two" , "value": "2" , "format": "1.4.6" , "versi +on": "5.4}, {"key": "five" , "value": "5" , "format": "1.5.9" , "vers +ion": "5.1"}] }
    This is the structure I would like the JSON file to be. Also, consider that the data is in a file that each one if its lines look like this:
    first,1,1.5.6,5.4 two,2,1.4.6,5.4 five,5,1.5.9,5.1

    So the array of objection that JSON file should contain is represented as each line of the previous file. I know how to split each line and push into a hash. So I would like to ask the two following questions:

    1. Is there a better way to than splitting and pushing into a hash?
    2. Main question: After I get a hash, how can I convert it to be of JSON file type while not forgetting to add the primitive values of "time" & "id"?
    I saw some examples of how to convert JSON to hash in Perl but didn't find an example of how to use the other way.

    Thank you and have a great day.
How to remove HTTP Keep-Alive 300 header from LWP::UserAgent request
1 direct reply — Read more / Contribute
by Veltro
on Apr 24, 2018 at 09:23
    Hello, I'd like to remove the Keep-Alive 300 header from the request but I can't figure out how.

    I am instantiating the LWP::UserAgent with the intention to use HTTP 1.1 and keeping the connection alive as follows:

    my $ua = LWP::UserAgent->new(keep_alive => 1, send_te => 0) ;

    send_te => 0 removes the TE header and the header information that I want to send contains tags like:
    my @ns_headers = ( 'ACCEPT' => '..', 'ACCEPT_ENCODING' => '...', 'ACCEPT-LANGUAGE => '..', 'UPGRADE_INSECURE_REQUESTS' => '1', 'USER-AGENT' => '...', ) ;
    I have tried several methods creating the request but each and one of them sends the Keep-Alive 300 header.

    my $response = $ua->get( $link, @ns_headers ) ;

    my $response = $ua->request(GET $link) ; # This does not use @ns_headers
    my $getReq = HTTP::Request->new( GET => $link, HTTP::Headers->new( @ns +_headers ) ) ; my $response = $ua->request( $getReq ) ;
    Tryig to get rid of it by specifying this in the @ns_headers does not work:

    'KEEP-ALIVE' => undef,

    Anyone knows how to do this? Thanks
TK param passing
2 direct replies — Read more / Contribute
by jsteng
on Apr 23, 2018 at 21:42
    I would see codes written like this:
    $submit->bind('<1>' => sub { Submit($p1, $p2, $p3, $p4, $p5); } );
    The above codes I understand, knowing how many parameters and how to intercept the params in a subroutine.



    However I dont understand this code:
    $yscroll=$mw->Scrollbar()->pack(-fill=>'y', -side=>'right',); $yscroll->configure( -command => [ \&ScrollAll, $yscroll, [$p1, $p2, $ +p3, $p4, $p5]]); sub ScrollAll { my ($sb, $wigs, @args) = @_; foreach my $w (@$wigs) { $w->yview(@args); } }


    Can anyone explain how the params are passed when it is constructed in this manner:
    -command => [ \&ScrollAll, $yscroll, [$p1, $p2, $p3, $p4, $p5]]
    In the above sub's code my ($sb, $wigs, @args) = @_;
    What is assigned to $sb?
    What is assigned to $wigs?
    Is there any other way of passing params when used with -command?
    And can that like be written like:
    -command => sub { subname ($p1, $p2, $p3, $p4, $p5); }
    thanks

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!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • 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 all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others pondering the Monastery: (2)
    As of 2018-04-26 06:00 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Notices?