perl-diddler has asked for the wisdom of the Perl Monks concerning the following question:

I have a prototype I'm working (thus a copyright @ top, as it's not released for Gnu-Domain yet) on that has an confusing bug.

This prog runs on unix, as it reads /dev, /dev/mapper, and uses the output of 'iostat', though this bug will be hit before it tries to read /dev or /dev/mapper, so the only requirement to dup the bug (I think) is iostat in your path.

At some point, I'm using 'select' since I will be using data non-availability as the trigger to actually display buffered text, but for now, I'm using unbuffered text, so that doesn't really come into play. I sleep for 1 second and the problem comes up on the initial output from iostat.

I read the whole chunk of iostat's output using a sysread w/a 2M buffer size, then split it into an array of lines called @data using 'split'.

If I use a 'for(i=0...)' type loop to index into @data, all the lines display as expected, but immediately following, I use a foreach(@lines){...print "line=$_\n";...} and instead of the data for each line, it prints out ARRAY=<ADDR> (different for each line).

If I write a 'simple', similar prog in a 1-liner, it works as expected, the 'foreach' display each line, but within this more complex program, it doesn't. I don't understand why. :-(

Being of the stubborn sort, rather than just using the for(i=0...) form (because it works), I'd like to know why the foreach isn't working! It just seems weird to me.
Cluesticks please? :-)
Thanks!

following is the code: 

#!/usr/bin/perl -w 
# 
# Prototype Code
# Copyright L A Walsh 2011
#
use strict;
use feature ':5.10';
use Fatal;
use Time::HiRes qw(ualarm);

my ($Devel, $Debuff_Output) = (1, 1);
if ($Debuff_Output) { select STDERR; $| = 1; select STDOUT; $| = 1; }
if ($Devel) {
    $ENV{PERL_HASH_SEED} = 0;
    use Carp qw(cluck confess);
    $SIG{__WARN__} = $SIG{__DIE__} = sub {
        $Carp::CarpLevel = 1 if defined $^S && !$^S;
        $SIG{__WARN__} = $SIG{__DIE__} = undef;
        confess $_[0] if defined $^S;
        die "Fatal Exit: Perl backtrace unavailable\n";
        }
}

my %colors = (
    'black'     => 0,
    'red'       => 1,
    'green'     => 2,
    'yellow'    => 3,
    'blue'      => 4,
    'magenta'   => 5,
    'turquoise' => 6,
    'white'     => 7);

my $interval         = 2;
my $Iostatargs       = "-dk";
my $clear            = `tput clear`;
my $at00             = `tput cup 0 0`;
my $term_reset_color = `tput sgr0`;
my $norm_color       = $term_reset_color;
my $term_bold        = `tput bold`;
my $term_blue_color  = `tput setaf $colors{blue}`;
my $term_red_color   = `tput setaf $colors{red}`;
my $read_color       = $term_blue_color;
my $write_color      = $term_red_color;
my ($rfds, $wfds, $efds) = ('', '', '');
my $ioh;

foreach (@ARGV) {
    /^(\d+)$/ and do { $interval = $1; next };
    print STDERR "Unknown arg: \"$_\"\n";
    sleep 1;
}

open($ioh, "iostat $interval $Iostatargs|") ||
    die "Can't start iostat $?\n";


my $maxcols;

sub maxcols {
    my $stty = `/bin/stty size </dev/tty`;
    my ($rows, $cols) = ($stty =~ /^(\d+)\s+(\d+)/);
    $maxcols = $cols if defined $cols;
    $maxcols;
}

my @dev_sub_strs = ('[hs]d[abcdefg-z]\s', 'md[0-9]\s', 'dm-\d+');
my $ord_sub_strs = '(?:' . (join '|', @dev_sub_strs) . ')';
my $devexp       = '(' . '.*' . $ord_sub_strs . ')';
my $rest_exp     = '(.*)$';
my $data_exp     = qr{$devexp . $rest_exp};
my $termwidth    = $maxcols ? $maxcols : &maxcols ? $maxcols : 80;

my $mapper_devno = 252;

# only use last 'segment' of a mapper name: ( /-[^-]+$/ )

my $use_shortnames = 1;

my $short_regexp    = qr{^.*-([^-]+)$};
my $long_regexp     = qr{^(.*)$};
my $mapper_name_exp = $use_shortnames ? $short_regexp : $long_regexp;

my @map_names;
my @map_namelens;

