Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl Monk, Perl Meditation

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
IO::Socket reconnect
1 direct reply — Read more / Contribute
on Feb 13, 2016 at 16:34

    Hi all. I wrote a script for my hosts which collects data and send it to a server. Script opens network socket and wait for a connection from monitoring application. After connection my script starts to send data to an open socket. The issue is that if remote side disconnected, script returns "Broken pipe" and die while I suppose it to wait connection again. Could someone help with it ? Here is the snippet:

    #!/usr/bin/env perl use 5.010; use warnings; use strict; use Net::Ping; use Getopt::Std; use IO::Socket; my $proto; # ping protocol my $host; # remote host my $bind_addr; # local ip interface to bind my $bind_port; # local port to bind my $monitoring_node; # monitoring status node my $monitoring_name; # cantain formatted remote host name to +insert into a monitoring node my %options=(); # hash to work with options my $result; # ping probe result my $latency; # latency to remote host my $sock; # network sockect object my $agent_socket; # network sockect object my $interval; # delay between checks $|=1; # Getting options getopts("p:h::n:i:s:d:", \%options); sub CheckArgs() { # Checking for non-mandatory options if (defined ($options{p})) { $proto = $options{p}; } else { $p +roto = "tcp"; }; if (defined ($options{i})) { $bind_addr = $options{i}; } else +{ $bind_addr=""; }; if (defined ($options{s})) { $bind_port = $options{s}; } else +{ $bind_port = "9906"; }; if (defined ($options{d})) { $interval = $options{d}; } else { + $interval = "5"; }; # Checking for mandatory options if (defined ($options{h}) && defined ($options{n})) { $host = $options{h}; $monitoring_node = $options{n}; &Main; } else { &PrintHelp; exit 1; } } sub PrintHelp() { print "Latency monitor v1.5.1\nOptions:\n -p Ping protocol +to use: tcp(default), udp, icmp(requires root)\n -h Destination ho +st. IP or DNS name can be specified. Mandatory option, no have defaul +t value\n -n status node to report. Mandatory option, no default v +alue\n -d Delay between checks in seconds. Default value 5\n -i + IP interface to bind. Default value\n -s Socket to bind. +Default value 9906\n"; exit; } sub Main() { # New network socket instance $sock = new IO::Socket::INET ( LocalHost => "$bind_addr", LocalPort => "$bind_port", Proto => 'tcp', Listen => 5, Type => SOCK_STREAM, Reuse => 1 ) or die "Can't create socket: $!\n"; # New ping instance my $ping = Net::Ping->new("$proto") or die "Can't initialize ping: $!\n"; $monitoring_name = $host; $monitoring_name =~ s/\./-/; $agent_socket = $sock->accept(); # Main loop while (42) { ($result,$latency) = $ping->ping($host); $latency *= 1000; $latency =~ s/\.\d+//; print $agent_socket $monitoring_node . ".lmonitor." . +$monitoring_name . ".rtt.value=" . $latency . "\n"; sleep $interval; } $sock->close; } &CheckArgs;
How to findout a sub string from the string
3 direct replies — Read more / Contribute
by gjoshi
on Feb 13, 2016 at 12:48
    Hi all I have string like
    $tmp = "1: 2\n2: /my/tmp/20160213T161519/outgoing\n3: DL\n4: 0\nTempSo +urce: , Ue: 2, TaskName=, TempDest: \nTaskName \n/data/busybox/ps |gr +ep mgen5| grep -v grep\nDL txt is running PID: 3848\nRunning:Mgen:384 +8";
    I would like to just get string "Running:Mgen:3848" and store it in a variable so that I can do come post processing. thanks --girija
