How can I skip some block content while reading in Perl.

Question

Hello.

I plan to skip the block content which include the start line of "MaterializeU4()" with the subroutin() read_block below. But failed.

# Read a constant definition block from a file handle. 
# void return when there is no data left in the file. 
# Otherwise return an array ref containing lines to in the block.  
sub read_block { 
    my $fh = shift; 

    my @lines; 
    my $block_started = 0; 

    while( my $line = <$fh> ) { 

    # how to correct my code below? I don't need the 2nd block content.
 $block_started++ if ( ($line =~ /^(status)/) && (index($line, "MaterializeU4") != 0) ) ;

 if( $block_started ) { 

     last if $line =~ /^\s*$/; 

     push @lines, $line; 
 }

    } 
    return \@lines if @lines;
    return; 
} 

Data as below:

__DATA__ 
status DynTest = <dynamic 100>
vid = 10002
name = "DynTest"
units   = ""

status VIDNAME9000 = <U4 MaterializeU4()>
vid = 9000
name = "VIDNAME9000"
units = "degC"

status DynTest = <U1 100>
vid = 100
name = "Hello"
units   = ""

Output:

  <StatusVariables>
    <SVID logicalName="DynTest" type="L" value="100" vid="10002" name="DynTest" units=""></SVID>
    <SVID logicalName="DynTest" type="L" value="100" vid="100" name="Hello" units=""></SVID>
  </StatusVariables>

[Updated] I print the value of index($line, "MaterializeU4"), it output 25. Then I updated the code as below

$block_started++ if ( ($line =~ /^(status)/) && (index($line, "MaterializeU4") != 25)

Now it works.

Any comments are welcome about my practice.

Thank you.

Answer 1

On successful match of a substring, index returns the position of the substring, which could be any value >= 0. On "failure", index returns -1.

The way you are using index

index($line, "MaterializeU4") != 0

will be true for all lines except for a line that begins with the string "MaterializeU4".

It looks like you already know a little bit about Perl regular expressions. Why not use one in this case, too?

++$block_started if $line =~ /status/ && $line =~ /MaterializeU4/;

Another issue I see is that you set $block_started to begin capturing lines, but you never set it to zero at the end of the "block", say, when $line is empty. I'm not sure if that's what you wanted to do.

Answer 2

First, using a regex instead of index is probably better since you can tune it to the exact format of status string if you may decide to be stricter than just "substring exists"

I would suggest as one solution adding a second flag to skip the block contents if it's a MaterializeU4 block, as follows:

# Read a constant definition block from a file handle. 
# void return when there is no data left in the file. 
# Empty return for skippable (Materialize4U) block!!!
# Otherwise return an array ref containing lines to in the block.  
sub read_block { 
    my $fh = shift; 
    my @lines = (); 
    my $block_started = 0; 
    my $block_ignore = 0;
    while (my $line = <$fh> ) { 
        if ($line =~ /^status.*?((MaterializeU4)?)/) {
            $block_started = 1;
            $block_ignore = 1 if $1;
        }
        last if $line =~ /^\s*$/ && $block_started;
        push @lines, $line unless $block_ignore; 
    } 
    return \@lines if @lines || $block_started;
    return; 
} 

---

Here's a slightly modified sample I tested using codepad.org:

Code:

use Data::Dumper;
my @all_lines = (
  "s 1" ,"b 1" ,""
, "s MaterializeU4" ,"b 2" ,""
, "s 3" ,"b 3" ,""
);

while (@all_lines) {
    my $block = read_block();
    print Data::Dumper->Dump([$block]);
}
exit 0;

sub read_block { 
    my @lines = (); 
    my $block_started = 0; 
    my $block_ignore = 0;
    while (my $line = shift @all_lines) { 
        if ($line =~ /^s .*?((MaterializeU4)?)/) {
            $block_started = 1;
            $block_ignore = 1 if $1;
        }
        last if $line =~ /^\s*$/ && $block_started;
        push @lines, $line unless $block_ignore; 
    } 
    return \@lines if @lines || $block_started;
    return; 
} 

Output:

$VAR1 = [
          's 1',
          'b 1'
        ];
$VAR1 = [];
$VAR1 = [
          's 3',
          'b 3'
        ];

Answer 3

Perl already has an operator to keep track of blocks. It's called the "flip-flop" operator:

Try this out:

while ( <DATA> ) { 
   next if /\Q<U4 MaterializeU4()>\E/../^\s*$/;
   push @lines, $_;
}

The value of /\Q<U4 MaterializeU4()>\E/../^\s*$/ will be true when it sees a line that matches the starting regex and it will stop being true after it sees a line matching the second expression.