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

Hello Monks,

I am attempting to do the classic match across mulitple lines (with a small twist) that I can't seem to figure out.
The file is set up as such.
Header1
A list of numbers (1-50)
END LIST
Header1
A different list of numbers (1-50)
END LIST
Header2
A diffierent list of numbers (1-50)
END LIST
The header text is the same but the subsequent # is different. Also, the list of numbers is variable (there could be 1-50).
What I wish to do is remove the header text line that only has the number 1 associated with it as well the list of numbers that follow it to the 'END LIST' line. If the header text line has any other number associated with it, print it out and the list of numbers associated with it to the 'END LIST'.

The code I have is not working...I am actually embrassed to post it. I have no! idea how to proceed and have looked around for ideas but to no avail.

my $text = do { local $/; <FILE> };
if ($text =~ /^Header1.*?END LIST/m) {
....
}

[download]

Any help would be greatly appreciated.
Thanks,

Dr.J

Replies are listed 'Best First'.
Re: match and remove across multiple lines
by Enlil (Parson) on Apr 24, 2004 at 03:41 UTC
    The flip flop operator (..) is good for this sort of thing. 
    use strict;
use warnings;
while (<DATA>) {
 print unless ( /^Header1$/ .. /^END LIST$/ );
}

__DATA__
Header1
1 2 3 4 5 3
2
43 43
END LIST
Header2
2 42 24 2 32 2 32
2 2  4 2 3 
END LIST
Header1
2
43 43
END LIST
Header3
2 3 4 32 
3 4 3 43 
END LIST
Header1
1 2 3 4 5 3
2
43 43
END LIST

    [download]
    Which can be reduced to a one liner for files:
    perl -ni.bak -e 'print unless ( /^Header1$/ .. /^END LIST$/)'  filenam
+e

    [download]

    update: As to the way you have it. 

    my $text = do { local $/; <FILE> };
if ($text =~ /^Header1.*?END LIST/m) {
....
}

    [download]
    You are missing the /s modifier as the . will not match newlines without it. Also if you just want to remove that stuff you might as well use s/// and then print the result (add the /g modifier if Header1 appears more than once
    my $text = do { local $/; <FILE> };
$text =~ s/^Header1.*?END LIST\n?//msg

    [download]
    Note the \n is there to remove the blank lines that might result.

    -enlil

[reply]
[d/l]
[select]
      Thanks Enlil!!
      Appreciate it...boy o boy that was simple. I was looking through my beginning perl books for quite awhile and could not find this solution... Thanks again,
      Dr.J
[reply]
Re: match and remove across multiple lines
by TomDLux (Vicar) on Apr 24, 2004 at 03:47 UTC

    I'm assuming you only want to delete the first Header 1 section.

    while ( $line = <FILE> ) {  # skip section 1
    chomp;
    last if $line eq "END LIST";
}
while ( $line = <FILE> ) {
    # do stuff with sections two and three
}

    [download]

    --
    TTTATCGGTCGTTATATAGATGTTTGCA

[reply]
[d/l]
Re: match and remove across multiple lines
by xenchu (Friar) on Apr 25, 2004 at 01:35 UTC

    I couldn't get Enlil's code to work until I changed:

    print unless ( /^Header1$/ .. /^END LIST$/ );

    to

    print unless ( /Header1/ .. /END LIST/ );

    As originally coded every line was printed.

    Update: I did get Enlil's code to work on Solaris 5.9. The only machine it did not work on was the one with Mandrake Linux on it. I have no explanation for that.

    xenchu

    That's about all there is to it, except for everything else. -<b>Programming Perl</b> (p.346)
[reply]
[d/l]
[select]
      Here is a sample code that works for me. I basically hv to direct the output to another file when I run the script and its working fine. But is there any way to manipulate the insert within the source file itself?.

      Also I am worried about the large xml file and how my memory might be effected 

              while (<FILE>) {
                $match++ if $match;
        if(/$same/){
       # When we see <pattern> start storing the data
        $match = 1;
                        }

      $match = 0 if (/APPLES=*/);
        next if ($match == 1);
        next unless $match;

        s/\<Row AutoFitHeight=*//;

        print "$_";
    }

foreach $o(sort keys %{$application{$key}}){
               
            print $boots{$s}{$o}\n";
                  } 
            else {
                        print "0\n";
                 }
                } 
                print "    $cnt{$s}\n";
                print "    $date\n";
        }
        close (FILE)

      [download]

      Edit: g0n - code tags

[reply]
[d/l]

Back to Seekers of Perl Wisdom