Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

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
Call to subs in a Dispatch Table
1 direct reply — Read more / Contribute
by Anonymous Monk
on May 06, 2015 at 15:35
    Hi Monks!

    I am trying to call two subs at the same time at this particular time once I call this value "results" in my dispatch table code.
    Is it possible and how can it be done? This is not working!

    ... my %general = ( data => sub { info( who=> $q->param('who') || '', why=> $q->param('why') || '', ) }, results => sub { names( first => $q->param('first'), zip => $q->param('zip'), ) }, sub { info( who => $q->param('who') || '', why => $q->param('why') || '', ) }, ); ...

    Thank for looking!
Calling subroutine with a scalar
1 direct reply — Read more / Contribute
by Rodster001
on May 06, 2015 at 14:07
    Hi Monks, I know this has been asked endlessly, but I am doing it slightly different than I have done before and I cannot quite get the syntax right.
    my $res = new Some::Package({ foo => bar })->subroutine;
    What I want to do is call "subroutine" by variable. For example:
    my $sub = "subroutine"; my $res = new Some::Package({ foo => bar })->( $sub );
    That doesn't work, I've tried several variations of that (along with \&) and I can't quite get it. Can someone enlighten me?

search contents of one file and replace with contents of another to make a new file
5 direct replies — Read more / Contribute
by vcorby
on May 06, 2015 at 12:43

    Dearest Monks,

    I am trying to replace the text in file #1 with the text in file #2 to make file #3. I would like to do so based on the identity between the text in file #1 and the text before the underscore (_) in file #2 to make file #3. The basic idea is to be able to add the content after the underscore (which is indicated in file #2) into each entry of file #1, but I want to maintain the commas and line breaks found in file #1 so that it can be read into another program.

    Here are smaller versions of my files:

    File 1 (1.txt):


    File 2 (2.txt):


    I want to make File 3 (3.txt):


    Based on a similar post, I thought I could do the following (please excuse my child-like annotations):

    #!/usr/local/bin/perl use warnings; use strict; my $f1 = '1.txt'; # set up files 1 through 3 my $f2 = '2.txt'; my $f3 = '3.txt'; my (@strings, $text); open (FH, $f1) || die; # open file 1 in a file handle chomp(@strings = <FH>); # take off the line breaks open (FH, $f2) || die; # open file 2 in a file handle $text = join '', <FH>; # joins files 1 and 2? - I don't think I wa +nt to do this... $text =~ s/\Q$_\E/$f3/g for @strings; # this is the problem spot, +I think... open (FH, ">$f3") || die; print FH $text; close FH;

    but obviously not because when I do I get this for 3.txt:


    Any ideas?

    And many thanks in advance.


Module caller
2 direct replies — Read more / Contribute
by jeffsto
on May 06, 2015 at 09:29
    I've started putting my code into modules for obvious reasons. Is there a way I can get the name of the script that is calling the module? I want to use this for tracking so I can easily keep track of what scripts call my modules. I've looked at the module "caller" however I couldn't determine if it could extract the correct information. It seemed like it was limited to the information within the module itself, or did I miss something? Thanks!
Ceiling elements of an array!
6 direct replies — Read more / Contribute
by shadowman13
on May 06, 2015 at 04:20
    Hi All wisdom Monks,

    I'm new to Perl, so don't know if there is a way to ceil the number of elements inside an array?

    I got a task like below:

    +Get a list of modules if number of modules is 8 ceiling(6/2)= ceiling(3)=3 -> call the first 3 modules on port 80 and call the last 3 modules on port 8080

    +if there is 5 modules deployed -> ceiling(5/2)= ceiling(2.5)=3 -> call the first 3 modules on port 80 and call the last 3 modules on port 8080 (the module “in the middle” will be called twice)

    Could you help me with an algorithm or a way to do this in perl?
