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
plack: close filehandle responsibility
1 direct reply — Read more / Contribute
by basiliscos
on May 05, 2015 at 13:21

    Hello dear monks!

    I'm using Kelp, which is very Plack-centered framework.

    I have the following code for rendering icons:

    use Path::Tiny; ... my $image = path($self->config('storage'), $domain_id, "icon-${size}.i +co"); ... return $self->res->set_content_type('image/x-icon') ->render_binary($image->filehandle('<', ':raw'));

    After some time of execution under plackup I got the following error:

    Error open (<:raw) on \'storage/3/icon-256.ico\': Too many open files at ...

    Why so? I looked at Kelp::Request sources, and it just transfers the filehandle for Plack. Why Plack does not closes it after rendering the requests?

    Yes, I know that I could do something like:

    return $self->res->set_content_type('image/x-icon') ->render_binary($image->slurp);

    but this is counter-effective a little bit? sendfile(2) cannot be used by server, and why at all I should load the whole image into perl, while actually i don't need it?

    WBR, basiliscos.
exiting a subroutine neatly
3 direct replies — Read more / Contribute
by Mavebe
on May 05, 2015 at 05:26
    I'm using a subroutine to communicate with an SSH host. Each time i post a command i receive a errcode and the return value. If one of those isn't as expected, i exit my subroutine using return. However, before the return, i first have to exit the ssh session and then close the session.
    if (!$ssh->start_session($ssh_host)) { print "ERROR connecting to $ssh_host\n"; return 1; } my ($ret,$err)=$ssh->execute('command1','expect1'); if ($err || $ret=~/Unknown command:/m) { $ssh->exit_session(); $ssh->close_session; return 2; } my ($ret,$err)=$ssh->execute('command2','expect2'); if ($err || $ret=~/Unknown command:/m) { $ssh->exit_session(); $ssh->close_session; return 3; }
    Is there a better way to execute the exit, close and then the return instead of writing them after every statement to get out of the subroutine ? kr
[emacs] auto-completion of Perl code
1 direct reply — Read more / Contribute
by LanX
on May 03, 2015 at 17:37

    I'm playing around with auto-complete.el combined pos-tip.el but it seems Perl isn't properly supported yet.

    see this picture PosTipScreenshotAutoComplete for motivation.

    I tried making perl-completion.el work but it had too many prerequisites und didn't seem well supported.

    Any other way?

    I can see that ECB is able to parse Perl using imenu and/or etags, would be nice to feed this into auto-complete. :)

    (update: I know that only perl can parse perl for 100%, but 90% is better than nothing)

    Cheers Rolf
    (addicted to the Perl Programming Language and ☆☆☆☆ :)
    Je suis Charlie!

