Question

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.

Answer 1

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'
        ];