Re: Sort never returns data in right order

[stall]

The previous answers seem to address the question asked. The code has many more issues and, as presented, does not run. There are many improvements that could be made, I’m just presenting a minimally cleaned up version of the code, in case that may be of help to the person who asked.

I wonder if this is a practice project from an old Perl course. It’s dated, but was fun to play with.

use strict;
use warnings;

my @cmdoutput = (
'  Interface                   IHQ       IQD       OHQ       OQD      
+RXBS      RXPS      TXBS      TXPS      TRTL',
'---------------------------------------------------------------------
+--------------------------------------------',
'* GigabitEthernet0/0/0          1         0         0         0    11
+5000       111    143000        81         0',
'* Gi0/0/0.15                    -         -         -         -      
+   -         -         -         -         -',
'* Gi0/0/0.999                   -         -         -         -      
+   -         -         -         -         -',
'* GigabitEthernet0/0/1          0         0         0         0     9
+1000        32         0         0         0',
'* GigabitEthernet0/0/3          0         0         0         0    16
+2000       168   2206000       212         0',
'* GigabitEthernet0/1/1          0         0         0         0   485
+0000      1005   9590000      1153         0',
'* GigabitEthernet0/1/4          0         0         0         0   210
+5000       200    136000       155         0',
'* Te0/3/0                       0         0         0         0  1013
+4000      1480   4448000       843         0',
);

my %interface_bytes;

foreach my $summary (@cmdoutput) {
  chomp($summary);
  $summary =~ s/\s+/ /g;
  my $Star = 0;
  my $Intf = 0;
  my $IHQ  = 0;
  my $IQD  = 0;
  my $OHQ  = 0;
  my $OQD  = 0;
  my $RXBS = 0;
  my $RXPS = 0;
  my $TXBS = 0;
  my $TXPS = 0;
  my $TRTL = 0;

  my $Track = "";

  my $rec = "Sasquatch";

  # remove extra spaces
  my $fields = () = $summary =~ /[\s+,:]/g;
  
  #   Debug if records are not processing correctly
  #     print "Record contains $fields fields\n";
  if ( $fields == 0 ) {
    print "No fields\n";
    next; 
  } elsif ( $fields == 10 ) {
    ( $Star, $Intf, $IHQ, $IQD, $OHQ, $OQD, $RXBS, $RXPS, $TXBS, $TXPS
+, $TRTL )
      = split( ' ', $summary ); 
    if    ( $Star ne "*" )  { next; }
    elsif ( $RXBS =~ /\D/ ) { next; }
    elsif ( $TXBS =~ /\D/ ) { next; }
    else {
      $Track = join "<<-", $rec, $Intf;
      $interface_bytes{$Track} += $RXBS;
      $Track = join "->>", $rec, $Intf;
      $interface_bytes{$Track} += $TXBS;
    } 
    
  } else {
    print STDERR
"Danger Will Robinson - my sensors detect an invisible hole that may c
+onsume you\n";
  }
  
}

my $key    = "";
my @keys   = ();
my $lastid = 4;

# sort by value and put the keys in an array (Ascending sort)
@keys =
  sort { $interface_bytes{$a} <=> $interface_bytes{$b} } keys %interfa
+ce_bytes;

# foreach $key ( @keys[ 0 .. $lastid ] ) {
foreach $key (@keys) {
  if ( not defined $key ) { next; }

  #     printf("%-45s %-6d\n","\t".$key,$interface_bytes{$key});
  #     my $number = $interface_bytes{$key};
  #     $number =~ s/(\d)(?=(\d{3})+(\D|$))/$1\,/g;
  #     printf("%-20s %-8s\n",$key,$number);
  printf( "%-10s %-6s\n", "\t" . $key, $interface_bytes{$key} );
}

[afoken]

Just a few comments on that piece of code:

  # remove extra spaces
  my $fields = () = $summary =~ /[\s+,:]/g;

Misleading comment, misleading variable name. No space is removed from anywhere. It's just attempting to count the number of field separators, and it will probably fail. \s+ looks like you want to match any number of spaces, but that won't happen:

>perl -MYAPE::Regex::Explain -E 'say YAPE::Regex::Explain->new(q<[\s+,
+:]>)->explain'
The regular expression:

(?-imsx:[\s+,:])

matches as follows:

NODE                     EXPLANATION
----------------------------------------------------------------------
(?-imsx:                 group, but do not capture (case-sensitive)
                         (with ^ and $ matching normally) (with . not
                         matching \n) (matching whitespace and #
                         normally):
----------------------------------------------------------------------
  [\s+,:]                  any character of: whitespace (\n, \r, \t,
                           \f, and " "), '+', ',', ':'
----------------------------------------------------------------------
)                        end of grouping
----------------------------------------------------------------------

And by the way: The split pattern does not fit the input.

  elsif ( $fields == 10 ) {
    ( $Star, $Intf, $IHQ, $IQD, $OHQ, $OQD, $RXBS, $RXPS, $TXBS, $TXPS
+, $TRTL )
      = split( ' ', $summary );

$fields was calculated for a different set of field separators. Additionally, split on ' ' is special cased to emulate awk, see split.

This is overly complex. Just split the current line into an array, check if the array has the expexted number of fields (@array==10), and go on from there.

  my $Star = 0;
  my $Intf = 0;
  my $IHQ  = 0;
  my $IQD  = 0;
  my $OHQ  = 0;
  my $OQD  = 0;
  my $RXBS = 0;
  my $RXPS = 0;
  my $TXBS = 0;
  my $TXPS = 0;
  my $TRTL = 0;

  my $Track = "";

  # ...
  } elsif ( $fields == 10 ) {
    ( $Star, $Intf, $IHQ, $IQD, $OHQ, $OQD, $RXBS, $RXPS, $TXBS, $TXPS
+, $TRTL )
      = split( ' ', $summary ); 

  # ...
      $Track = join "<<-", $rec, $Intf;
      $interface_bytes{$Track} += $RXBS;
      $Track = join "->>", $rec, $Intf;
      $interface_bytes{$Track} += $TXBS;
  # ...
  }

Scope of the variables should be limited to the block following elsif, i.e. my ($Star, $Intf, ...) = split .... Assigning unused fields to write-only variables is not needed, use undef instead: my ($x,undef,$y,undef,$z)=split .... Changing the code to split into an array instead of guessing field separators would require changes here, you would use just a constant index into an array. Readonly and constant could help avoiding magic numbers for the indexes, but on the other hand, you need those field numbers only here.

      $Track = join "<<-", $rec, $Intf;
      $interface_bytes{$Track} += $RXBS;

join is overkill here. Just use string interpolation. That also gets rid of the $Track variable:

      $interface_bytes{"$rec<<-$Intf"}+=$RXBS;

    if    ( $Star ne "*" )  { next; }
    elsif ( $RXBS =~ /\D/ ) { next; }
    elsif ( $TXBS =~ /\D/ ) { next; }

You check for errors, but you don't report them. Why?

Yes, I see that the heading line will trigger those errors. But why don't you get rid of the header line before working with the input?

  } else {
    print STDERR
"Danger Will Robinson - my sensors detect an invisible hole that may c
+onsume you\n";
  }

That perfectly explains the problem. For every f*ing line. Imagine reading in 10k lines from the wrong file. Seeing the same lame joke 10_000 times is not funny at all. If you find an unrecoverable error, just die, with a reasonable error message!

---

I'm sure I would find more things that I don't like if I would take some time to actually review the code. But to summarize:

Don't post bad code!

Alexander

[stall]

I believe the previous person's post missed the point of my posts and does a disservice to the Perl community.