Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

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
Move all files and folders older than 5 minutes
1 direct reply — Read more / Contribute
by omegaweaponZ
on May 01, 2015 at 07:18
    Hey there, I'm looking to move all files and folders from one directory to another, but I don't just want a full instant directory move. I'm looking to individually scan each file and folder from a parent directory and, keeping the sub-folder structure intact, only move them if they are older than 5 minutes of being modified to a new directory. So something like this:
    $dir = '/current/directory/'; $newdir = '/new/directory/'; find(\&movefiles, $dir); sub movefiles { $move_file = $File::Find::name; $move_curDir = $File::Find::dir; $move_curFile = $_; $move_basedir = dirname($move_curDir); $file_time = (stat($move_file))[9]; $current_time = time; $time_dif = $current_time - $file_time; if ($time_dif <= 300) { #Ignore } else { #Move my $new_file = $move_file; $new_file =~ s/old_folder/new_folder/; copy("$move_file","$new_file") or die "Copy failed: $!";
    After this, I'm looking to actually move the files and sub-folders of those files from the base current directory to the new current directory. Any thoughts? Thank you!
how to report error when remote commands fail
2 direct replies — Read more / Contribute
by janasec
on May 01, 2015 at 06:51

    how to report error when remote commands fail

    here is the sample of my script iam trying to run on remote systems and execute commands

    #!/usr/bin/perl -w use strict; use Net::SSH::Perl; my $hostname = ""; my $username = "root"; my $password = "Pass1234"; my $cmd = 'ls'; my $cmd1 = 'ling -c 2 -q'; my $cmd2 = 'ping -w 3'; my @cmds = ($cmd , $cmd1, $cmd2); my $ssh = Net::SSH::Perl->new("$hostname", debug=>0); $ssh->login("$username","$password"); foreach my $one(@cmds) { my ($stdout,$stderr,$exit) = $ssh->cmd("$one") ; print $stdout; }

    the stdout is outputting "bash: ling: command not found " for the $cmd1 but if the commands fail and then the script should warn me

    here below is the output

    suse@linux-p9uj:~/junk/vm> ./ anaconda-ks.cfg bash: ling: command not found PING ( 56(84) bytes of data. 64 bytes from icmp_seq=1 ttl=57 time=125 ms 64 bytes from icmp_seq=2 ttl=57 time=52.1 ms 64 bytes from icmp_seq=3 ttl=57 time=211 ms --- ping statistics --- 3 packets transmitted, 3 received, 0% packet loss, time 2003ms rtt min/avg/max/mdev = 52.113/129.706/211.260/65.033 ms

    what iam trying to finally achieve is to run the script and see all the logs and errors in one place

HTTP::Server::PSGI outputs broken utf-8 strings
1 direct reply — Read more / Contribute
by Anonymous Monk
on May 01, 2015 at 02:22
    Even with meta charset utf-8 tag, It is not working How can I encode it?
parse string containing space
2 direct replies — Read more / Contribute
by mtovey
on Apr 30, 2015 at 23:50

    So, this is yet another string parsing question that has probably been asked before, but I am so far unable to find a solution.

    I have a string that looks like the following:

    "name1=value1 name2=' value2=0' name3=value3"

    I need a loop that will break each pair into two scalars, $name and $value, and process them. The killer for me is the "name2=' value2'" pair. I need that leading space for value2 to be included into $value.

    So far I am ending up with $name set to "name2" and $value set to "'" during one iteration of the loop, and $name set to "vlaue2" and $value set to "0'" during the next iteration. What I am expecting is $name set to "name2" and $value set to " value2=0" during one iteration.

    I assume that a regular expression can be written for this, but my perlre is pretty thin right now. Any help will be greatly appreciated!


Issues connecting android GCM CCS using perl
1 direct reply — Read more / Contribute
by kamrul
on Apr 30, 2015 at 19:42
    I am trying to connect to GCM CCS server using the below script:
    #!/usr/bin/perl use Net::XMPP; my $con = Net::XMPP::Client->new( debuglevel => 5, debugfile => "stdout", debugtime => 1 ); print "trying ... \n"; my $status = $con->Connect( hostname => '', connectiontype => 'tcpip', port => 5236, tls => 1 ssl_ca_path => '/etc/ssl/localcerts/gcm.key' ); die('ERROR: XMPP connection failed') if ! defined($status); $con->Disconnect();
    I am getting the below error: Anybody tried connecting CCS with perl. What wrong am I doing ?
    [17:25:00] XML::Stream: new: hostname = ( [17:25:00] XML::Stream: SetCallBacks: tag(node) func(CODE(0x90fe390)) [17:25:00] XMPP::Conn: xmppCallbackInit: start [17:25:00] XMPP::Conn: SetCallBacks: tag(message) func(CODE(0x90fe530) +) [17:25:00] XMPP::Conn: SetCallBacks: tag(presence) func(CODE(0x90fe4b0 +)) [17:25:00] XMPP::Conn: SetCallBacks: tag(iq) func(CODE(0x90fe3e0)) [17:25:00] XMPP::Conn: SetPresenceCallBacks: type(subscribe) func(CODE +(0x90fe4a0)) [17:25:00] XMPP::Conn: SetPresenceCallBacks: type(subscribed) func(COD +E(0x90fe6f0)) [17:25:00] XMPP::Conn: SetPresenceCallBacks: type(unsubscribe) func(CO +DE(0x90fe670)) [17:25:00] XMPP::Conn: SetPresenceCallBacks: type(unsubscribed) func(C +ODE(0x90fe770)) [17:25:00] XMPP::Conn: SetDirectXPathCallBacks: xpath(/[@xmlns="urn:ie +tf:params:xml:ns:xmpp-tls"]) func(CODE(0x90fe6e0)) [17:25:00] XMPP::Conn: SetDirectXPathCallBacks: xpath(/[@xmlns="urn:ie +tf:params:xml:ns:xmpp-sasl"]) func(CODE(0x9102ba8)) [17:25:00] XMPP::Conn: xmppCallbackInit: stop trying ... [17:25:00] XMPP::Conn: Connect: host( +namespace(jabber:client) [17:25:00] XMPP::Conn: Connect: timeout(10) [17:25:00] XML::Stream: Connect: timeout(10) [17:25:00] XML::Stream: Connect: type(tcpip) [17:25:00] XML::Stream: Connect: Got a connection [17:25:00] XML::Stream: MarkActivity: sid(newconnection) [17:25:00] XML::Stream: Send: (<?xml version='1.0'?><stream:stream ver +sion='1.0' xmlns:stream='' xmlns='jab +ber:client' to='' from='' xml: +lang='en' >) [17:25:00] XML::Stream: Send: sid(newconnection) [17:25:00] XML::Stream: Send: status(0) [17:25:00] XML::Stream: Send: socket(IO::Socket::INET=GLOB(0x90fe580)) [17:25:00] XML::Stream: Send: can_write [17:25:00] XML::Stream: Send: SENDWRITTEN(196) [17:25:00] XML::Stream: Send: no exceptions [17:25:00] XML::Stream: MarkActivity: sid(newconnection) [17:25:00] XML::Stream: Connect: can_read( ) [17:25:00] XML::Stream: Read: sid(newconnection) [17:25:00] XML::Stream: Read: connectionType(tcpip) [17:25:00] XML::Stream: Read: socket(IO::Socket::INET=GLOB(0x90fe580)) [17:25:00] XML::Stream: Read: buff() [17:25:00] XML::Stream: Read: status(0) [17:25:00] XML::Stream: Read: ERROR [17:25:00] XML::Stream: GetErrorCode: sid(newconnection) ERROR: XMPP connection failed at line 18.
processing a list of events
7 direct replies — Read more / Contribute
by BluePerlDev
on Apr 30, 2015 at 14:26

    So, I have an array of 2 types of events, and the times they occurred. I need to parse through the array and take teh time of the first Event A, and then find the first Event B after Event A, and calculate the time delta. using a simple grep on the array isn't a viable option because there could be multiple occurrences of Event A before there is an Event B, potentially looking like this:


    I had initially thought of using a for loop with a dual index, something that would look kinda like this:

    my $i = 0; my $j = $i; for ( $i ; $i <= $#eventlist ; $i++ ){ print "i is $i, j is $j\n"; my ($subj,$date) = split(',',$eventlist[$i]); if ( $subj eq "Event B" ){ while ( $subj ne "Event A" ){ $i++; ($subj,$date) = split(',',$eventlist[$i]); } print "i is $i, j is $j\n"; $j = $i; print "i is $i, j is $j\n"; my ($str,$date1) = split(',',$eventlist[$i]); my ($subj2,$x) = split(',',$eventlist[$j]); while ( $subj2 ne "Event B" ){ $j++; ($subj2,$x) = split(',',$eventlist[$j]);

    But that never finished, and stayed at the top 2 events of the array. I was looking at the List::Util and List::MoreUtils modules, for the first adn first_idx functions, but I can't see how to update the list to have the function move from the last occurrence it returned of Event A or Event B. and I really can't do foreach because it just goes blindly through the entire list, and I want to be able to skip through the list after I find an event, to get to the corresponding second event.

    Is there another iteration method I could be using, or a better set of list processing utilities? I have the Date::Manip module set up for teh date delta calculations, that was not hard. I just can't seem to get the list to process.

Sort string according to numbers in it
2 direct replies — Read more / Contribute
by Alexander75
on Apr 30, 2015 at 13:45
    Hello, I need to sort this king of string : Lee Morgan : 20 Clifford Brown : 3 Freddie Hubbard : 6 The way that C.B goes before L.M and F.H before L.M I really have no idea of to make it First I wanted to use a module that is able to find numbers, but I didn't find one After I wanted to use regexp But however the real problem reminds to know how to sort, because sort function only takes like just one kind of values
Perl-Tk copy/paste to X terminal
1 direct reply — Read more / Contribute
by dadenn
on Apr 30, 2015 at 10:37

    I am able to copy within a Perl-Tk application, but not able to paste externally to an X terminal window or a Konsole window. Within the Tk app, I am using ROText. I highlight the text with the mouse and upon Button-1 release, I have the text in a variable. I have tried the solutions in Mastering Perl-Tk, but to no avail. I may be overthinking this problem. I was under the impression that copy/paste should be pretty much automatic. I bind Button-1-release to capture the mouse event and use a callback. I have tried the clipboard commands but they don't work for me.

    Does anyone have ideas or sample code that works?

Help needed with Perl script designed to find files by extension and count the number of chars
5 direct replies — Read more / Contribute
by Griegomas
on Apr 30, 2015 at 08:28

    Thanks for all the help guys, I really appreciate it. I have gotten the script to work almost entirely except for one problem; it seems to be interpreting the . at the beginning of each extension as any character. This results in an extension like .h finding all files that end with h. I believe the solution is to use glob pattern matching but I am unsure how to incorporate that into my find statements. Here is my updated (and better indented) code:

    #!/usr/bin/perl use warnings; use File::Find; sub countThem { $dir = '.'; $filecount=0; $ext1=$_[2]; find(sub{$filecount++ if $File::Find::name =~ /$ext1$/}, $dir); $filebytes=0; if ($filecount > 0 ){ #`find . -name "*$_[2]" -print`; my @f; find ( sub { return unless /$ext1$/; push @f, $File::Find::name; },$dir); chomp(@f); foreach $a (@f){ $fbytes=`cat $a | wc -c`; $filebytes=$filebytes+$fbytes; }} $_[0]=$filecount; $_[1]=$filebytes; } foreach $ext (@ARGV){ $tmpfilecount=0; $tmpfilebytes=0; countThem ($tmpfilecount, $tmpfilebytes, $ext); if ( $tmpfilecount > 0 ){ print STDOUT ("EXTENSION $ext, FILE COUNT: $tmpfilecount, FILE + CHARS: $\ tmpfilebytes\n"); } }

    any ideas?

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.

    لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

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!
  • 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
  • Outside of code tags, you may need to use entities for some characters:
            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 about the Monastery: (4)
    As of 2015-05-04 00:49 GMT
    Find Nodes?
      Voting Booth?

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

      Results (79 votes), past polls