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
how to get a 64bit random number with rand() ?
3 direct replies — Read more / Contribute
by iglake
on Mar 21, 2018 at 08:11

    Hello all monks,

    In the following code rand() doesn't even give me 52bit of data;
    both MSB and LSBs are fixed !

    what is the best way to get 64bit numbers ?

    0000000000000000010111100101110000011011100101010001000000001111 00005 +E5C1B95100F 0000000000001100111011111010100001011001101001100011011101111111 000CE +FA859A6377F 0000000000000011001010100001010110101011101000101010001000101111 00032 +A15ABA2A22F 0000000000000110110100001111000101010110001101100010111100011111 0006D +0F156362F1F 0000000000001101001011001010011110010100111010001101000101001111 000D2 +CA794E8D14F 0000000000000101110101011101011111101000111011101111111110111111 0005D +5D7E8EEFFBF 0000000000000001000001010001000100101100100010010110010101101111 00010 +5112C89656F 0000000000001111110001100010010000001010111000101101000101011111 000FC +6240AE2D15F 0000000000000100100100001010101010101111001011110110011010001111 00049 +0AAAF2F668F 0000000000001100100011011000010010011010000101000000101111111111 000C8 +D849A140BFF 0000000000001101000011001100011010101101010100010001110010101111 000D0 +CC6AD511CAF 0000000000000010100111010110010110111101100011110101011110011111 00029 +D65BD8F579F 0000000000000000001100001110001000000110010000100000111111001111 00003 +0E206420FCF 0000000000000101001111111000100011111000000101011001110000111111 00053 +F88F8159C3F 0000000000000100100110101110000010010110100101010000011111101111 00049 +AE0969507EF 0000000000000100111011101101111101110011110101100000000111011111 0004E +EDF73D601DF 0000000000000110110111111000000010010010010011100000110100001111 0006D +F80924E0D0F 0000000000000111011111011100100001010101101101111111000001111111 00077 +DC855B7F07F 0000000000001110110001011111000001110111011001000110011100101111 000EC +5F07764672F 0000000000001101011110001010000111001010101101010001000000011111 000D7 +8A1CAB5101F
    #!/usr/bin/perl $|++; srand(54321); for (1 .. 20) { my $n = int rand(0xF_FFFF_FFFF_FFFF); printf "\r%064b %016X\n",$n,$n; } exit $?;
JSON Return Values
2 direct replies — Read more / Contribute
by tultalk
on Mar 20, 2018 at 21:27


    How do I capture the JSON data in a usable manner?


    Following code executes the CGI script:

    <script type="text/javascript"> $(document).ready(function(){ alert("entered function"); $.getJSON(" +tion=updatetable_167&kind=0&searchterm=19", function(data){ $.each(data, function(key, value){ document.write(key+":"+value+"<br />"); }); }); }); </script

    Nothing printed out

    Below is log showing that the query was executed and returned the correct values

    [Tue Mar 20 19:59:06 2018] update_tables.cgi: searchterm = '19' at upd +ate_tables.cgi line 439. sortindex = '0' at update_tables.cgi line 455. [Tue Mar 20 19:59:06 2018] update_tables.cgi: sortindex = '0' at upda +te_tables.cgi line 455. searchfield = 'user_id' at update_tables.cgi line 457. [Tue Mar 20 19:59:06 2018] update_tables.cgi: searchfield = 'user_id' + at update_tables.cgi line 457. statement = 'SELECT * FROM users WHERE user_id = ? ORDER BY ? ASC' at + update_tables.cgi line 462. count = '1' at update_tables.cgi line 473. [Tue Mar 20 19:59:06 2018] update_tables.cgi: count = '1' at update_ta +bles.cgi line 486. Finished print {"DD":"2019-01-30","DP":"2018-12-31","MD":"120.00","MJ" +:"2018-01-30","address1":"1471 Meeks Rd","address2":null,"business":" +JZ Electroplating","city":"Latham","comments":"This is a test entry", +"email":"","forename":"John","id":57,"lastname":"Zinzer" +,"password":"1234","phone_cell":"517-204-1111","phone_home":"517-233- +4378","pin":"JbwmZ","position":"General Member","state":"NJ","user_id +":19,"username":"lms19","zip":"45789-2334"} at update_tables.cgi line + 492.

    JSON print works as I captured output in an IFrame for testing.

    my $searchResult = $sth->fetchrow_hashref(); my $count = $sth->rows; warn("count = '$count'"); if ($count == 0) { warn("Failed Search: '$searchfield' equal to '$searchterm' "); my %searchFail = ( SearchError => $kind); my $json = JSON->new; $json->canonical(1); $json = encode_json(\%searchFail); print "Content-Type: application/json\n\n"; print $json; warn("Finished print 0 count $json"); exit(1); } #{"SearchError":0} Good else { warn("count = '$count'"); my $json = JSON->new; $json->canonical(1); $json = encode_json($searchResult); print "Content-Type: application/json\n\n"; print $json; warn("Finished print $json"); exit(0); }