multi level hash terror - if statement to access specific elements
2 direct replies — Read more / Contribute
by hungrysumo79
on Feb 12, 2016 at 20:29

    Hi Monks, I have a multi level hash from a db call of employees details. I can print it out and am working on querying specific employees. Problem is that when I query one, I get all records returned...I just want to return "Gay" last name.. How can I return just one record from the final if statement. I think its because its in the foreach Please help wise monks..

    #!/opt/local/bin/perl use DBI; use DBD::mysql; use Data::Dumper;; use strict; my %names=(); my $driver = "mysql"; my $database = "employees"; my $dsn = "DBI:$driver:database=$database"; my $userid = "hungrysumo"; my $password = ""; my $dbh = DBI->connect($dsn, $userid, $password ) or die $DBI::errstr; my $sth = $dbh->prepare("SELECT * FROM employees" ); $sth->execute() or die $DBI::errstr; print "Number of rows found :" + $sth->rows; while (my @row = $sth->fetchrow()) { $names{$row[0]}{$row[1]} = [$row[2],$row[3],$row[4],$row[5]];#print Du +mper \%names; } $sth->finish(); for my $key (keys %names){ #print "Employee Number:$key\n"; for my $key2(keys $names{$key}){ #print "Birth Date:$key2\n"; print "First Name:".$names{$key}{$key2}[0], "\n"; #print "Last Name:".$names{$key}{$key2}[1], "\n"; #print "Gender:".$names{$key}{$key2}[2], "\n"; #print "Hire Date:",$names{$key}{$key2}[3],"\n"; if ($names{$key}{$key2}[0] = 'Gay'){ print "Last Name:".$names{$key}{$key2}[1]."\n"; } } }
