perl script to generate server round-robin assignments

[inetquestion]

#!/usr/bin/perl

##################
### Main Begin ###
##################

if ($#ARGV < 0) {
&DoUsage;
exit;
}

my ($hostname, $limit) = @ARGV; # Script inputs

if ($hostname =~ /^([\d]+)\.([\d]+)\.([\d]+)\.([\d]+)$/) { # Filter
on IP address
$hostString=$hostname; # Save IP
} else {
($hostString) = split /\./,$hostname; # Obtain first portion
of FQDN component
}

@B = qw(svr01 svr02 svr03 svr04 svr05 svr06); # Array containing
assignable server
$binaryNumber = DoAsc2bin($hostString); # Convert string
into base2
$binaryNumber =~ s/\s+//g; # Remove spaces
from base2 string
$decString = DoBin2dec($binaryNumber); # Convert base2
string to base10
$assignment = DoAssign(scalar(@B), $decString, $hostname, $limit); #
Call subroutine to get assignments

print "$hostname: $assignment\n";
exit;

########################
### Subroutine Begin ###
########################

sub DoUsage() {

print <<EOM;


Generates assignment values where servers in list-A need to
communicate with all or some of the servers in list-B. The input to
the script is a single server hostname or IP from list-A. This server
name will go through a conversion (ascII->Binary->Dec), then the order
of the assignments will be made. As long as no two servers have the
same hostname, the assignment will be varied across the list to ensure
the servers in List-B are distributed evenly across those in List-A.

Usage: $0 <hostname|IP> <entry limit>

EOM
}

sub DoAsc2bin { # Convert ASCII string to binary equivalent
my ($string) = @_; # Input
my @bytes; # Declare byte array
for (split //, $string) { # Run throuh for loop per character
of string being split
push @bytes, unpack "B8", $_; # Store binary equivalent of
each character into @bytes
}
return wantarray ? @bytes : join " ", @bytes; # Return @bytes or
a string of all content of @bytes
}

sub DoBin2dec {
return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); #
Converts binary string to decimal equivalent
}

sub DoAssign {
my ($numListB, $num, $host, $lim) = @_; # Function inputs
$lim ||= 100; # Set lim=100 unless otherwise specified
@B = reverse(@B); # Reverse array, then pop last
my $popNum = $num % $numListB; # Get modulus, then pop that
many elements from reversed array
while ( $popNum != 0 ) { #
Iterate until all values have been popped off array
push(@popSave, pop(@B)); # Save popped elements
$popNum--; # Decrement pop counter
}
@B = reverse(@B); # Reverse array
push(@B, @popSave); # Appennd popped elements to
reversed (original direction) array

for( $i = 0; $i < scalar(@B); $i++) { # Loop
through all array elements, maintain counter
if( $B[$i] eq $host ) { # Look for match
#print "Match on $host\n"; # Debug statement
@B = ($B[$i], @B[0..($i-1)], @B[($i+1)..scalar
(@B)]); # Modify array order by moving the "match" to front

last; # Move on
}
}
return join " ", @B[0..($lim-1)]; # Return space
deleimited string
}

 

[John W. Krahn]

#!/usr/bin/perl

use warnings;
use strict;

##################
### Main Begin ###
##################