sub _populate_mapnames() {
    my $maxdm = -1;
    my $devh;
    opendir($devh, "/dev") || die "Can't opendir on /dev\n";
    while ($_ = readdir $devh) {
        /^dm-(\d+)$/ and do {
            $maxdm = $1 if $maxdm < $1;
        };
    }
    $map_names[ $maxdm + 1 ] = "NO_SUCH_DEV";
    my $dmapper_h;
    opendir($dmapper_h, "/dev/mapper") ||
        die "Can't opendir on /dev/mapper\n";
    print "using RE $mapper_name_exp\n";
    while ($_ = readdir $dmapper_h) {
        chomp;
        /$mapper_name_exp/ and do {

            # my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
            #        $atime,$mtime,$ctime,$blksize,$blocks) = stat(...
+);
            my $rdev  = (stat "/dev/mapper/$_")[6];
            my $minor = $rdev & 0xff;
            $map_names[$minor]    = $1;
            $map_namelens[$minor] = length $1;
            print "min=$minor, name=$1, len=", length $1, "\n";
        };
    }
}

sub map_namelen {
    _populate_mapnames unless @map_names;
    return $map_namelens[$1];
}

sub map_name {
    _populate_mapnames unless @map_names;
    return $map_names[$1];
}

vec($rfds, fileno($ioh), 1) = 1;
$efds = $rfds | $wfds;
my $maxread = 2 * 1024 * 1024;

my $running = 1;
my @data;
while ($running) {
    my $nfound = select $rfds, $wfds, $efds, 0;
    unless ($nfound) {
        print "$clear$at00";
        &print_title;
        &print_devs;
    } else {
        exit 1 if (vec $efds, fileno($ioh), 1);
        sleep 1;
        my $rawdata;
        my $readlen = sysread $ioh, $rawdata, $maxread;
        print "read $readlen/$maxread\n";
        @data = split /\n/, $rawdata;
    }
    for (my $i=0; $i<=$#data; ++$i) {
        printf "data[$i]=%s\n", $data[$i];
    }
    my $max_rate    = 0;
    my $max_namelen = 0;
    foreach (@data,) {
        print "line=".$_."\n";
        if (/$data_exp/) {
            my ($dev, $rest) = ($1, $2);
            print "dev=$dev\n";
            /^(\S+)\s+\S+\s+(\S+)\s+(\S+)\s+/ || die "Unparseable stri
+ng: '$_'\n";
            my ($name, $rrate, $wrate) = ($1, $2, $3);
            my $namelen;
            if ($name =~ /^dm-(\d+)$/) {
                my $mapdev = $1;
                $name    = map_name $mapdev;
                $namelen = map_namelen $mapdev;
            } else {
                $namelen = length $name;
            }
            my $total = $rrate + $wrate;
            $max_rate    = $total   if $total > $max_rate;
            $max_namelen = $namelen if $namelen > $max_namelen;
            push @data, [ $name, $rrate, $wrate, $total ];
        }
    }
    my @sorted_data = sort { $a->[3] <=> $b->[3] } @data;
    print "mx_rate=$max_rate, mxnmln=$max_namelen, trmwid=$termwidth\n
+";
    $max_namelen = 20 if ($max_namelen > 20);
    my $device_suffix   = " : ";
    my $dev_sfxlen      = length $device_suffix;
    my $max_scale_space = $termwidth - $max_namelen - $dev_sfxlen;
    my $units_str       = "KB/s";
    my $divisor         = 1;

    if ($max_rate > 9999) {
        $max_rate /= ($divisor = 1024);
        $units_str = "MB/s";
    }

    my @rate_formats = ("%.2f","%.1f","%.0f");
    my $rate_format;
    my $desired_max_rate_format_len = 6;
    my $rate_str;
    my $rate_strlen;
    foreach (@rate_formats) {
        $rate_format    =    $_;
        $rate_str = sprintf $rate_format, $max_rate;
        $rate_strlen = length $rate_str;
        last if $rate_strlen <= $desired_max_rate_format_len;
    }

    my $scale_str        =  ($rate_format . " " . $units_str);
    my $ss_len      = length $scale_str;
    
    my $mid_str0        = " |<-- Read+Write -- ";        #for len calc
+s

    my $dev_format    =    "%-${max_namelen}.${max_namelen}s";
    my $mid_string    = " |<-- " . $term_bold . $read_color . "Read" .
                                            "$norm_color" . "+" . $wri
+te_color . "Write" . 
                                            $norm_color . " -- ";
    my $end_string = "-->|";
    my $label_fill_len    =    $termwidth - $max_namelen - $ss_len - 1
+ -
                                                length($mid_str0 . $en
+d_string);

    my $label_str = $dev_format . $mid_string . $scale_str .  " " .
                                    ('-' x $label_fill_len) . $end_str
+ing;
    print "lab_str=$label_str\n";
    printf "$label_str\n", "Device", $rate_str;
    
    my $rate_per_space = ($max_rate) / $max_scale_space;
    print "units=$units_str, maxrt=$max_rate, rt_p_space=$rate_per_spa
+ce\n";

    foreach (@sorted_data) {
        my ($dev, $rrate, $wrate, $tot) = @$_;
        $rrate /= $divisor;
        $wrate /= $divisor;
        $tot   /= $divisor;

        my $read_fill  = int($rrate / $rate_per_space);
        my $write_fill = int($wrate / $rate_per_space);
        my $rdfill_ch  = '=';
        my $wrfill_ch  = '=';

        if ($read_fill < 1 && ($rrate / $rate_per_space) > 0) {
            $read_fill = 1;
            $rdfill_ch = "|";
        }
        if ($write_fill < 1 && ($wrate / $rate_per_space) > 0) {
            $write_fill = 1;
            $wrfill_ch  = "|";
        }
        if ($read_fill + $write_fill > $max_scale_space) {
            if   ($write_fill > $read_fill) { --$write_fill; }
            else                            { --$read_fill; }
        }
        printf $dev_format, $dev;
        print " : ";
        #print "(r=$read_fill, w=$write_fill)";
        print $term_bold;
        if ($read_fill > 0) {
            print $read_color . ($rdfill_ch x $read_fill);
        }
        if ($write_fill > 0) {
            print $write_color . ($wrfill_ch x $write_fill);
        }
        print $norm_color. "\n";
    }
    @data = undef;
}

