Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much

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
resetting a foreach loop!
5 direct replies — Read more / Contribute
by lunette
on Nov 16, 2017 at 17:05
    hello, monks! it's been a little while, and i need some help with a small thing. i've figured out how to make this entire thing run, but i can't figure out how to clear the foreach loop for every new set of data it uploads from a file. the explicit package name for "@array" can't be moved into the loop because the subroutine below needs it as well, which seemed to be what everyone said would fix the problem.

    is there any other way to clear the data each time? i've tried 'next', 'last', and 'redo', and none of them seem to do anything besides mess the loop up entirely. i've also tried adding another array into the loop using the original array to manipulate the data into clearing that way, but as i thought, that did nothing.

    does anyone have any simple way of getting the data to clear for each loop? i'm sure it's something simple that i'm just overlooking. here's the code itself:

    #!usr/bin/perl use strict; use diagnostics; use warnings; my @array; my $average; while (1) { print "Enter an input file name: "; chomp (my $choice = <STDIN>); open (FH, '<', "C:/Users/tsukk/$choice"); while (my $data = <FH>) { push @array, $data; } my @largest = sort {$b<=>$a} @array; my @smallest = sort {$a<=>$b} @array; print "\nThe largest number is: "; print $largest[0], "\n"; print "The smallest number is: "; print $smallest[0]; print "The average of the numbers is: "; printf "%.1f\n", average(@array); print "\n"; $average = average(@array); foreach (@array) { chomp; if ($average > $_) { print "$_\t is below average.\n"; } elsif ($average < $_) { print "$_\t is above average.\n"; } elsif ($average = $_) { print "$_\t is equal to average.\n"; } } print "\nDo it again? (Yes or No): "; chomp (my $yesno=<STDIN>); if($yesno ne 'Yes') { print "Goodbye.\n"; exit; } } sub average { if (@array) { my @temp = @_; my $sum = 0; foreach (@temp) { $sum = $sum + $_; } return $sum/@temp; } }

    thank you!

Net::SMTP upgraded but with warnings
1 direct reply — Read more / Contribute
by bdegan2
on Nov 16, 2017 at 12:31

    We managed to upgrade Net::SMTP to 3.11 and IO::Socket::SSL to 2.052

    But we are getting these warning messages out when we call either of these modules:

    perl -MNet::SMTP -e 'print "$Net::SMTP::VERSION\n"' Constant subroutine IO::Socket::INET6::AF_INET6 redefined at /usr/lib/perl5/5.8.8/ line 65. at /usr/lib/perl5/vendor_perl/5.8.8/IO/Socket/ line 16 Prototype mismatch: sub IO::Socket::INET6::AF_INET6 () vs none at /usr/lib/perl5/5.8.8/ line 65. at /usr/lib/perl5/vendor_perl/5.8.8/IO/Socket/ line 16 Constant subroutine IO::Socket::INET6::PF_INET6 redefined at /usr/lib/perl5/5.8.8/ line 65. at /usr/lib/perl5/vendor_perl/5.8.8/IO/Socket/ line 16 Prototype mismatch: sub IO::Socket::INET6::PF_INET6 () vs none at /usr/lib/perl5/5.8.8/ line 65. at /usr/lib/perl5/vendor_perl/5.8.8/IO/Socket/ line 16 3.11

    We did have this issue during the upgrade:

    Went back through the install screens. even though I got an ok at the end, I found a MakeMaker version issue. I had to force install Make::Maker Net::SMTP is now installed,

    Our server is : uname -a Linux 2.6.18-53.1.6.el5 #1 SMP Wed Jan 16 03:56:15 EST 2008 x86_64 x86_64 x86_64 GNU/Linux

    Can these warning messages be disregarded ?? thank you

Looking for general pointers on Apache::Session
5 direct replies — Read more / Contribute
by nysus
on Nov 16, 2017 at 09:26

    I'm rolling my own little web development framework based on mod_perl 2 and jquery mobile. I've got a good start on making it easy to create navigation menus and generate forms and now I want to turn some attention to access control. I'm thinking of using Apache::Sessions to track user sessions to certain resources based on nothing other than that seems to be a possible solution based on what I've read. But before I do that, I wanted to check in with the Monks to see if I'm on the right track and offer some big picture guidance on using Apache::Sessions. Some specific questions I have to get started:

    1) What's the fastest way to store session data? In the DB? In a file? What are the advantages/disadvantages of the different methods?

    2) If I use a DB, do I have to set up the DB table for storing session data ahead of time or prep the DB in any way?

    3) There is a module called Apache::SessionManager. Not sure if that is the direction to take or not. It looks like it might do the same thing as Apache::Session but is built specifically for mod_perl. Is that right?

    Any other useful guidance or general pointers is appreciated. Thank you very much for your time.

    $PM = "Perl Monk's";
    $MCF = "Most Clueless Friar Abbot Bishop Pontiff Deacon Curate";
    $nysus = $PM . ' ' . $MCF;
    Click here if you love Perl Monks