if ($#ARGV < 0) {
&DoUsage;

if ( @ARGV < 1 ) {
DoUsage();

Or probably better as:

if ( @ARGV != 2 ) {
DoUsage();

exit;
}

my ($hostname, $limit) = @ARGV; # Script inputs

if ($hostname =~ /^([\d]+)\.([\d]+)\.([\d]+)\.([\d]+)$/) { # Filter

Why use capturing parentheses? Why put the \d character class inside a
character class?

if ( $hostname =~ /^\d+\.\d+\.\d+\.\d+$/ ) {

on IP address
$hostString=$hostname; # Save IP
} else {
($hostString) = split /\./,$hostname; # Obtain first portion
of FQDN component
}

@B = qw(svr01 svr02 svr03 svr04 svr05 svr06); # Array containing
assignable server
$binaryNumber = DoAsc2bin($hostString); # Convert string
into base2
$binaryNumber =~ s/\s+//g; # Remove spaces

Why does DoAsc2bin() add the whitespace if you are just going to remove it?

from base2 string
$decString = DoBin2dec($binaryNumber); # Convert base2
string to base10
$assignment = DoAssign(scalar(@B), $decString, $hostname, $limit); #

You should probably pass a reference to @B instead of using it globally.

Call subroutine to get assignments

print "$hostname: $assignment\n";
exit;

########################
### Subroutine Begin ###
########################

sub DoUsage() {

print <<EOM;


Generates assignment values where servers in list-A need to
communicate with all or some of the servers in list-B. The input to
the script is a single server hostname or IP from list-A. This server
name will go through a conversion (ascII->Binary->Dec), then the order
of the assignments will be made. As long as no two servers have the
same hostname, the assignment will be varied across the list to ensure
the servers in List-B are distributed evenly across those in List-A.

Usage: $0 <hostname|IP> <entry limit>

EOM
}

sub DoAsc2bin { # Convert ASCII string to binary equivalent
my ($string) = @_; # Input
my @bytes; # Declare byte array
for (split //, $string) { # Run throuh for loop per character
of string being split
push @bytes, unpack "B8", $_; # Store binary equivalent of
each character into @bytes
}
return wantarray ? @bytes : join " ", @bytes; # Return @bytes or

^^^^
Why are you adding these spaces if you don't really want them?

a string of all content of @bytes
}

sub DoBin2dec {
return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); #
Converts binary string to decimal equivalent
}

sub DoAssign {
my ($numListB, $num, $host, $lim) = @_; # Function inputs
$lim ||= 100; # Set lim=100 unless otherwise specified
@B = reverse(@B); # Reverse array, then pop last
my $popNum = $num % $numListB; # Get modulus, then pop that
many elements from reversed array
while ( $popNum != 0 ) { #
Iterate until all values have been popped off array
push(@popSave, pop(@B)); # Save popped elements
$popNum--; # Decrement pop counter
}
@B = reverse(@B); # Reverse array
push(@B, @popSave); # Appennd popped elements to
reversed (original direction) array

for( $i = 0; $i < scalar(@B); $i++) { # Loop
through all array elements, maintain counter
if( $B[$i] eq $host ) { # Look for match
#print "Match on $host\n"; # Debug statement
@B = ($B[$i], @B[0..($i-1)], @B[($i+1)..scalar
(@B)]); # Modify array order by moving the "match" to front

last; # Move on
}
}
return join " ", @B[0..($lim-1)]; # Return space
deleimited string
}

There is no need to reverse the contents of @B to get the same results:

sub DoAssign {
# Here $ListB contains a reference to @B
my ( $ListB, $num, $host, $lim ) = @_;

$lim ||= 100;

push @$ListB, splice @$ListB, 0, $num % @$ListB;

for my $i ( 0 .. $#$ListB ) {
if ( $ListB->[ $i ] eq $host ) {
#print "Match on $host\n"; # Debug statement
# Modify array order by moving the "match" to front
unshift @$ListB, splice @$ListB, $i, 1;
last;
}
}

return "@{ $ListB }[ 0 .. $lim - 1 ]";
}




John

 

[inetquestion]

inetquestionwrote:

#!/usr/bin/perl

use warnings;
use strict;

##################
### Main Begin ###
##################

if ($#ARGV < 0) {
    &DoUsage;

if ( @ARGV < 1 ) {
     DoUsage();

Or probably better as:

if ( @ARGV != 2 ) {
     DoUsage();

    exit;
}

my ($hostname, $limit) = @ARGV;                                    # Script inputs

if ($hostname =~ /^([\d]+)\.([\d]+)\.([\d]+)\.([\d]+)$/) {                 # Filter

Why use capturing parentheses?  Why put the \d character class inside a
character class?

if ( $hostname =~ /^\d+\.\d+\.\d+\.\d+$/ ) {

on IP address
      $hostString=$hostname;                                               # Save IP
} else {
     ($hostString) = split /\./,$hostname;                         # Obtain first portion
of FQDN component
}

@B = qw(svr01 svr02 svr03 svr04 svr05 svr06);                     # Array containing
assignable server
$binaryNumber = DoAsc2bin($hostString);                            # Convert string
into base2
$binaryNumber =~ s/\s+//g;                                                 # Remove spaces

Why does DoAsc2bin() add the whitespace if you are just going to remove it?

from base2 string
$decString = DoBin2dec($binaryNumber);                             # Convert base2
string to base10
$assignment = DoAssign(scalar(@B), $decString, $hostname, $limit); #

You should probably pass a reference to @B instead of using it globally.

Call subroutine to get assignments

print "$hostname: $assignment\n";
exit;

########################
### Subroutine Begin ###
########################

sub DoUsage() {

print <<EOM;

Generates assignment values where servers in list-A need to
communicate with all or some of the servers in list-B.  The input to
the script is a single server hostname or IP from list-A.  This server
name will go through a conversion (ascII->Binary->Dec), then the order
of the assignments will be made.  As long as no two servers have the
same hostname, the assignment will be varied across the list to ensure
the servers in List-B are distributed evenly across those in List-A.

Usage: $0 <hostname|IP> <entry limit>

sub DoAsc2bin {                                                   # Convert ASCII string to binary equivalent
    my ($string) = @_;                                                     # Input
    my @bytes;                                                             # Declare byte array
    for (split //, $string) {                                              # Run throuh for loop per character
of string being split
      push @bytes, unpack "B8", $_;                              # Store binary equivalent of
each character into @bytes
    }
    return wantarray ? @bytes : join " ", @bytes;                # Return @bytes or

                                        ^^^^
Why are you adding these spaces if you don't really want them?

a string of all content of @bytes
}

sub DoBin2dec {
    return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); #
Converts binary string to decimal equivalent
}

sub DoAssign {
    my ($numListB, $num, $host, $lim) = @_;        # Function inputs
    $lim ||= 100;                                                 # Set lim=100 unless otherwise specified
    @B = reverse(@B);                                     # Reverse array, then pop last
    my $popNum = $num % $numListB;                 # Get modulus, then pop that
many elements from reversed array
    while ( $popNum != 0 ) {                                       #
Iterate until all values have been popped off array
        push(@popSave, pop(@B));                   # Save popped elements
        $popNum--;                                         # Decrement pop counter
    }
    @B = reverse(@B);                                     # Reverse array
    push(@B, @popSave);                                   # Appennd popped elements to
reversed (original direction) array

    for( $i = 0; $i < scalar(@B); $i++) {                      # Loop
through all array elements, maintain counter
   if( $B[$i] eq $host ) {                                 # Look for match
            #print "Match on $host\n";                   # Debug statement
            @B = ($B[$i], @B[0..($i-1)], @B[($i+1)..scalar
(@B)]);       # Modify array order by moving the "match" to front

last;                                                       # Move on
        }
    }
    return join " ", @B[0..($lim-1)];                    # Return space
deleimited string
}

There is no need to reverse the contents of @B to get the same results:

sub DoAssign {
     # Here $ListB contains a reference to @B
     my ( $ListB, $num, $host, $lim ) = @_;

     $lim ||= 100;

     push @$ListB, splice @$ListB, 0, $num % @$ListB;

     for my $i ( 0 .. $#$ListB ) {
         if ( $ListB->[ $i ] eq $host ) {
             #print "Match on $host\n";          # Debug statement
             # Modify array order by moving the "match" to front
             unshift @$ListB, splice @$ListB, $i, 1;
             last;
             }
         }

     return "@{ $ListB }[ 0 .. $lim - 1 ]";
     }

John

Thanks for the suggestion; that clears up the questions I had. As i
was writing that I thought there must be an easier way to do
that...

 

[inetquestion]

inetquestionwrote:

#!/usr/bin/perl

use warnings;
use strict;

##################
### Main Begin ###
##################

if ($#ARGV < 0) {
    &DoUsage;

if ( @ARGV < 1 ) {
     DoUsage();

Or probably better as:

if ( @ARGV != 2 ) {
     DoUsage();

    exit;
}

my ($hostname, $limit) = @ARGV;                                    # Script inputs

if ($hostname =~ /^([\d]+)\.([\d]+)\.([\d]+)\.([\d]+)$/) {                 # Filter

Why use capturing parentheses?  Why put the \d character class inside a
character class?

if ( $hostname =~ /^\d+\.\d+\.\d+\.\d+$/ ) {

on IP address
      $hostString=$hostname;                                               # Save IP
} else {
     ($hostString) = split /\./,$hostname;                         # Obtain first portion
of FQDN component
}

@B = qw(svr01 svr02 svr03 svr04 svr05 svr06);                     # Array containing
assignable server
$binaryNumber = DoAsc2bin($hostString);                            # Convert string
into base2
$binaryNumber =~ s/\s+//g;                                                 # Remove spaces

Why does DoAsc2bin() add the whitespace if you are just going to remove it?

from base2 string
$decString = DoBin2dec($binaryNumber);                             # Convert base2
string to base10
$assignment = DoAssign(scalar(@B), $decString, $hostname, $limit); #

You should probably pass a reference to @B instead of using it globally.

Call subroutine to get assignments

print "$hostname: $assignment\n";
exit;

########################
### Subroutine Begin ###
########################

sub DoUsage() {

print <<EOM;

Generates assignment values where servers in list-A need to
communicate with all or some of the servers in list-B.  The input to
the script is a single server hostname or IP from list-A.  This server
name will go through a conversion (ascII->Binary->Dec), then the order
of the assignments will be made.  As long as no two servers have the
same hostname, the assignment will be varied across the list to ensure
the servers in List-B are distributed evenly across those in List-A.

Usage: $0 <hostname|IP> <entry limit>

sub DoAsc2bin {                                                   # Convert ASCII string to binary equivalent
    my ($string) = @_;                                                     # Input
    my @bytes;                                                             # Declare byte array
    for (split //, $string) {                                              # Run throuh for loop per character
of string being split
      push @bytes, unpack "B8", $_;                              # Store binary equivalent of
each character into @bytes
    }
    return wantarray ? @bytes : join " ", @bytes;                # Return @bytes or

                                        ^^^^
Why are you adding these spaces if you don't really want them?

a string of all content of @bytes
}

sub DoBin2dec {
    return unpack("N", pack("B32", substr("0" x 32 . shift, -32))); #
Converts binary string to decimal equivalent
}

sub DoAssign {
    my ($numListB, $num, $host, $lim) = @_;        # Function inputs
    $lim ||= 100;                                                 # Set lim=100 unless otherwise specified
    @B = reverse(@B);                                     # Reverse array, then pop last
    my $popNum = $num % $numListB;                 # Get modulus, then pop that
many elements from reversed array
    while ( $popNum != 0 ) {                                       #
Iterate until all values have been popped off array
        push(@popSave, pop(@B));                   # Save popped elements
        $popNum--;                                         # Decrement pop counter
    }
    @B = reverse(@B);                                     # Reverse array
    push(@B, @popSave);                                   # Appennd popped elements to
reversed (original direction) array

    for( $i = 0; $i < scalar(@B); $i++) {                      # Loop
through all array elements, maintain counter
   if( $B[$i] eq $host ) {                                 # Look for match
            #print "Match on $host\n";                   # Debug statement
            @B = ($B[$i], @B[0..($i-1)], @B[($i+1)..scalar
(@B)]);       # Modify array order by moving the "match" to front

last;                                                       # Move on
        }
    }
    return join " ", @B[0..($lim-1)];                    # Return space
deleimited string
}

There is no need to reverse the contents of @B to get the same results:

sub DoAssign {
     # Here $ListB contains a reference to @B
     my ( $ListB, $num, $host, $lim ) = @_;

     $lim ||= 100;

     push @$ListB, splice @$ListB, 0, $num % @$ListB;

     for my $i ( 0 .. $#$ListB ) {
         if ( $ListB->[ $i ] eq $host ) {
             #print "Match on $host\n";          # Debug statement
             # Modify array order by moving the "match" to front
             unshift @$ListB, splice @$ListB, $i, 1;
             last;
             }
         }

     return "@{ $ListB }[ 0 .. $lim - 1 ]";
     }

John

It is impressive you "can and would" take the time to make my original
function more efficient. Being able to take someone else's code in
which wasn't explained at all, and modify it so quickly truly
impresses me. Your version worked immediately after I changed my
calling code to pass a reference array.

Thanks again!

-Inet