perl script to generate server round-robin assignments

Discussion in 'Perl Misc' started by inetquestion, Aug 29, 2009.

  1. inetquestion

    inetquestion Guest

    #!/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
    }
    inetquestion, Aug 29, 2009
    #1
    1. Advertising

  2. inetquestion wrote:
    > #!/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
    --
    Those people who think they know everything are a great
    annoyance to those of us who do. -- Isaac Asimov
    John W. Krahn, Aug 29, 2009
    #2
    1. Advertising

  3. inetquestion

    inetquestion Guest

    On Aug 28, 10:14 pm, "John W. Krahn" <> wrote:
    > 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>

    >
    > > 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
    > --
    > Those people who think they know everything are a great
    > annoyance to those of us who do.        -- Isaac Asimov




    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, Aug 29, 2009
    #3
  4. inetquestion

    inetquestion Guest

    On Aug 28, 10:14 pm, "John W. Krahn" <> wrote:
    > 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>

    >
    > > 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
    > --
    > Those people who think they know everything are a great
    > annoyance to those of us who do.        -- Isaac Asimov




    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
    inetquestion, Aug 29, 2009
    #4
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. =?Utf-8?B?U2NvdHQ=?=

    DNS Round Robin and ViewState

    =?Utf-8?B?U2NvdHQ=?=, Mar 3, 2005, in forum: ASP .Net
    Replies:
    1
    Views:
    560
    bruce barker
    Mar 4, 2005
  2. Hraggie

    Round Robin scheduling

    Hraggie, Feb 26, 2006, in forum: Java
    Replies:
    2
    Views:
    894
    Martin Gregorie
    Mar 1, 2006
  3. Replies:
    2
    Views:
    3,435
    Pooja
    May 9, 2006
  4. Jerry Khoo

    help on round robin

    Jerry Khoo, Jun 28, 2004, in forum: C++
    Replies:
    1
    Views:
    585
    Chris Theis
    Jun 28, 2004
  5. rhitx

    round robin scheduler

    rhitx, Dec 7, 2006, in forum: C Programming
    Replies:
    6
    Views:
    614
Loading...

Share This Page