Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Break perl foreach loop

by pvecchio (Initiate)
on Mar 03, 2009 at 16:38 UTC ( #747793=perlquestion: print w/ replies, xml ) Need Help??
pvecchio has asked for the wisdom of the Perl Monks concerning the following question:

Old monk here that couldn't even remember my original membername...
I have a foreach loop that I need to stop after a certain match is made. I added a Label to start the foreach loop, but when I match my condition and call Last, it does not end. Can another set of eyes help me see what I'm not seeing? This is a customized subroutine from afpdump.pl (parsing the details from a .afp file). After I read the total, I do not want to read any other dates or info. The match works perfectly but calling Last does not.
TIA
sub dump_afp { my $obj = shift; my $struct = $obj->struct; my @keys = sort grep !/^_|^(?:Data|EscapeSequence|ControlCode|Leng +th|CC|(?:Sub)?Type|FlagByte)$/, keys %$struct; push @keys, 'Data' if exists $struct->{Data}; WID: foreach my $key (@keys) { next if ref $struct->{$key}; length($x = $struct->{$key}) or next; if ($obj->ENCODING and grep { $key eq $_ } $obj->ENCODED_FIELDS) { $x = $obj->$key; $x = qq("$x"); } elsif ($x =~ /[^\w\s]/) { $x = ""; } if ($key eq 'Data') { if($x =~ m/^\"(\w|\d|\$)/) { $x =~ s/\"|\(|\)//g; if($x =~ m/^\d\d\/\d\d\/\d\d\s/){ my @dateinfo = split(/\s/, $x); if($dateinfo[0] =~ m/^\d\d\/\d\d\/\d\d/) { print "<DATE>"; print $dateinfo[0]; print "</DATE>\n"; print "<DESCRIPTION>"; print $dateinfo[1]; print "</DESCRIPTION>\n"; } } else { if($x =~ m/^\d\d\/\d\d\/\d\d/) { print "<DATE>"; print $x; print "</DATE>\n"; } if (($x !~/^\d\d\/\d\d\/\d\d/)&&($x != "Patient")){ if ($x !~ /^((\d+)||(\d+,\d+))\.\d\d/){ print "<DESCRIPTION>"; print $x; print "</DESCRIPTION>\n"; } } } if ($x =~ m/^((\d+)||(\d+,\d+))\.\d\d/){ print "<AMOUNT>"; print $x; print "</AMOUNT>\n"; } if($x =~ m/^((\$\d+)||(\$\d+,\d+))\.\d\d/) { print "<TOTAL>"; print $x; print "</TOTAL>\n"; } } } if ($x =~ m/^Patient/){ last WID; } } if ($obj->has_members) { dump_members($obj); } }

Comment on Break perl foreach loop
Download Code
Re: Break perl foreach loop
by Bloodnok (Vicar) on Mar 03, 2009 at 16:49 UTC
    Are you sure the last WID; statement is being hit ?

    Aside:

    Proper indentation would help you enormously - I had to copy the text into a syntax sensitive editor just to determine the correlation between opening and closing braces.

    A user level that continues to overstate my experience :-))
Re: Break perl foreach loop
by hbm (Hermit) on Mar 03, 2009 at 17:01 UTC

    How about printing $x before testing to see if it matches "Patient"? Is that condition simply not being met?

    Also, try to minimize slashes in your REs: Choose a different delimiter; you don't need to escape double-quotes; and character sets can help, too (consider s/["()]//g; versus s/\"|\(|\)//g;)

    And consider combining multiple prints with commas or dots:

    print "<DATE>", $x, "</DATE>\n"; # or print "<DATE>" . $x . "</DATE>\n";
      Thank you for the help.
      Yes, the Last WID is being hit. I did do a print $x if "Patient" is matched. So I'm confident that the condition is met. I only have Notepad ++ as an editor so my indentation is ugly. I like the character sets in the REs. I will use that (and the dots too).
Re: Break perl foreach loop
by misterwhipple (Monk) on Mar 03, 2009 at 17:48 UTC
    Courtesy of Perl::Tidy:
    sub dump_afp { my $obj = shift; my $struct = $obj->struct; my @keys = sort grep ! /^_|^(?:Data|EscapeSequence|ControlCode|Length|CC|(?:Sub)?Type +|FlagByte)$/, keys %$struct; push @keys, 'Data' if exists $struct->{Data}; WID: foreach my $key (@keys) { next if ref $struct->{$key}; length( $x = $struct->{$key} ) or next; if ( $obj->ENCODING and grep { $key eq $_ } $obj->ENCODED_FIELDS ) { $x = $obj->$key; $x = qq("$x"); } elsif ( $x =~ /[^\w\s]/ ) { $x = ""; } if ( $key eq 'Data' ) { if ( $x =~ m/^\"(\w|\d|\$)/ ) { $x =~ s/\"|\(|\)//g; if ( $x =~ m/^\d\d\/\d\d\/\d\d\s/ ) { my @dateinfo = split( /\s/, $x ); if ( $dateinfo[0] =~ m/^\d\d\/\d\d\/\d\d/ ) { print "<DATE>"; print $dateinfo[0]; print "</DATE>\n"; print "<DESCRIPTION>"; print $dateinfo[1]; print "</DESCRIPTION>\n"; } } else { if ( $x =~ m/^\d\d\/\d\d\/\d\d/ ) { print "<DATE>"; print $x; print "</DATE>\n"; } if ( ( $x !~ /^\d\d\/\d\d\/\d\d/ ) && ( $x != "Patient" ) ) { if ( $x !~ /^((\d+)||(\d+,\d+))\.\d\d/ ) { print "<DESCRIPTION>"; print $x; print "</DESCRIPTION>\n"; } } } if ( $x =~ m/^((\d+)||(\d+,\d+))\.\d\d/ ) { print "<AMOUNT>"; print $x; print "</AMOUNT>\n"; } if ( $x =~ m/^((\$\d+)||(\$\d+,\d+))\.\d\d/ ) { print "<TOTAL>"; print $x; print "</TOTAL>\n"; } } } if ( $x =~ m/^Patient/ ) { last WID; } } if ( $obj->has_members ) { dump_members($obj); } }

    --
    Your left-hand veeblefetzer is calibrated to the wrong frammistan coefficient. Pass me that finklegruber.

      Thanks misterwhipple. The cleanup helps a great deal.
      Here is the output from this sub routine. I want it to break the loop after the first Total (where the data starts with dollar sign and has digits dot digits). The two dates, two descriptions and total after the first total are not needed.

      <Page id="2"> <DATE>06/09/08</DATE> <DESCRIPTION>3 PHARMACY</DESCRIPTION> <AMOUNT>36.00</AMOUNT> <DATE>06/09/08</DATE> <DESCRIPTION>1 LABORATORY</DESCRIPTION> <AMOUNT>35.00</AMOUNT> <DATE>06/09/08</DATE> <DESCRIPTION>1 EMERGENCY SVCS</DESCRIPTION> <AMOUNT>1,159.00</AMOUNT> <DATE>06/09/08</DATE> <DESCRIPTION>3 PULMONARY FUNCTION</DESCRIPTION> <AMOUNT>246.00</AMOUNT> <DATE>06/09/08</DATE> <DESCRIPTION>3 THERAPEUTIC SERV</DESCRIPTION> <AMOUNT>111.00</AMOUNT> <TOTAL>$1,587.00</TOTAL> <DATE>10/08/08</DATE> <DATE>06/09/08</DATE> <DESCRIPTION>70247259</DESCRIPTION> <DESCRIPTION>000000840423</DESCRIPTION> <TOTAL>$68.54</TOTAL> </Page>
      I'm not sure if these are the problem you're looking for, but they might be confusing the issue.

      In the section

      elsif ( $x =~ /[^\w\s]/ ) { $x = ""; }
      if $x begins with a single word-character followed by whitespace, $x is set to an empty string. However, all of the if's in the block following if ( $key eq 'Data' ), which is inside the foreach loop, are looking for a non-empty value of $x.

      Also, in the section

      if ( ( $x !~ /^\d\d\/\d\d\/\d\d/ ) && ( $x != "Patient" ) )
      did you intend to say  $x !~ m/^Patient/ instead?

      --
      Your left-hand veeblefetzer is calibrated to the wrong frammistan coefficient. Pass me that finklegruber.

        The data I'm parsing is difficult. The presentation text of the document is referenced by PTX. A PTX::TRN contains data and is the only piece of data that is surrounded by quotes. That's why I test for it early in the loop.

        Here we can see the first two pieces of data are "Office" and "Hours". Ugly way to search I know.
        The ( $x != "Patient" ) helps me keep from putting in everything else (like "Office") into the xml node Description.
        PTX Presentation Text Data PTX::STO Set Text Orientation Orientation 0000 WrapDirection 2d00 PTX::AMI Absolute Move Inline 6480 PTX::AMB Absolute Move Baseline 1982 PTX::SCFL Set Coded Font Local 3 PTX::TRN Transparent Data "Office" PTX::AMI Absolute Move Inline 7079 PTX::TRN Transparent Data "Hours"
        When I put this print in the match condition I want to break the loop, the print comes along at the right place, it's just that the loop continues.
        if ( $x =~ m/^Patient/ ) { print "matched here "; #goto WID; last WID; }
        Tried the goto (even going to the originating sub routine, but to no avail. Here's the output:
        <Page id="2"> <DATE>06/09/08</DATE> <DESCRIPTION>3 PHARMACY</DESCRIPTION> <AMOUNT>36.00</AMOUNT> <DATE>06/09/08</DATE> <DESCRIPTION>1 LABORATORY</DESCRIPTION> <AMOUNT>35.00</AMOUNT> <DATE>06/09/08</DATE> <DESCRIPTION>1 EMERGENCY SVCS</DESCRIPTION> <AMOUNT>1,159.00</AMOUNT> <DATE>06/09/08</DATE> <DESCRIPTION>3 PULMONARY FUNCTION</DESCRIPTION> <AMOUNT>246.00</AMOUNT> <DATE>06/09/08</DATE> <DESCRIPTION>3 THERAPEUTIC SERV</DESCRIPTION> <AMOUNT>111.00</AMOUNT> <TOTAL>$1,587.00</TOTAL> matched here <DATE>10/08/08</DATE> <DATE>06/09/08</DATE> <DESCRIPTION>70247259</DESCRIPTION> <DESCRIPTION>000000840423</DESCRIPTION> <TOTAL>$68.54</TOTAL> </Page>
Re: Break perl foreach loop
by zentara (Archbishop) on Mar 03, 2009 at 18:06 UTC
Re: Break perl foreach loop
by ELISHEVA (Prior) on Mar 03, 2009 at 19:11 UTC
    I did do a print $x if "Patient" is matched

    and

    When I put this print in the match condition I want to break the loop, the print comes along at the right place, it's just that the loop continues. if ( $x =~ m/^Patient/ ) { print "matched here "; #goto WID; last WID; }
    Are you sure you are actually entering this section, i.e. did you do a distinctive print STDERR from that section (not just a match on patient or vague print "matched here")? As in:
    ... if ($x =~ m/^Patient/) { print STDERR "Patient found\n"; #added for verification last WID; } ...

    If you have a match on the ENCODE stuff at the top of the loop, your $x will be set to "Patient" (with quotes) and will match m/^"Patient/ and /Patient/ but not m/^Patient/.

    Failing that, I would try to comment out everything except the stuff at the top that sets $x and the if ... last WID stuff and see if you still have the wierd behavior. If you do, start simplifying the code that sets $x until you don't. Then start adding stuff back until you do. The key thing is to isolate the code that triggers this odd behavior.

    Best, beth

    Update: added quotes of previous debugging efforts, plus some extra suggestions.

      The STDERR did not provide any output. Only see something if I 'print' to document. See example output above where it matches after total. It does print based on the match but if I put Last WID before print, it does not print. Only prints if followed by Last WID.

      My sense is that since I don't completely understand the top of the code (I did not write it), from what I see it's putting everything into $x and then performing the matching and print operations after. So ending the foreach comes too late. I think I'd have to delete everything at the end of the array after I first match total.

      Maybe?
        Sorry, I was adding thoughts to my post while you were responding. Yes, I think the strategy is to start by commenting out stuff until you no longer get the symptoms and then adding it back.

        I think your hunch about something not quite matching up may be right. I don't think it is the problem here but I remember once driving myself crazy over a bug that was caused by a single missing ; - for some reason the code compiled without syntax errors but line 2 was executing before line 1 and I couldn't figure out why... until I realized that Perl thought line 2 was a parameter to line 1 and so was evaluating it first. Sometimes Perl makes sense of things we rather it wouldn't.

        Best, beth

        You could try putting a $|=1; statement at top of program. This turns force flushing on. Each print will get flushed to output as it happens. Maybe the loop really is finishing, but some stuff is stuck in print buffer that you don't see until later?

        I can't see anything wrong with syntax. Of course you don't need the WID label (just like not need for the next's), but you probably already know that.

        Update:I like Beth's suggestion more. Something is strange here that Perl is doing its best with, but not what was intended.

Re: Break perl foreach loop
by ig (Vicar) on Mar 03, 2009 at 19:49 UTC

    Maybe it would help if you added a print just after the loop, to confirm you have exited the loop, as follows:

    } if ( $x =~ m/^Patient/ ) { print "matched here"; last WID; } } print "out of loop"; if ( $obj->has_members ) { dump_members($obj); } }

    I wonder what output dump_members($obj) is producing.

    update3 I suspect you are calling your subroutine more than once. Each call produces one or two tagged (e.g. <DATE></DATE>) blocks of data. Your loop within the subroutine is probably exiting as you expect (note that if you put the last before your print statement the print doesn't execute) but the caller then calls again with more data and your subroutine produces more output. You can test for this by adding a print "starting dump_afp" at the start of your subroutine.

    update: If you post a dump of the object you are passing to the subroutine I can try running it and let you know what happens on my system.

    update2: Here is the result of running your sub through B::Deparse. I see nothing obviously wrong.

      Nice to back in the Perl community with so many helpful people...

      I tried the suggesting of printing "out of loop" and it provides a great clue. It prints "out of loop" all over the place, so it's looping through many, many times.

      eg.

      out of loop out of loop out of loop out of loop out of loop out of loo +p out of loop out of loop <TOTAL>$1,587.00</TOTAL> out of loop out of loop out of loop out of loop matched here out of lo +op out of loop out of loop out of loop out of loop out of loop out of + loop out of loop out of loop out of loop out of loop out of loop out + of loop out of loop out of loop <DATE>10/08/08</DATE>
      The dump_members subroutine at the end is the initial routine that parses the document looking for particular data markers (such as NOP, BPG, or PTX::TRN). If NOP, it sends to another subroutine that has different decoding functions. If PTX::TRN (transparent data), it sends it to this subroutine.
        Got it! Marshall gets the major thumbs up. I took out the "or next" line and it worked! It was going to next before any end of loop could be established.

        removed this:

        length( $x = $struct->{$key} ) or next;

        Thank you all!

        Peppi
Re: Break perl foreach loop
by GrandFather (Cardinal) on Mar 03, 2009 at 20:53 UTC

    $x != "Patient" is wrong. If you want to test string inequality use ne.


    True laziness is hard work

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://747793]
Approved by Bloodnok
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (9)
As of 2014-10-25 15:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (145 votes), past polls