# vim: ts=2 sw=2

[download]

Replies are listed 'Best First'.
Re: foreach(@input_lines) giving array ref not scalar? Confusion
by ikegami (Patriarch) on Mar 15, 2011 at 18:33 UTC

    Trimmed to the parts that use and modify @data: 

    my @data;
while ($running) {
    unless ($nfound) {
        ...
    } else {
        @data = split /\n/, $rawdata;
    }

    for (my $i=0; $i<=$#data; ++$i) {
        printf "data[$i]=%s\n", $data[$i];
    }

    foreach (@data,) {
        print "line=".$_."\n";
        if (...) {
            ...
            push @data, [ $name, $rrate, $wrate, $total ];
        }
    }

    my @sorted_data = sort { $a->[3] <=> $b->[3] } @data;

    ...

    @data = undef;
}

    [download]

    The outputs of the loops differ because you modify @data in the middle of it all.

    Don't change the array over which you are iterating, and don't use the same variable for two different purposes.

    Fix: 

    while ($running) {
    my @data;
    unless ($nfound) {
        ...
    } else {
        @data = split /\n/, $rawdata;
    }

    for (my $i=0; $i<=$#data; ++$i) {
        printf "data[$i]=%s\n", $data[$i];
    }

    my @parsed_data;
    foreach (@data,) {
        print "line=".$_."\n";
        if (...) {
            ...
            push @parsed_data, [ $name, $rrate, $wrate, $total ];
        }
    }

    my @sorted_data = sort { $a->[3] <=> $b->[3] } @parsed_data;

    ...
}

    [download]

    Note that I got rid of the @data = undef; by properly scoping my vars.

    Update: Added more of original code.
    Update: Added solution.

[reply]
[d/l]
[select]
Re: foreach(@input_lines) giving array ref not scalar? Confusion
by BrowserUk (Patriarch) on Mar 15, 2011 at 18:43 UTC

    You start out by populating @data with simple lines:

    my @data;
while ($running) {
    my $nfound = select $rfds, $wfds, $efds, 0;
...
        @data = split /\n/, $rawdata;
    }

    [download]

    but then later, you suddenly start pushing arrays onto data, without having removed the lines:

        foreach (@data,) {
...
        push @data, [ $name, $rrate, $wrate, $total ]; ###!!!!!!!!!!!!
+!!!!!!
        }
    }

    [download]

    And you know you've done it because you then try to sort those arrays:

        my @sorted_data = sort { $a->[3] <=> $b->[3] } @data;

    [download]

    But you left the lines in there so the sort will screw up producing the errors you cite. But you did it yourself!

    Why are you reusing that array?

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
      Oh !*@!.

      When I first wrote the code yesterday, I had 2 arrays -- then, today, for some reason (I'll have to retrace my steps), I thought I didn't need it and removed it...

      ARG...talk about shooting one's self in the face. I *HAD* it right, then I fixed it! (for some reason I don't know yet, but probably a premature and ill considered 'optimization'sic...)

      *sigh*

[reply]
        but probably a premature and ill considered 'optimization'

        If the size of the dataset is sufficient to make re-using the original array worthwhile, then you could just the subarray back over the string from which it was derived: 

        $_ = [ $name, $rrate, $wrate, $total ];

        [download]

        That would allow the space used for the original strings to be reclaimed and reused.

        Given that source of the data is only 2MB, that probably isn't a worthwhile consideration though.

        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
          ARG...talk about shooting one's self in the face. I *HAD* it right, then I fixed it!

        Don't be so hard on yourself. The worst thing is self-doubt and going back on the work/decisions/factoring you have made thus far.

        What you're REALLY missing is... a test suite.

        It helps catch regressions, lock in design decisions, play out use cases, test edge cases, etc. Here's some useful reading:

        A Perl Testing Tutorial
        Test::More
[reply]

Back to Seekers of Perl Wisdom