Hello ozboomer,

This is not a big improvement but just in case you are interested you can replace the foreach loops with while loops. See sample of code bellow:

#!/usr/bin/perl
use strict;
use warnings;
# use Benchmark qw(:all) ; # WindowsOS
use Benchmark::Forking qw( timethese cmpthese ); # UnixOS

my @preserved = @ARGV;

sub while_test {
    my %data_hash   = ();
    my %output_hash = ();

    @ARGV = @preserved; # restore original @ARGV

    while (<>) {                          # Build list of unique (site
+:dsk) items
    my ($site, $buf) = split(/,/);

    my @input_item = split(/:/, $buf);
    while ( defined ( my $input_field = shift @input_item ) ) { # EX: 
+"VAR8=36!206!207!"
        my @dsk_list = ($input_field =~ /([0-9]+)!([0-9]+)!$/);  # Get
+ last 2 of 3 items

        while ( defined ( my $dsk = shift @dsk_list ) ) { # Each dsk i
+tem in the input...
        next if ($dsk == 0);              # Skip '0' dsk items
        my $key = $site . ":" . $dsk;        # Build composite key
        $data_hash{$key}++;               # ...and save it
        }
    }
    }

    my @sort_data_keys = sort keys %data_hash;
    while ( defined ( my $key = shift (@sort_data_keys) ) ) { # Build 
+list of dsk -> (multi sites)
    my ($site, $dsk) = split(/:/, $key);
    push( @{$output_hash{$dsk} }, $site );
    }

    my @sort_output_hash = sort {$a <=> $b} keys %output_hash;
    while ( defined ( my $dsk = shift (@sort_output_hash) ) ) { # Show
+ list of sites for each dsk
    # printf("Dsk: %d:\n", $dsk);
    foreach my $site (sort {$a <=> $b} @{$output_hash{$dsk}}) {
        # printf("  %d\n", $site);
    }
    # printf("\n");
    }
}

sub foreach_test {
    my %data_hash   = ();
    my %output_hash = ();

    @ARGV = @preserved; # restore original @ARGV

    while(<>) {                          # Build list of unique (site:
+dsk) items
    my ($site, $buf) = split(/,/);

    my @input_item = split(/:/, $buf);
    foreach my $input_field (@input_item) {    # EX: "VAR8=36!206!207!
+"
        my @dsk_list = ($input_field =~ /([0-9]+)!([0-9]+)!$/);  # Get
+ last 2 of 3 items

        foreach my $dsk (@dsk_list) {           # Each dsk item in the
+ input...
        next if ($dsk == 0);              # Skip '0' dsk items
        my $key = $site . ":" . $dsk;        # Build composite key
        $data_hash{$key}++;               # ...and save it
        }
    }
    }

    foreach my $key ( sort keys %data_hash ) {    # Build list of dsk 
+-> (multi sites)
    my ($site, $dsk) = split(/:/, $key);
    push( @{$output_hash{$dsk} }, $site );
    }

    foreach my $dsk (sort {$a <=> $b} keys %output_hash) {  # Show lis
+t of sites for each dsk
    # printf("Dsk: %d:\n", $dsk);
    foreach my $site (sort {$a <=> $b} @{$output_hash{$dsk}}) {
        # printf("  %d\n", $site);
    }
    # printf("\n");
    }
}

my $results = timethese(1000000, { While => \&while_test,
                   ForEach => \&foreach_test, }, 'none');
cmpthese( $results );

__END__

$ perl test.pl in.txt
           Rate   While ForEach
While   14286/s      --    -10%
ForEach 15898/s     11%      --
[download]

Keep in mind that all the arrays that we use in the while loops are destroyed because of shift. In case that you do not need to use the arrays again try this it should give a small boost.

Hope this helps, BR.