Perl AWS Error
3 direct replies — Read more / Contribute
by cbtshare
on Feb 12, 2016 at 14:08

    Hey all, I am using the perl AWS api( to make a script, the module is installed, but when I run a sample script, I am getting the error below.I search on google and cant seem to find anything wrong.Can anyone assist? Thank you

    Can't call method "architecture" on an undefined value at line +18.
    #!/usr/local/perl-5.23.3/perl use strict; use warnings; use VM::EC2; my $ec2 = VM::EC2->new(-access_key => "5454fgfffh", -secret_key => "dscsdcsd", -endpoint => ' ); #Get image my $image = $ec2->describe_images('ami-469e1d2a'); # get some information about the image my $architecture = $image->architecture; my $description = $image->description; my @devices = $image->blockDeviceMapping; for my $d (@devices) { print $d->deviceName,"\n"; print $d->snapshotId,"\n"; print $d->volumeSize,"\n"; }
ARP poisoning and redirection
1 direct reply — Read more / Contribute
by QuillMeantTen
on Feb 12, 2016 at 12:24

    Greetings fellow monks
    First thing, I am aware of this post so before anyone jumps the gun and beats me bloody I'd like to say a few words:
    Even though I am most interested in computer security (in fact I'm planing to start a masters degree in that field next year) I did not write this script with wanton destruction in mind, just mischievous curiosity (ain't it worse?).
    The idea came to me after other students told me that during the networking workshops at uni great pranks were to be played on unsuspecting marks : since all computers shared the same login and password one could decide to log into someone else's computer and either eject the legitimate user or reboot the machine.
    So I thought, hey, iptables exists for one reason but turning the (ip)tables on the prankster might be fun too (at least having fount out how to do so). I came up with the following code, which
    I do not intend to use on any network that is not mine to own and rule other as I see fit meaning made of machines I own as in paid for.
    The idea behind it is quite simple:

    1. Populate a hash with all the ip/mac couples to be found on the local segment
    2. create a log and drop chain in iptables for tcp packets on port 22
    3. filter /var/log/messages for the word "ATTACK"
    Upon an attack here is what happens:
    1. A random mac/ip couple is selected from the hash
    2. ARP replies are sent to the prankster, telling him my ip address is mapped to the random mac selected
    3. To prevent the periodic refresh of the arp cache (default 60 seconds, according to this), arp replies are sent to the target machine telling it the prankster's machine is at aa:bb:cc:dd:ee:ff (killing two birds with one stone, if my script worked the prankster would not be able to do much harm since any attempts at a tcp handshake would fail because of this, of course ping floods exist too)
    4. Sinceres replies from my own system are prevented (the echo part to arp_ignore
    Alas, even after rereading my course material on the arp protocol (which is scant to say the least) and searching the internet for informations on the behaviour of linux systems when it comes to it I cant answer the question that bugs me most:

    Even though wireshark indicates that the packets are correctly sent (and even warns me of duplicate macs for the same ip address during the capture) the arp cache of the machine I am using to trigger the script is not updated with the random mac.

    So here I come, looking for your wisdom and hoping to learn more on this topic.

    And the code I came up with:
    It is one my first attempts at using module starter instead of single file scripts so I would also be grateful for informations and advice regarding my code layout/style

Help me beat NodeJS
6 direct replies — Read more / Contribute
by rickyw59
on Feb 12, 2016 at 12:09

    Hello, I'm trying to write a script to go through hundreds of "log.gz" files, roughly 500,000 lines per file. Is there something limiting me? How can perl do a single file 3 times faster, but when I start forking perl's performance tanks? Below are the results of timing the parsing of a single file. When timing 70 files, nodejs takes 20 seconds and perl is at 60 seconds.

    zcat &> /dev/null 0.54s user 0.01s system 99% cpu 0.549 total node test.js 0.79s user 0.05s system 130% cpu 0.646 total perl 0.23s user 0.03s system 38% cpu 0.686 total

    I've tried forking for each file (limited to the number of cpus(24)). I've also tried dividing the logs by number of forks evenly, IE fork 24 times and each fork works n number of files, some how this was slightly slower. Both node and perl are spawning zcats and parsing line-by-line. I'm unable to use zlib, due to the files being zipped in-correctly by the device generating the logs.

    *Edit: the directory is an nfsv3 mounted SAN. For tests, I'm only reading, no printing so IO on the test server should not be an issue. Also both node and perl tests are being run in the same environment.

    #!/usr/local/bin/perl use strict; use warnings; use Parallel::ForkManager; my $pm = new Parallel::ForkManager(24); my $dir = '/data/logs/*.log.gz'; my @files = sort(glob "$dir"); for my $file(@files) { $pm->start and next; open(FH,"-|") || exec "/bin/zcat", $file; while(my $line = <FH>){ my @matches = $line =~ /".*?"|\S+/g; # print "$matches[0],$matches[1],$matches[3],$matche +s[4]; #matches[0] = date, matches[1] = time, matches[3] = source IP #matches[4] = dest IP, some other matches are used or may be used. #line is space seperated, but any field with a space is inside "", hen +ce regex instead of split. } $pm->finish; } $pm->wait_all_children;
perl with Oracle indices
3 direct replies — Read more / Contribute
by Anonymous Monk
on Feb 12, 2016 at 09:16
    I had a job interview the other day were the question was postedL "how do you use Perl to see the efficiency of an Oracle table index" Is this possible?
Problems with RHEL7 and multi-function modules
2 direct replies — Read more / Contribute
by sleddergirl
on Feb 12, 2016 at 08:37

    We are testing a new Linux server running RHEL7 and Perl5. My Perl program (code snippet below) dies on the 'use SSSourceOrg' line (code snippet also below). This is a home-grown module as is Syslog. The difference I found between Syslog and SSSourceOrg is that Syslog has 1 function and SSSourceOrg has multiple functions. The error is "Can't locate in @INC (@INC contains: /usr/local/lib64/perl5...)". The module isn't and shouldn't be part of @INC and it does exist in my PERL5LIB path. I changed so that it now has only 1 function and I changed the perl program so the use line is just 'use SSSourceOrg;' and the program gets by the line successfully and dies on the next line. I'm not a Perl developer so I'm hoping that someone else has run into this problem and can tell me how to fix it without changing all of our modules to be single-function. #!/usr/bin/perl use English; use POSIX qw( :stdlib_h strftime getcwd ); use Getopt::Std; use FileHandle; use strict vars; use File::Basename; eval "use CVSClient"; use Syslog; # homegrown version use SSSourceOrg qw( getLibExts getLibDirs ); use SSMail qw( send );
    package SSSourceOrg; use strict; use POSIX qw( :stdlib_h ); use Cwd; use File::Basename; use English; use UserIO qw( getStrUntilMatch ); require Exporter; use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 1.01; @ISA = qw( Exporter ); @EXPORT = (); %EXPORT_TAGS = (); @EXPORT_OK = qw( getValidModule getSSROPath getSSEditPath getPaths getRefRoot getEditRoot getQARoot getCommittedLibRoot getLinkedDir getLibExts getLibDirs getLibRegex isCopybook isCobolProgram buildcobcpy ); my @libExts = qw( LIB UNQ PRC HVD WS IO ); #my @libDirs = qw( lio lib lci lga lhv lxf ); my $libRegex = "(\\." . join( "|\\.", @libExts ) . ")"; sub getLibExts(){ return( @libExts ); } 1;
using perlbrew with apache
2 direct replies — Read more / Contribute
by Dave Howorth
on Feb 12, 2016 at 06:41

    I'm trying to use perlbrew with apache and my head hurts!

    I have a machine where I don't want to use the system perl with my applications, so I've installed perlbrew. It works fine for me, and it works fine for another user sharing my installation, but I can't figure out how to make it work for apache CGI scripts.

    I know this is a question that's been asked lots of times in various places, because google tells me so. But I haven't found any articles that answer all my questions.

    The first stumbling block of course is that apache doesn't have a login account, so can't setup perlbrew in the normal way. So the common wisdom appears to be to use the shebang line in the CGI scripts to hardwire a particular perlbrew perl. So OK, it feels a bit clunky because I have to modify every script every time I change perls, but hey. So I do that and discover that now it can't find the modules so I add a bunch of use lib statements to the scripts as well.

    That gets the script running, but all the script does is massage its arguments and 'system' an actual application program. So I add another hack that discovers the perl running the script and adds that to the 'system' call that runs the application. And after doing some tweaking to satisfy taint, that works too. But I have a nagging worry about which libraries it's using and it all feels kludgy.

    Except that the application program in turn executes various other applications in some circumstances, so before I can investigate my library doubts I'm faced with yet another case of the wrong perl.

    Now sure I could edit my application and however many other applications until it all works, but there's really got to be a better way! It feels like I'm falling down the rabbit hole. So I thought before I dive off and explore all kinds of wacky possibilities, I'd supplicate myself at the gates of the monastery and ask pretty please if anybody already knows a good way to do this?

WWW::Mechanize::Firefox hangs when jquery element clicked
1 direct reply — Read more / Contribute
by nysus
on Feb 12, 2016 at 06:13

    I've got a form in WordPress that uses the "Chosen" jquery plugin for drop down <select> fields. I'm having a tough time automating these fields with WWW::Mechanize::Firefox. The website for the plugin is here.

    When I click on the div tag associated with the drop down, it just hangs. Here is the code I'm using to click on it:

    $mech->click({xpath => '//div[@id="saved_venue_chosen"]'}, synchronize + => 0);

    The synchronize => 0 bit is supposed to prevent the script from waiting for a response from the server. However, I'm thinking that because clicking on the div tag causes jquery to change the classes of the div tag, it might be confusing WWW::Mechanize::Firefox.

    I tried this:

    my $i = $mech->xpath('//div[@id="saved_venue_chosen"]', one => 1); + $i->__event('focus'); $i->__event('click');

    It didn't work. Any other workarounds I might try?

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

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 the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others wandering the Monastery: (7)
    As of 2016-02-14 07:24 GMT
    Find Nodes?
      Voting Booth?

      How many photographs, souvenirs, artworks, trophies or other decorative objects are displayed in your home?

      Results (460 votes), past polls