For Loop Output Errors
4 direct replies — Read more / Contribute
by Bama_Perl
on May 02, 2015 at 18:34
    I am fairly new to perl, and I am struggling with an output using a for loop and a nested for loop. I have an input file that looks like this:
    MCCC processed: unknown event at: Tue, 21 Oct 2014 13:39:56 CST station, mccc delay, std, cc coeff, cc std, pol , t0_times + , delay_times ZJ.APRL 0.5735 0.0270 0.8548 0.1060 0 APRL.BHZ 30 +1.0824 -1.0954 ZJ.BEBP 0.0431 0.0173 0.8982 0.0495 0 BEBP.BHZ 30 +0.6827 -1.2262 ZJ.DUBY -0.3951 0.0242 0.8635 0.0550 0 DUBY.BHZ 30 +0.9965 -1.9781 ZJ.FOOT 0.4722 0.0570 0.7965 0.0987 0 FOOT.BHZ 30 +1.2407 -1.3550 ZJ.GRAW -0.2962 0.0203 0.8875 0.0789 0 GRAW.BHZ 30 +0.5646 -1.4473 ZJ.KNYN 0.2933 0.0428 0.7879 0.1305 0 KNYN.BHZ 30 +1.3060 -1.5992 ZJ.LEON 0.5243 0.0235 0.8996 0.0634 0 LEON.BHZ 30 +0.4850 -0.5473 ZJ.MICH -0.1824 0.0165 0.8599 0.0713 0 MICH.BHZ 30 +0.1649 -0.9339 ZJ.RAPH 0.3076 0.0422 0.8096 0.0954 0 RAPH.BHZ 30 +0.4645 -0.7435 ZJ.RKST -0.7187 0.0401 0.8060 0.0827 0 RKST.BHZ 30 +0.3940 -1.6992 ZJ.SAMH -0.0702 0.0260 0.8930 0.0465 0 SAMH.BHZ 30 +1.0272 -1.6839 ZJ.SHRD -0.3952 0.0319 0.8343 0.0938 0 SHRD.BHZ 30 +0.8002 -1.7819 ZJ.SPLN -0.1563 0.0306 0.8653 0.0878 0 SPLN.BHZ 30 +0.5314 -1.2742 Mean_arrival_time: 299.4135 No weighting of equations. Window: 3.19 Inset: 1.28 Shift: 0.25 Variance: 0.03135 Coefficient: 0.85047 Sample rate: 40.000 Taper: 0.40 Phase: P PDE 2013 4 20 3 47 55.02 -5.002 152.111 65.3 0.0 5.6
    What the following script hopes to do is read the last line (with respective formatting) -- the line beginning with PDE. Let's call this the event information. Next, for EACH event, I need to read in the Station Name (Column 1, eg. ZJ.DONT), and the delay time (column 9). What I need to do, is output the Station name,the delay time and the number 1, 6 times across a column, and then the remaining stations (and respective delay times) will move to the next column, and if the remainder doesn't add up to six, pad the rest of the columns with zeroes, such as in this output:
    97 42121 2 27.38 0.00-12.544 0.000 166.815 0.000 29.90 0.00 83 7.6 0.0 +0 44 -1.45 1135 0.70 1105 -0.13 1547 0.04 1184 0.91 1168 -1.07 1 209 -1.28 1 41 -0.79 1163 0.72 1134 -0.59 1254 -0.95 1148 0.31 1 40 -0.24 1322 -0.68 1276 1.09 1338 0.11 1321 0.15 1132 -0.80 1 442 1.08 1107 -1.28 1 39 -0.09 1196 -0.04 1 31 -0.76 1 78 0.20 1 38 -1.43 1 80 0.45 1131 1.07 1164 0.19 1274 -0.29 1526 1.29 1 186 0.15 1108 0.45 1277 0.83 1 91 0.83 1554 0.45 1160 -0.30 1 225 0.33 1505 -0.11 1154 0.75 1204 -0.18 1228 0.94 1143 -0.60 1 243 -1.82 1229 0.18 1 93 -0.29 1247 -0.94 1227 -0.47 1 76 0.10 1 123 0.58 1 96 0.78 1 84 -0.03 1242 0.51 1182 -0.26 1244 0.37 1 232 -0.25 1246 0.70 1226 -0.22 1245 0.71 1189 1.05 1165 0.21 1 230 0.17 1444 -0.95 1272 0.51 1234 1.20 1 32 0.34 1 77 -1.90 1 150 0.34 1124 0.47 1157 -0.33 1 34 -0.58 1 28 -0.59 1199 -0.37 1 185 -0.58 1119 0.04 1490 0.03 1463 -0.06 1330 0.50 1255 -0.04 1 231 -0.17 1 30 0.16 1331 0.77 1523 -0.43 1191 0.58 1 0 0.00 0
    Where the first number represents the station number, the second number is the delay time (column 9) and the third column is just a 1. What I have thus far is below:
    open(TABLEA, "mcp_list"); @tablea = <TABLEA>; # Specify the correspoding output file open(OUT,">output_inversion"); for ($i = 0; $i < @tablea; $i++) { chomp ($tablea[$i]); ($mcpFile) = (split /\s+/,$tablea[$i])[0]; system("wc $mcpFile > crap"); open(TABLEB,'crap'); @tableb = <TABLEB>; chomp ($tableb[0]); ($count) = (split /\s+/,$tableb[0])[1]; $numObs = $count - 9; close(TABLEB); unlink('crap'); #print $mcpFile," ",$numObs,"\n"; $numLines = int($numObs/6); $remainder = $numObs - ($numLines*6); if ($numLines eq 0) { $numLines = $numLines + 1; } #print $numLines," ",$remainder,"\n"; # Now begin with the output file open(TABLEB, $mcpFile); @tableb = <TABLEB>; for ($j = 0; $j < @tableb; $j++) { chomp ($tableb[$j]); ($PDE,$year,$month,$day,$hour,$minute,$second,$eqlat,$eqlong,$ +eqdepth,$mag) = (split /\s+/,$tableb[$j])[0,1,2,3,4,5,6,7,8,9,11]; if ($PDE eq "PDE") { printf OUT "%2d%2d%2d%2d%2d %s %s%7.3f %s%8.3f %s%6.2f %s +%s %s %s \n", $year%100,$month,$day,$hour,$minute,$second,"0.00",$eql +at,"0.00",$eqlong,"0.00",$eqdepth,"0.00",$numObs,$mag, "0.00", "\n"; } for ($k = 0; $k < @tableb; $k++) { chomp ($tableb[$k]); ($netsta, $delay_time) = (split /\s+/,$tableb[$j])[1,9]; ($net, $sta) = (split /\./, $netsta)[0,1]; print $net, " ", $sta, "\n";
    In summary, I need to figure out a way to print (underneath each $mcpFile, the first and 9th column in that $mcpFile, along with the number "1", 6 times, with the remainders on the next line. It's long, I know, but I hope someone here can provide wisdom to send me on my way! Cheers.
LWP not working with HTTPS protocol (SOLVED)
5 direct replies — Read more / Contribute
by CountZero
on May 02, 2015 at 18:08
    Brothers & Sisters in Perl,

    I was writing some code to access my Flickr account, when I happened to have to access a resource over an SSL connection (https-protocol).

    Much to my surprise, LWP failed to access this resource and gave me a most strange error:

    Can't connect to Bad file descriptor at d:/Perl/perl/site/lib/LWP/Protocol/ line + 41.
    The code I used was a very simple
    my $ua = LWP::UserAgent->new; my $req = HTTP::Request->new( GET => ' +rest'); my $response = $ua->request($req);
    Note that LWP makes the connection if I change 'https' by 'http'. Of course the webserver then refuses to return the requested resource as it requires an SSL connection.

    Note also that the error message refers to the LWP::Protocol::http-module, rather than the LWP::Protocol::https-module, as one should expect.

    Both modules are installed and up-to-date. Net::SSL is also installed and up-to-date (version 2.86).

    I am running Strawberry Perl 18.2 on a Windows 8.1 machine.

    Anyone any ideas how to make this work?

    Update: Adding the ssl_opts and protocols_allowed parameters solved the problem. Thanks all!


    A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

    My blog: Imperial Deltronics
Unpack or substr to create CSV?
6 direct replies — Read more / Contribute
by johnmck
on May 02, 2015 at 12:05
    I am a Perl neophyte when it comes to reading and parsing files. I am definitely in need of wisdom.

    I have a 3000 line text file that is comprised of 46 character lines:

    C4432882490H019000020150211ESL6690 0H2015PC
    C4833076550HC0P0000201412093J46651 0H2015DX
    C6033106980H057130020150323FRE7602 0H2015PC
    C663160140MT007015G20141124274847A MT2015PC

    Character 1 (or 0?) is a field, Characters 2-16 are a field, 17-30 another, and finally 31-46 are the last field. I want to read the file from /tmp (filename is always the same and always in the same place) and parse it into the fields (the counts never change) and then save it as a comma-delimited version.

    Since the fields never change length it would seem that unpack is a better choice than substr, is that correct?

    Is there a simple bit of code that someone might get me started with, please? Thank you!

"Cast" a wxString to Numeric?
2 direct replies — Read more / Contribute
by jmlynesjr
on May 02, 2015 at 09:08

    I have the following event handler dealing with a change in a Wx::TextCtrl:

    Wx::Event::EVT_TEXT($self, $IcqText, sub { my ($self, $event) = @_; $self->{AMP1}->Icq(($IcqText->GetValue) / 1000 +);});

    Where $IcqText->GetValue returns a wxString and the / 1000 throws the warning Argument "" isn't numeric in division (/) at ./ line 163. The division is successfully completed.

    The following modification masks the warning:

    Wx::Event::EVT_TEXT($self, $IcqText, sub { my ($self, $event) = @_; { no warnings; $self->{AMP1}->Icq(($IcqText->GetValue) / 1000 +); } });

    Is there an alternate way to "cast" the wxString to numeric?


    There's never enough time to do it right, but always enough time to do it over...

Net::SSH::Perl and getting User from config
3 direct replies — Read more / Contribute
by dayton
on May 01, 2015 at 14:58

    I'm trying to setup a script using Net::SSH::Perl to connect to several hosts and need some insight.. I'm able to connect either with password or rsa/dsa key as long as I specify the username - however on a few hosts the user name is different (and defined in my ~/.ssh/config) How can I get my script to grab the "User" value from the "Hostname" in my config file?

    foreach $host (@HOSTS) { $ssh = Net::SSH::Perl->new("$host",debug=>1,option +s => ["ConnectTimeout=5","StrictHostKeyChecking=no"]); $ssh->login($user); ($out, $err, $exit)=$ssh->cmd($exec_cmd); }

    per the debug, it's reading my config but not getting the User for a particular host:

    Host host2 hostname host2.mydomain User user1
    my_host: Reading configuration data /home/djones/.ssh/config my_host: Reading configuration data /etc/ssh_config my_host: Connecting to host2, port 22. my_host: Remote version string: SSH-2.0-OpenSSH_5.3p1 Debian-3ubuntu7. +1 my_host: Remote protocol version 2.0, remote software version OpenSSH_ +5.3p1 Debian-3ubuntu7.1 my_host: Net::SSH::Perl Version 1.36, protocol version 2.0. .y_host: No compat match: OpenSSH_5.3p1 Debian-3ubuntu7.1 my_host: Connection established. my_host: Sent key-exchange init (KEXINIT), wait response. my_host: Algorithms, c->s: 3des-cbc hmac-sha1 none my_host: Algorithms, s->c: 3des-cbc hmac-sha1 none my_host: Entering Diffie-Hellman Group 1 key exchange. my_host: Sent DH public key, waiting for reply. my_host: Received host key, type 'ssh-dss'. my_host: Host 'host2' is known and matches the host key. my_host: Computing shared secret key. my_host: Verifying server signature. my_host: Waiting for NEWKEYS message. my_host: Send NEWKEYS. my_host: Enabling encryption/MAC/compression. my_host: Sending request for user-authentication service. my_host: Service accepted: ssh-userauth. my_host: Trying empty user-authentication request. my_host: Authentication methods that can continue: publickey,password. my_host: Next method to try is publickey. my_host: Publickey: testing agent key '/home/djones/.ssh/id_dsa' my_host: Authentication methods that can continue: publickey,password. my_host: Next method to try is publickey. my_host: Next method to try is password. my_host: Trying password authentication. my_host: Will not query passphrase in batch mode. my_host: Authentication methods that can continue: publickey,password. my_host: Next method to try is publickey. my_host: Publickey: testing agent key '/home/djones/.ssh/id_dsa' my_host: Authentication methods that can continue: publickey,password. my_host: Next method to try is publickey. Received disconnect message: Too many authentication failures for djon +es at /usr/share/perl5/vendor_perl/Net/SSH/Perl/ line 143.
AnyEvent::ForkManager fails tests on Cygwin
2 direct replies — Read more / Contribute
by choroba
on Apr 30, 2015 at 07:35
    Hi fellow Monks,

    I tried to install AnyEvent::ForkManager on Cygwin. Both its main dependencies, AnyEvent and Parallel::ForkManager, installed without problems, but the module itself hung right after the first test in 001_basic.t:

    ~/.cpan/build/AnyEvent-ForkManager-0.04-ZOUXbL$ ./Build test t/000_load.t ...... 1/1 # Testing AnyEvent::ForkManager/0.04 t/000_load.t ...... ok t/001_basic.t ..... 1/63

    I sprinkled the code with tracing warns to discover where exactly the code gets stuck. The following line never finished:

    $pm->start( cb => sub { my($pm, $exit_code) = @_; local $SIG{USR1} = sub { $started_all_process = 1; }; isnt $$, $pm->manager_pid, 'called by child'; # <<== + HERE until ($started_all_process) {}; # wait note "exit_code: $exit_code"; $pm->finish($exit_code); fail 'finish failed'; }, args => [$exit_code] );

    At first, I though that's manager_pid that doesn't return, but after replacing the line with

    my $mpid = $pm->manager_pid; isnt $$, $mpid, 'called by child';

    it became obvious it's the isnt line that causes the issue. I delved more deeply and found out it comes from Test::SharedFork. It uses flock to lock a file that shares the information between forks. The Store::Locker is constructed with the following:

    sub new { my ($class, $store) = @_; $store->_reopen_if_needed; if ($store->{lock}++ == 0) { flock $store->{fh}, LOCK_EX or die $!; # <<== HERE } bless { store => $store }, $class; }

    The code stops on the flock line and stays there forever (on Linux, it works correctly). I wanted to know more, so I prepended the following to the line:

    use Data::Dumper; $Data::Dumper::Deparse = 1; warn Dumper($store);

    Not only was I able to see the structure, but all the tests passed. "A race condition," though I and replaced the line with

    use Time::HiRes qw{ usleep }; usleep 200;

    Result: PASS. When lowering the value, the tests sometimes hung again.

    The questions

    1. Can someone with a MSWin machine (non-cygwin) try the same? Is the behaviour similar?
    2. Can someone explain how exactly the race condition happens in this case?

    Thanks. The issue lives outside of PM at github, too.

    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Using and compilation errors
1 direct reply — Read more / Contribute
by walshy
on Apr 30, 2015 at 06:21

    I'm using ($VERSION = '2.000001';) and using 'extends' to build up inheritance.

    This works fine, yet if I make an edit that will not compile (not my intention, but it sometimes happens, in this case the semi colon after handleDUM), the compile error is messed up: -type CRANESWL

    Can't locate object method "checkArgs" via package "CRANESWL" at line 37.

    Please see my code below. Note that I've cut it down to be as short as possible to be relevant to this problem

    My guess is that I'm not using Moo correctly and I should be using either Tiny::Roles or Moo::Roles, but without the compilation error it all works fine.

    package MHE; use Data::Dumper; ################################################## use Moo; use Sub::Quote; my $args = (); has heartbeat => ( is => 'ro', default => sub { $args->{heartbeat} || 10; } ); ################################################## # End of oo setup ################################################## sub checkArgs { my ($self, $args) = @_; pod2usage( -msg => "No IP address specified\n", -verbose => 1 ) unless $args->{ip}; } 1;
    package CRANESWL; use Moo; extends 'MHE'; has type => ( is => 'ro', default => 'CRANESWL', ); ################################################## # Handle incoming messages ################################################## # hash to define what sub to call dependant upon what msg type my $msgTypes = { DUM => \&handleDUM; }; 1;

    and the main script:

    #!/usr/bin/perl -w use FindBin qw($Bin); use Getopt::Long; use strict; # Set Library path for MHE modules use lib "$Bin/../lib"; use MHE; my $opts = { }; GetOptions($opts, 'type:s', ); # Use the object dependant upon the requested Type eval "use MHE::$opts->{type} qw(sendHeartbeat)"; my $mhe = $opts->{type}->new; $mhe->checkArgs($opts);
Plack::Middleware::StackTrace missing frame
2 direct replies — Read more / Contribute
by Anonymous Monk
on Apr 29, 2015 at 21:33

    I'm converting an old CGI-based program to Plack and the StackTrace stuff is really cool, but it's not showing the first location... only the second.

    In other words, I see this:

    egad! at line 267. at /home/user/perl5/Plack/Middleware/ line 59 1. in Plack::Middleware::HTTPExceptions::transform_error at /home/user +/perl5/Plack/Middleware/ line 59

    The error is triggered at MyApp line 267, but it's just printed out as normal text. The next frame, transform_error() has all the HTML formatting and the "show lexical variables" option, etc.

    How can I get it to do the same treatment for the MyApp call though? I do have an eval {} and am catching and rethrowing the error. I tried removing that though and it didn't seem to make a difference.


Redirection problem / question
1 direct reply — Read more / Contribute
by taint
on Apr 29, 2015 at 20:45
    OK. I've been struggling with this long enough. I'm going to have to ask for help...

    I'm working (manipulating) a list of IP addresses. I have been largely doing this manually, which is stupid. So now that I've finally got to the point that the list is large enough that I have to deal with it in some (at least somewhat) automated fashion. I'm looking to Perl to save the day.

    The finished list is packed in CIDR form. I unpack the address block I need to modify, then repack, and re-insert the (modified) block back into the list.

    I looked at several nodes here, including (tye)Re2: Net::CIDR::Lite ?? (Merge CIDR addresses). But wasn't sure how to apply it to my needs. So I eventually settled on Net::CIDR. I've managed unpacking the list, with an array. But what I'm trying to do, is feed the list to the script

    # unpackcidr < packed-list > unpacked-list

    Here's what I have so far. But it requires me to paste the list between the paren's
    #!/usr/bin/perl use Net::CIDR; use Net::CIDR ':all'; print join("\n", Net::CIDR::cidr2octets( # here's where I've tried <STDIN> && $_ but to no avail )) . "\n";
    Inserting a list of quoted IP addresses in CIDR notation works in there. But that's not what I'm hoping for. I know this is dead simple stuff. But I'm apparently in dimwit mode ATM. :P

    Thanks for anything that might help.

    λɐp ʇɑəɹ⅁ ɐ əʌɐɥ puɐ ʻꜱdləɥ ꜱᴉɥʇ ədoH

New Perl Poetry
You work and you learn
No replies — Read more | Post response
by chacham
on Apr 30, 2015 at 09:55

    I spent hours and hours on what not to see,
    (To extend ignored users, specifically,)
    So that it would work in last hour of cb
    And then ambrus responded with simplicity.

    I tried using javascript, with Greasemonkey installed,
    For "editing scripts", it's normally called,
    With testing and googling, i was enthralled,
    Then a Perl Monks Discussion, to show what i scrawled.

    But, .chatfrom_<some digits>, when i took a peek,
    I mistakenly thought, was to keep it unique,
    Corion explained, ambrus's critique,
    It's the monk's node id, and not that oblique.

    You work and you learn, even when it's for naught,
    And look on with pride, when you see what you wrought,
    Though the answer is different than i previously thought,
    I'm happy i did it, i reached what i sought.


    Update: 4th stanza, 1st line, changed "all is" to "it's".

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 having an uproarious good time at the Monastery: (8)
As of 2015-05-05 23:00 GMT
Find Nodes?
    Voting Booth?

    In my home, the TV remote control is ...

    Results (127 votes), past polls