Pure perl Jenkins 32 bit Hash
3 direct replies — Read more / Contribute
by huck
on Nov 16, 2017 at 08:00

    Below is a pure perl version of the lookup2 hash by Bob Jenkins as talked about at A Hash Function for Hash Table Lookup.

    Edit: This is an updated version, in particular the mix4 mentioned at Re: Pure perl Jenkins 32 bit Hash is now called mix4x and may be discarded. Also there is code to select the proper version based on $Config{ivsize} and a test call.

    { # has use integer/bytes use integer; use bytes; # # # # # */ + use constant GOLDEN_RATIO => 0x9e3779b9; use constant A => 0; use constant B => 1; use constant C => 2; use constant FFFFFFFF => 0xffffffff; use constant KEY => 0; use constant INITHASH => 1; sub mix4 ($$$) { # 32bit version # per this is a revised 32bi +t under 'use integer'; $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>>13) +; } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<< 8) +; } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>>13) +; } $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>>12) +; } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<<16) +; } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>> 5) +; } $_[A] -= $_[B]; $_[A] -= $_[C]; { no integer; $_[A] ^= ($_[C]>> 3) +; } $_[B] -= $_[C]; $_[B] -= $_[A]; { no integer; $_[B] ^= ($_[A]<<10) +; } $_[C] -= $_[A]; $_[C] -= $_[B]; { no integer; $_[C] ^= ($_[B]>>15) +; } } sub mix4x ($$$) { # per this is wrong $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>>13); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<< 8); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>>13); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>>12); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<<16); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>> 5); $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] ^= ($_[C]>> 3); $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] ^= ($_[A]<<10); $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] ^= ($_[B]>>15); } sub mix8 ($$$) { # 64bit version $_[A] &= FFFFFFFF; $_[B] &= FFFFFFFF; $_[C] &= FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C]>>13) ) & + FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A]<< 8) ) & + FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B]>>13) ) & + FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C]>>12) ) & + FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A]<<16) ) & + FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B]>> 5) ) & + FFFFFFFF; $_[A] -= $_[B]; $_[A] -= $_[C]; $_[A] = ( $_[A] ^ ($_[C]>> 3) ) & + FFFFFFFF; $_[B] -= $_[C]; $_[B] -= $_[A]; $_[B] = ( $_[B] ^ ($_[A]<<10) ) & + FFFFFFFF; $_[C] -= $_[A]; $_[C] -= $_[B]; $_[C] = ( $_[C] ^ ($_[B]>>15) ) & + FFFFFFFF; } sub jhash_pp_hex { my ($a, $b, $c) = ( GOLDEN_RATIO, GOLDEN_RATIO, $_[INITHASH] ); my ($p, $length) = (0, length $_[KEY]); my $len=$length; my($x,$y,$z); while ($len>=12) { ($x,$y,$z) = unpack 'LLL', substr($_[KEY], $p, 12); $a+=$x;$b+=$y;$c+=$z; mix($a, $b, $c); $p += 12; $len-=12; } # even if len==0 we need another round to mix in the length ($x,$y,$z) = unpack 'LLL', substr($_[KEY] . (chr(0)x12), $p, 1 +2); $z<<=8; # /* the first byte of c is reserved for the length * +/ $z+=$length; $a+=$x;$b+=$y;$c+=$z; mix($a, $b, $c); my $hex = unpack("H*", pack("N", $c)); return $hex; } # jhash_pp_hex use Config; if ( $Config{ivsize} == 4 ) { *main::mix=*main::mix4; } else { *main::mix=*main::mix8; } } # has use integer/bytes print jhash_pp_hex('abcdef',0)."\n";

    I had a situation where i could not use Digest::JHash because i did not have access to a compiler.

    I needed to hash filenames for a filetracking program using a mysql database. Rather than carry the filename in 4+ tables i use a unique fnid assigned in a fnid table that holds the filename in a text bucket.

    As you cannot really index a text field i was originally using md5 on the filename as a key. I knew there can be collisions but that to select a single filename SELECT fnid FROM fnid WHERE fnmd5=? and fn=? would do ok if fnmd5 was a index.

    But md5 in hex is 32 chars, and that was real big, bigger than i needed. So i searched for 32 bit hashs, found the jenkins variants and found Re: Fast string hash in portable perl? [DO NOT USE!] by BrowserUk so i decided to try that. My disappointment will be described in a separate reply thread about the history below [history] Pure perl Jenkins 32 bit Hash.

    This also calls into question what to do about Digest::JHash, again i will use a separate reply thread [Digest::JHash problem] Pure perl Jenkins 32 bit Hash to talk about that.

    Overall i am happy with this. I realize there are newer jenkins and other 32bit hashs, but this will do. It reduced the phpmyadmin reported size of the fnid table by 50%. It is fast enough for my needs, it seems to be the hash perl uses for its hashs.

perl modules
6 direct replies — Read more / Contribute
by codestroman
on Nov 16, 2017 at 03:56

    Hi im new to perl, and im currently trying to create, and run my own module.

    Here is my module code .pm file

    #!/bin/usr/perl use warnings; sub dog { print "roof roof im a dog!\n"; } dog; 1;

    and here is my .pl file to run the simple module.

    #!/usr/bin/perl use lib '.'; use dog; dog;

    Every-time i try to run the code i get this message

    $ perl Can't locate in @INC (you may need to install the dog module) ( +@INC contains: . /usr/lib/perl5/site_perl /usr/share/perl5/site_perl /usr/lib/perl5/vendor_perl /usr/share/perl5/vendor_perl /usr/lib/perl5 +/core_perl /usr/share/perl5/core_perl) at line 4. BEGIN failed--compilation aborted at line 4.


    2017-11-17 Athanasius added code and paragragh tags

Generating a range of Unicode characters
3 direct replies — Read more / Contribute
by mldvx4
on Nov 16, 2017 at 00:36

    I'd like to generate a span of Unicode characters. I am clearly missing some understanding about working with Unicode. The following produced no output except for a newline:

    perl -Mutf8 -e 'binmode(STDOUT, ":utf8"); $a=join("", "\x{DF}" .. "\x{0101}"); print "$a\n";'

    That style worked fine with the ASCII range, join("", "A" .. "Z"); but maybe I was doing it wrong there too. So what is a correct way to generate a string consisting of a span of Unicode characters?

I want to change something in this code
3 direct replies — Read more / Contribute
by hegaa
on Nov 15, 2017 at 23:12


    I'm using this sip scanner

    I want to make it take ips form a text file not to give it an ip range

    i want to put a list of ips in text file

    Like :


    this is the code

    #!/usr/bin/perl # TODO: # - SIP over TCP and TLS # - mass INVITE use Getopt::Std; use Socket; use IO::Socket::INET; use IO::Select; use Time::HiRes qw(time); use Digest::MD5 qw(md5_base64); #use Date::Format; use IP_iterator; $udp_maxlength = 100000; $lport = $rport = $ARGV[1]; # default ports $delay = 1; $wait = 1; sub HELP_MESSAGE { print <<EOH Usage: sip-scan [options] <network spec> -v Be verbose. -i ip|if Interface/IP for SIP-headers (default: IP from ppp0) -p port remote port to scan. (default: 5060) -l port local origin of packets. (default: 5060) -d n[p] Wait n ms after each sent packet (default: 50ms) or if 'p' +is given, send n packets per second (default: 20) -w n Wait n ms for remaining answers (default: 2000ms) Network spec contains the wildcard * or ranges n-m. EOH } sub verbose { if ($opt_v) { print $_[0]; } } sub scan_host { my $ip = shift; my $callid = md5_base64("$myip:$ip"); $callid =~ s/[^a-zA-Z1-9]//g; my $fromtag = 1000000000 + int(rand(1000000000)); my $cseq = 60000 + int(rand(5001)); my $branch = md5_base64("$callid"); $branch =~ s/[^a-zA-Z1-9]//g; my $sip = <<SIP; OPTIONS sip:foobar\@$ip SIP/2.0\r To: test <sip:foobar\@$ip>\r From: sip-scan <sip:sip-scan\@$myip>;tag=$fromtag\r Via: SIP/2.0/udp $myip;branch=$branch CSeq: $cseq OPTIONS\r Call-ID: $callid\\r Max_forwards: 70\r Date: Fri Oct 14 17:48:37 GMT+01:00 2005\r Contact: <sip:foobar\@$myip>\r Content-Type: application/sdp\r Content-Length: 0\r \r SIP my $toaddr = pack_sockaddr_in($rport, inet_aton($ip)); $udp->send($sip, 0, $toaddr); } sub recvsip { my $sock = shift; my $addr = $sock->recv(my $msg, $udp_maxlength); my ($port, $ip) = sockaddr_in($addr); $ip = inet_ntoa($ip); if ($msg =~ /^User-Agent:[ ]*(.*)$/mi) { print "$ip:$rport $1\n"; } } sub start_scan { my $ips = IP_iterator->new($ARGV[0]); my $done = 0; while (1) { my $ip = $ips->next; if (defined $ip) { scan_host($ip); verbose "Scan $ip\n"; $rdelay = $delay; } elsif ($done == 0) { # just wait a few seconds for re +maining answers verbose "Done...waiting for remaining answers!\n"; $rdelay = $wait; $done = 1; } if ($done == 0) { # never reset timer after last sent packe +t $rdelay > 0 or $rdelay = $delay; } my $t = time(); # print "$rdelay\n"; my @ready = $sel->can_read($rdelay); my $tdiff = (time() - $t); # print "tdiff=$tdiff\n"; my $rdelay = $rdelay - $tdiff; if ($done == 1 && $rdelay - 0.000001 <= 0) { return } foreach my $sock (@ready) { if ($sock == $udp) { # incoming UDP recvsip($sock); } } } } sub setip { my $iface = shift; if ($iface =~ /[0-9\-\*]+(?:\.[0-9\-\*]+){3}/) { return $iface } # i +s already ip my $ifconfig = `ifconfig $iface`; verbose "Using interface $iface\n"; $ifconfig =~ /inet[a-zA-Z ]*:([0-9\.]+)/; # verbose $ifconfig; return $1; } $Getopt::Std::STANDARD_HELP_VERSION = 1; getopts('vl:p:d:i:w:'); !defined $opt_l or $lport = $opt_l; !defined $opt_p or $rport = $opt_p; !defined $opt_w or $wait = $opt_w; if (defined $opt_d) { if ($opt_d =~ /([0-9]+)p/) { # packet rate given $delay = int(10 / $1) } else { # ms given $delay = $opt_d; } } $delay /= 10; $opt_i = defined $opt_i ? $opt_i : "ppp0"; $myip = setip($opt_i); $ARGV[0] =~ /[0-9\-\*]+(?:\.[0-9\-\*]+){3}/ or die "Not allowed netspe +c!"; verbose "Using own IP $myip\n"; $udp = IO::Socket::INET->new( Proto => "udp", LocalPort => "$lport", PeerPort => "$rport" ) or die "Cannot create UDP socket: $@"; $sel = IO::Select->new($udp); start_scan();
Strange behaviour of tr function in case the set1 is supplied by a variable
5 direct replies — Read more / Contribute
by likbez
on Nov 15, 2017 at 21:50
    Looks like in tr function a scalar variable is accepted as the fist argument, but is not compiled properly into set of characters
    $str1='abcde'; $str2='eda'; print "Test 1: strait set\n"; $diff1=$str1=~tr/$str2//; $diff2=$str1=~tr/eda//; print " diff1=$diff1, diff2=$diff2\n"; print "Test 2: complement set\n"; $diff1=$str1=~tr/$str2//c; $diff2=$str1=~tr/eda//c; print " diff1=$diff1, diff2=$diff2\n";
    This produces in perl 5, version 26:
    Test 1: strait set diff1=0, diff2=3 Test 2: complement set diff1=5, diff2=2

    Obviously only the second result in both tests is correct.

    Looks like only explicitly given first set is correctly compiled.

    Is this a feature or a bug ?

what's mean Options for specifying or deriving the key?
2 direct replies — Read more / Contribute
by serpino
on Nov 15, 2017 at 21:20

    I'm trying to encrypt perl script by using Filter::Crypto package with strawberry perl.

    So I'm installing refered ""

    I can see "Options for specifying or deriving the key?" while installing Filter::Crypto?

    there are 4 options.

    1 Enter a password when prompted

    2 Have a password randomly generated

    3 Enter a key when prompted

    4 Have a key randomly generated

    the default install setting is 2.

    when I sellect 1, I have to input password like 1234.

    But after finishing to install, There are no different to selecting 2.

    If when I sellect 3, I have to input key value. But I can't pass to next step because command console requires to input key continuously.

    Finally, I want the encrypted perl file can't decrypt on other PC.

    So I guess upper key or password setting is for that can't decrypt on other PC.

    Could you please explain this?

    Best Regards,


Access to standard module source code?
2 direct replies — Read more / Contribute
by chengchl
on Nov 15, 2017 at 18:08

    Hi Perl Experts

    I was wondering whether we have chance to look at the source code of the Perl standard modules like List::MoreUtils?

    I used some built-in functions and was amazed by how they work that well. Would be of great interest and curiosity to see what is inside but I searched online didn't get my luck. Any one knows? Thanks in advance!

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.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others chilling in the Monastery: (5)
    As of 2017-11-21 02:52 GMT
    Find Nodes?
      Voting Booth?
      In order to be able to say "I know Perl", you must have:

      Results (294 votes). Check out past polls.