jsmith118 has asked for the wisdom of the Perl Monks concerning the following question:

Hi all, Can anyone tell me how to fix this code? When I run this against the same testdata from a file, it always returns the sort in different orders, never in ascending or descending numeric.

foreach my $summary (@cmdoutput) { chomp($summary); $summary =~ s/\s+/ /g; my $Intf = $IHQ = $IQD = $OHQ = $OQD = $RXBS = $RXPS = $TXBS = $TX +PS = $TRTL = $Track = 0; select STDOUT; # 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 ($IHQ eq "-") { next;} elsif ($Intf eq "Interface") {next;} else { $Track = join "<<-", $rec,$Intf; $interface_bytes{$Track} += $RXBS; $Track = join "->>", $rec,$Intf; $interface_bytes{$Track} += $TXBS; } } } # 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 %inte +rface_bytes; foreach $key (@keys[0..$lastid]) { 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}); }
Testfile: intf-output.txt Interface IHQ IQD OHQ OQD R +XBS RXPS TXBS TXPS TRTL ---------------------------------------------------------------------- +------------------------------------------- * GigabitEthernet0/0/0 1 0 0 0 115 +000 111 143000 81 0 * Gi0/0/0.15 - - - - + - - - - - * Gi0/0/0.999 - - - - + - - - - - * GigabitEthernet0/0/1 0 0 0 0 91 +000 32 0 0 0 * GigabitEthernet0/0/3 0 0 0 0 162 +000 168 2206000 212 0 * GigabitEthernet0/1/1 0 0 0 0 4850 +000 1005 9590000 1153 0 * GigabitEthernet0/1/4 0 0 0 0 2105 +000 200 136000 155 0 * Te0/3/0 0 0 0 0 10134 +000 1480 4448000 843 0 Results: PS C:\perf> perl intf-summ.pl intf-output.txt Output from new-telnet.pl --- Input file: intf-output.txt End of Input file listing 10 lines RSA_4500<<-IHQ 0 RSA_4500<<-GigabitEthernet0/1/4 2105000 RSA_4500<<-GigabitEthernet0/1/1 4850000 RSA_4500<<-GigabitEthernet0/0/1 91000 RSA_4500->>GigabitEthernet0/0/0 143000 PS C:\perf> perl intf-summ.pl intf-output.txt Output from new-telnet.pl --- Input file: intf-output.txt End of Input file listing 10 lines RSA_4500->>IHQ 0 RSA_4500->>Te0/3/0 4448000 RSA_4500<<-GigabitEthernet0/1/1 4850000 RSA_4500<<-GigabitEthernet0/0/3 162000 RSA_4500->>GigabitEthernet0/1/4 136000 PS C:\perf> perl intf-summ.pl intf-output.txt Output from new-telnet.pl --- Input file: intf-output.txt End of Input file listing 10 lines RSA_4500->>IHQ 0 RSA_4500<<-GigabitEthernet0/1/4 2105000 RSA_4500<<-Te0/3/0 10134000 RSA_4500->>Te0/3/0 4448000 RSA_4500<<-IHQ 0

Replies are listed 'Best First'.
Re: Sort never returns data in right order
by hippo (Archbishop) on Sep 05, 2017 at 14:39 UTC
    @keys = sort {$interface_bytes{$a} <=> $interface_bytes{b}} keys %interface_bytes;

    That line doesn't look right to me. Perhaps you needed $b instead of just b.

      Thank you.. I looked at that for a day and never saw it.

        You should have gotten a warning ("Uninitialized used of ...") unless you happened to have a key named b. Always use use strict; use warnings qw( all );!!!

Re: Sort never returns data in right order
by Eily (Monsignor) on Sep 05, 2017 at 14:57 UTC

    ++ to hippo and dave_the_m for spotting the mistake.

    For your information, perl would have warned with use warnings (unless there was a "b" key somewhere in the hash):

    Use of uninitialized value in numeric comparison (<=>)
    That's because if $interface_bytes{"b"} is empty, perl will return undef for the missing value, and the comparison operators (<=> and cmp) will warn when one of the values is undef

Re: Sort never returns data in right order
by dave_the_m (Monsignor) on Sep 05, 2017 at 14:39 UTC
    $interface_bytes{b}
    You're missing a dollar sign before the 'b'.

    Dave.

Re: Sort never returns data in right order
by talexb (Chancellor) on Sep 05, 2017 at 14:57 UTC

    Do you have use strict; use warnings; in your code? They're always a good idea.

    Alex / talexb / Toronto

    Thanks PJ. We owe you so much. Groklaw -- RIP -- 2003 to 2013.

Re: Sort never returns data in right order
by stall (Novice) on Sep 06, 2017 at 07:08 UTC

    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} ); }

      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

      --
      Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
        I believe the previous person's post missed the point of my posts and does a disservice to the Perl community.