Use of 'last' within single-line while loops
3 direct replies — Read more / Contribute
by Special_K
on Mar 20, 2018 at 20:06

    Does the last keyword only care about braces when determining what constitutes a loop? I have the following code:

    #!/usr/bin/perl -w use strict; my $last_test_file = "./last_test_file"; printf("before loop\n"); while (1) { if (open TEST_FILE, $last_test_file) { printf("after open\n"); /^\s*TEST_PATTERN\s+/ and last while <TEST_FILE>; printf("after match\n"); close(TEST_FILE); } else { die("ERROR: Unable to open $last_test_file for read, exiting.. +.\n"); } } printf("after loop\n");

    Assume last_test_file contains the text TEST_PATTERN on line 6, and non-matching text on all other lines. My expectation is that the above script will open last_test_file, read the first 5 lines without matching, then read line 6, match, exit the inner while loop due to the 'last' statement, print "after match", close the file handle, and repeat this process indefinitely due to being stuck in the while(1) loop. What happens in actuality is the script never makes it to the "after match" text; the 'last' statement appears to be breaking out of the outer while (1) loop rather than the inner while <TEST_FILE> loop. If I replace the single-line while loop above with the following:

    while (<TEST_FILE>) { /^\s*TEST_PATTERN\s+/ and last; }

    The script behaves as I described above, i.e. it remains stuck inside the while (1) loop and the 'last' statement only breaks out of the while (<TEST_FILE>) loop. This occurs with perl 5.26.1.
    Here are my questions:

    1. Does 'last' use the presence of braces to determine what constitutes a loop? Does 'last' officially not work with single-line while loops like the above? I was not able to determine this from the perldoc page for 'last' (

    2. Are single-line while loops like the one above considered bad programming practice in general?

    3. I am running with "use strict" and warnings enabled. Shouldn't my single-line while loop with 'last' be flagged at least as a warning, given that the last statement doesn't apply to the loop it is used within? Is there any higher level of warning that can be enabled to catch things like this?

last/next/redo usages
3 direct replies — Read more / Contribute
by hurricup
on Mar 20, 2018 at 16:29

    Perldoc says pretty same for them, like

    next cannot be used to exit a block which returns a value such as eval {} , sub {} , or do {} , and should not be used to exit a grep or map operation.

    I read cannot as doesn't work. But. In some modules, like Par::Dist I can see code like:

    File::Find::find( sub { next unless $File::Find::name; (-r &amp;&amp; !-d) and push ( @files, substr($File::Find::nam +e, 5) ); } , 'blib' );

    What is it? Outdated documentation? Do I get cannot wrong way? Some tricky next, like sub?

    Also, TIL, missing in docs, that last/next/redo may be used in statement modifiers, like say $_ and last for 1,2,3

    I'm working on new code inspection, so question is not rythorical.

Using READDIR runs out of memory
3 direct replies — Read more / Contribute
by DenairPete
on Mar 20, 2018 at 15:06

    I need the wisdom of PerlMonks!!! I am running a script that opens a directory and puts files that end in .html into an array. The directory contains 1 million files total, with about half of them having the .html extension. When I run my script I get "Out of Memory": Here is how I am getting pushing the files into the array:

    opendir(DIR, $accumulatorDir) or die "$!\n"; my @jrnFiles = map $_, grep /\.html$/, readdir DIR; closedir(DIR);

    Is there another alternative I can use that is semi-efficient? Java has no problem doing this with their ""

How to get good primes for DH agreement ?
1 direct reply — Read more / Contribute
by iglake
on Mar 20, 2018 at 14:00

    Any perl-monks crypto savvy ?
    I'd like to have an opinion on how to choose good primes for DH agreement :
    here is an except of my perl code, I have mixed feeling about it, please comment !
    (link for downloading the file directly : )

    #!/usr/bin/perl our $dbug = 0; use YAML::Syck qw(DumpFile); # 0) initialization get (g,p) # 1) Bob to create keypair # 2) Alice to get Bob's public key # 3) Alice to compute a shared-secret with Bob's public key... # 4) Alice to send her public-key to Bob # 5) Bob to generate his side of the shared-secret # 6) compare ! my $user = 'Bob'; # --------------------------------------------------- $PKI = { anon => ['anonymous', 'pubkey' => '123', secret => undef ] }; # --------------------------------------------------- my $seed = srand(); printf "seed: %s\n",$seed; my $iv_key = rand(4125415); my ($g,$p) = &get_IV($iv_key); # keys agreement : use Crypt::DH; my $bob; # Bob's DH # --------------------------------------------------------- if ($user eq 'Bob') { my $I = uc substr($user,0,1); $bob = Crypt::DH->new( p => "$p", g => $g ); if ($dbug) { printf "g: %s\n",$bob->g(); printf "p: %s\n",$bob->p(); } my $pub = $bob->generate_keys; my $keypair = { user => $user, pubkey => $pub, seckey => $bob->priv_key() }; printf "%s:\n",$user; printf "pub(%s): %s\n",$I,substr($pub,0,32); printf "priv(%s): %s...\n",$I,substr($bob->priv_key(),0,32); DumpFile("DH_$user.key",$keypair); $PKI->{bob}{pubkey} = $bob->pub_key(); print ".\n"; } # --------------------------------------------------------- { # Alice's my $dh = Crypt::DH->new( p => "$p", g => $g ); my $pub = $dh->generate_keys; my $keypair = { user => 'Alice', pubkey => $pub, seckey => $dh->priv_key() }; printf "%s:\n",'Alice'; printf "pub(A): %s...\n",substr($pub,0,32); printf "priv(A): %s...\n",substr($dh->priv_key(),0,32); DumpFile("DH_Alice.key",$keypair); print ".\n"; my $secret = $dh->compute_secret( $PKI->{bob}{pubkey} ); printf "Alice's secret : %s\n",$secret; $PKI->{alice}{pubkey} = $dh->pub_key(); $PKI->{alice}{secret} = $secret; } # --------------------------------------------------------- { # BOB again ... my $secret = $bob->compute_secret( $PKI->{alice}{pubkey} ); printf "Bob's secret : %s\n",$secret; die if ($secret ne $PKI->{alice}{secret}); } exit $?; # -------------------------------- sub get_IV { # set initialization vector for keypair generation my $key = shift; my ($g,$p) = (2,undef); if ($dbug == 1) { ($g,$p) = (3,107); # very bad choice but simple case to verify t +he maths ! } else { $p = &get_prime($key); } return ($g,$p); } # -------------------------------- # ------------------------------------------ sub get_prime { my $key = shift; local $/ = "\n"; my $buf = ''; while (<DATA>) { # get prime from the bottom of this file ! next if /^#/o; # skip comments next if /^__\w+__/; # & markers chomp; y/ //d; $buf .= $_; } printf "buf: %s.\n",$buf if $dbug > 1; use Math::BigInt; my $bint = Math::BigInt->from_hex($buf); if (defined $key) { use Math::Primality qw(is_prime next_prime); my $digest = &digest('RIPEMD-160',$key); $digest =~ s/ //go; my $offset = Math::BigInt->from_hex($digest); my $candidate = $bint + $offset; if ($dbug > 1) { print "hash: $digest\n"; print "cand: $candidate\n"; } if (! &is_prime($candidate)) { print " p is not a prime ... will find an other one ! \n" if $ +dbug; $bint = &next_prime($candidate); if (&is_prime($bint)) { printf "%s is now a prime\n",$bint if $dbug; } } else { $bint = $candidate; printf "%s is prime!\n",$bint; } } return $bint; } # ------------------------------------------ sub digest { use Digest qw(); my $alg = shift; my $msg = Digest->new($alg) or die $!; $msg->add(join'',@_); my $digest = lc( $msg->hexdigest() ); return $digest; # hex form ! } # ------------------------------------------ 1; __DATA__ # SSH2 prime: FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1 29024E08 8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD EF9519B3 CD3A431B 302B0A6D F25F1437 4FE1356D 6D51C245 E485B576 625E7EC6 F44C42E9 A637ED6B 0BFF5CB6 F406B7ED EE386BFB 5A899FA5 AE9F2411 7C4B1FE6 49286651 ECE65381 FFFFFFFF FFFFFFFF __END__
fork always 'n' processes.
2 direct replies — Read more / Contribute
by TheMagician
on Mar 20, 2018 at 10:16
    Hello all, I am Paolo F. a newcomer (a.k.a TheMagician) and I am in search for wisdom. I would like to get a "$message" from this tcp server, an process (if available) always two $messages at a time. When a process finishes another one will be forked until the end of the "$messages".

    ### tcp server

    use DBI; use IO::Socket::INET; ### flush after every write $|= 1; ### infinite loop while(1) { my($socket, $client_socket); my($peeraddress, $peerport); my($row, $data); my @processes= ('one', 'two', 'three', 'four', 'five', 'six', 'seven +', 'eight', 'nine', 'ten'); # creating object interface of IO::Socket::INET modules which intern +ally does # socket creation, binding and listening at the specified port addre +ss. $socket = new IO::Socket::INET ( LocalHost=> '', LocalPort=> '5000', Proto=> 'tcp', Listen=> 5, Reuse=> 1 ) or die "ERROR in Socket creation: $!\n"; print "I am waiting clients to connect on port 5000.\n"; while($row= shift(@processes)) { $client_socket = $socket->accept(); $peeraddress = $client_socket->peerhost(); print "Sending $row to $peeraddress:$peerport)... "; # write to the newly accepted client. print $client_socket "$row\n"; # read from the newly accepted client. $data = <$client_socket>; chomp($data); print "got $data from client.\n"; $client_socket->close(); } $socket->close(); }

    The client part is giving me headaches.

    ### tcp client

    use strict; use warnings 'all'; sub sfork($&) { my($max, $code)= @_; foreach my $c (1..$max) { wait unless $c<=$max; die "Cannot fork: $!\n" unless defined(my $pid= fork); exit $code->($c) unless $pid; } 1 until -1 == wait; } sfork 2, sub { sub getFromProducer { use IO::Socket::INET; my($socket, $data); $socket= new IO::Socket::INET ( PeerHost=> '', PeerPort=> '5000', Proto=> 'tcp' ) or die "ERROR in Socket creation: $!\n"; $socket->autoflush(1); $data= <$socket>; chomp($data); $socket->close(); return $data; } while(my $data= &getFromProducer) { print "($$) Got $data from producer.\n"; } }

    I am not able to adapt the sfork to accomplish this task. Any help? All the best, TheMagician (Paolo F.)
Idiomatic Perl?
6 direct replies — Read more / Contribute
by thenextfart
on Mar 20, 2018 at 10:06
    I am currently learning Perl by trial/try/error, and I have a Python background. The purpose of the program of the subject of the question, however, is to find out what is idiomatic Perl and what is not. I don't want to end up writing Python in Perl. This is my program:
    use strict; use warnings; print "RegEx Engine 1.0\n________________\n"; print "Gimme a string: "; my $str = <STDIN>; print "Gimme a RegEx: "; my $pattern = <STDIN>; my $answer = eval("\"$str\" =~ $pattern"); if ($answer) { print "Yes!"; } else { print "No."; } print "\nkthxbye\n";
    Is this good/idiomatic/bad/ugly/encouraged/discouraged/ Perl? (Note: I am using Perl 5)
Date to Epoch
5 direct replies — Read more / Contribute
by Anonymous Monk
on Mar 20, 2018 at 09:51

    I am trying to convert a file date to epoch using a single line of code in Solaris 10, which uses an older version of perl.

    I have been able to convert epoch to a date with your assistance:

    echo $epoch | perl -MPOSIX -e 'print strftime("%m%d%H%M", gtime <stdin>)'

    However, I would like to now reverse this process.

    I was thinking about something like the following:

    echo "Mar 20 2018 09:00" | perl -MPOSIX -e 'print strptime(<stdin>, "%s")'

    But, I receive an error "Undefined subroutine &main::strptime called at -e line 1, <stdin> line 1. I tried substituting <stdin> with $ARGV[0] but still receive a subroutine error.

Question on deprecated CPAN modules
3 direct replies — Read more / Contribute
by Anonymous Monk
on Mar 20, 2018 at 09:50

    Hi everyday,

    If a CPAN module is deprecated, should we use it?

    I started to use Mail::Sender recently after it was suggested to me here but I saw on that it's deprecated.

    Please share your thoughts.

Add your question
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.