I've been modernizing an old tool used to run commands on multiple servers at once. We have a port check function that forks on an array of servers to perform a port check and then returns passed and failed nodes. I'm not sure if the way the functions are written are the most efficient way to perform this task and am seeking advice from all of you. The while statement used also adds an empty key and value to the results hash. Also please assume I have no access to install anything from CPAN.

my $SELECT     = IO::Select->new();
my $forks      = 100;

sub portcheck {
    my ( $checknodes, $port, $forks, $longest, $verbose ) = @_;

    # Hashes to store results and good/bad arrays
    my ( %threads, %results, $pid, $node );
    my ( @goodnodes, @badnodes );

    # Set default port to 22
    if ( !$port ) { $port = '22'; }

    # Destroyable copy of the list of nodes.
    my @checks = @{$checknodes};

    # Set forks properly
    if ( !$forks ) { $forks = $fanout; }
    $forks = ( $forks > scalar @checks ) ? scalar @checks : $forks;

    # Fork initial threads
    for ( 1 .. $forks ) { forkportcheck( shift @checks, \%threads, $po
+rt ); }

    # Prepare to display results in order
    my $resindex = 0;

    # Wait for a process to complete
    while ( ( $pid = wait ) > 0 ) {

        # store result of the port check
        $results{ $threads{$pid} } = ( $CHILD_ERROR == 0 );

        # delete the completed thread
        delete $threads{$pid};

        # Fork a new thread if there are still nodes to run
        if ( scalar @checks ) {
            forkportcheck( shift @checks, \%threads, $port );
        }
        no warnings 'uninitialized';
        #store and print the results for completed threads
        while ( defined $results{ $checknodes->[$resindex] } ) {
            $node = $checknodes->[ $resindex++ ];
            if ( $results{$node} ) {
                push @goodnodes, $node;
                if ($verbose) {
                    printf {*STDERR} "%-${longest}s: ssh port check pa
+ssed\n",
                      $node;
                }
            }
            else {
                push @badnodes, $node;
                if ($verbose) {
                    printf {*STDERR} "%-${longest}s: ssh port check fa
+iled\n",
                      $node;
                }
            }
        }
    }
    if ($verbose) { say {*STDERR} q{}; }
    return ( \@goodnodes, \@badnodes );
}

sub forkportcheck {
    my ( $node, $threads, $port ) = @_;

    # Ensure node is defined
    if ( !$node ) { return 0; }

    # Fork the process -- we just need the return code.
    my $pid = fork;
    if ( !defined $pid ) { croak "Fork didn't work $ERRNO"; }

    # is this the child
    if ( $pid == 0 ) {

        # Perform socket connection
        my $sock = IO::Socket::INET->new(
            PeerAddr => $node,
            Timeout  => 1,
            PeerPort => $port,
            Proto    => 'tcp',
        );

        # Exit 0 if get a socket. Else exit 1
        if ($sock) {
            close $sock or carp $ERRNO;
            exit 0;
        }
        exit 1;
    }

    # store the node name for the pid in the threads
    $threads->{$pid} = $node;
    return $pid;
}
[download]

---

---

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! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, 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, summary, 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:
	&		&
	<		&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.