Perl pattern matching question
5 direct replies — Read more / Contribute
by MadhAric
on May 06, 2015 at 04:12
    I have a sentence. My task is to find out whether the articles A and An are properly used. if a followed by a vowel , replace it with an (like replace a apple with an apple) and vice versa replace an dog with a dog. can you please tell me the code I am with basic level of PERL and wrote the following piece which did not give the desired result $string =~ (s/a (a|e|i|o|u)/an /g); print "\n$string\n"; Do we need to use loops and sub strings for this
plack: close filehandle responsibility
4 direct replies — 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
4 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
Q: Cannot get the capture from connection with Net::Openssh?
1 direct reply — Read more / Contribute
by ryder
on May 05, 2015 at 03:57

    Heelo Perl Monks,

    I try to connect to a network appliance using Net::Openssh. Simple commands like ls /tmp or cat /etc/hosts are working.

    But I try to capture the output from a proprietary command, called dbedit. The appliance have a standard Openssh server installed, version OpenSSH_4.3p2, OpenSSL 0.9.8b 04 May 2006 The server cannot be updated. here my test programm:

    #!/usr/bin/perl use Net::OpenSSH; my $host = ""; my $user = "admin"; my $pass = "my_pw"; #$Net::OpenSSH::debug=-1; my $ssh = Net::OpenSSH->new(host=>$host, user=>$user, password=>$pass, master_opts => [-v, -o => "StrictHostKeyCh +ecking=no"], ); $ssh->error and die "Couldn't establish SSH connection: ". $ssh->error +; my $xxx = "source /opt/CPshrd-R77/tmp/ ; /opt/CPsuite-R7 +7/fw1/bin/dbedit --h"; #my (@ls,$errput) = $ssh->capture2({tty => 1},"/opt/CPsuite-R77/fw1/ +bin/dbedit --h"); my (@ls,$errput) = $ssh->capture2({tty => 1},$xxx); $ssh->error and die "remote ls command failed: " . $ssh->error; print"LS:@ls\n"; print"ERR:$errput\n";

    As you can see by the code. I already tried some hacks to solve the problem. But any additional option I integrated into the code. Did not solve the problem. Interesting ist that the Debug-Output is showing the output from the command, but it seems this output did not get back through the tunnel to the ssh client. Please finde following the debug output from a connection establishment test:

    Is there anybody out there who can help me to capture the output from this command.

    ciao ryder

Problem installing Win32::ToolHelp with Strawbeery Perl Win64
2 direct replies — Read more / Contribute
by tangobaer
on May 05, 2015 at 03:52
    Hello community,
    this is my first question - please be kind.
    I try to install Win32::ToolHelp with x64 Strawberry Perl on Win7 64.
    When I use cpanm I get an dmake error: Build.log:
    cpanm (App::cpanminus) 1.7033 on perl 5.020002 built for MSWin32-x64-m +ulti-thread Work directory is C:\Users\Eurocom/.cpanm/work/1430810127.6240 You have make C:\Strawberry\c\bin\dmake.exe You have LWP 6.13 Falling back to Archive::Tar 2.04 Searching Win32::ToolHelp () on cpanmetadb ... --> Working on Win32::ToolHelp Fetching +tar.gz -> OK Unpacking Win32-ToolHelp-0.32.tar.gz Entering Win32-ToolHelp-0.32 Checking configure dependencies from META.yml Checking if you have ExtUtils::MakeMaker 6.58 ... Yes (7.04) Configuring Win32-ToolHelp-0.32 Running Makefile.PL Checking if your kit is complete... Looks good MakeMaker (v7.04) Warning (non-fatal): Target 'dynamic' depends on targets in skipped se +ction 'dynamic_lib' Warning (non-fatal): Target 'static' depends on targets in skipped sec +tion 'static_lib' Generating a dmake-style Makefile Writing Makefile for Win32::ToolHelp::Impl Writing MYMETA.yml and MYMETA.json Generating a dmake-style Makefile Writing Makefile for Win32::ToolHelp Writing MYMETA.yml and MYMETA.json -> OK Checking dependencies from MYMETA.json ... Checking if you have ExtUtils::MakeMaker 0 ... Yes (7.04) Building and testing Win32-ToolHelp-0.32 cp blib\lib\Win32\ AutoSplitting blib\lib\Win32\ (blib\lib\auto\Win32\ToolHelp +) cd Impl && dmake gcc -c -s -O2 -DWIN32 -DWIN64 -DCONSERVATIVE -DPERL_TEXTMODE_SCR +IPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -fwrapv + -fno-strict-aliasing -mms-bitfields -s -O2 -DVERSION=\"\" +-DXS_VERSION=\"\" "-IC:\STRAWB~1\perl\lib\CORE" Impl.c ar /out:Impl.a Impl.o ar: invalid option -- / Usage: ar [emulation options] [-]{dmpqrstx}[abcDfilMNoPsSTuvV] [member +-name] [count] archive-file file... ar -M [<mri-script] commands: d - delete file(s) from the archive m[ab] - move file(s) in the archive p - print file(s) found in the archive q[f] - quick append file(s) to the archive r[ab][f][u] - replace existing or insert new file(s) into the archi +ve s - act as ranlib t - display contents of archive x[o] - extract file(s) from the archive command specific modifiers: [a] - put file(s) after [member-name] [b] - put file(s) before [member-name] (same as [i]) [D] - use zero for timestamps and uids/gids [U] - use actual timestamps and uids/gids (default) [N] - use instance [count] of name [f] - truncate inserted file names [P] - use full path names when matching [o] - preserve original dates [u] - only replace files that are newer than current archiv +e contents generic modifiers: [c] - do not warn if the library had to be created [s] - create an archive index (cf. ranlib) [S] - do not build a symbol table [T] - make a thin archive [v] - be verbose [V] - display the version number @<file> - read options from <file> --target=BFDNAME - specify the target object format as BFDNAME emulation options: No emulation specific options ar: supported targets: pe-x86-64 pei-x86-64 elf64-x86-64 elf64-l1om el +f64-k1om pe-i386 pei-i386 elf32-i386 elf64-little elf64-big elf32-lit +tle elf32-big srec symbolsrec verilog tekhex binary ihex dmake: Error code 129, while making 'Impl.a' dmake.exe: Error code 255, while making 'Impl\Impl.a' -> FAIL Installing Win32::ToolHelp failed. See C:\Users\Eurocom\.cpanm +\work\1430810127.6240\build.log for details. Retry with --force to fo +rce install it.
    Please could someone explain the problem for me.
    It is the first time I try to install a Win32 Module from CPAN with Strawberry Perl.
    Thanks for your help !!
[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.
New Meditations
Never say never
2 direct replies — Read more / Contribute
by Lady_Aleena
on May 05, 2015 at 23:37

    A thud can be heard throughout the monastery as Lady Aleena's head hits her desk in the scriptorium. Shortly thereafter the sound of breaking glass filters through the monastery's halls as her preconceptions are shattered.

    Never say you will never do a thing because, one day, you will do the thing then feel foolish.

    Now here is some history and what happened tonight. I said I would never use pipes in my data fields. Tonight I did. Now I am feeling more than foolish. (And I've made more work for myself while trying to make less work for myself.) I just learned my lesson.

    If you feel you are about to say "I will never...", stop, think very hard, count to ten, whatever. Just do not say it! One day you will be writing a piece of code, humming a little tune stuck in your head, then you will crash into a wall because you did not take into consideration the exception you just wrote.

    Have a nice day!

    I started this thought in the CB and continued it here.

    No matter how hysterical I get, my problems are not time sensitive. So, relax, have a cookie, and a very nice day!
    Lady Aleena
perlnews item worth reading!
No replies — Read more | Post response
by ww
on May 05, 2015 at 16:12
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: (6)
As of 2015-05-07 09:03 GMT
Find Nodes?
    Voting Booth?

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

    Results (158 votes), past polls