Re: Break perl foreach loop

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);
    }
}
[download]

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

Comment on Re: Break perl foreach loop Download Code

Replies are listed 'Best First'.
Re^2: Break perl foreach loop by misterwhipple (Monk) on Mar 03, 2009 at 18:15 UTC
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 = ""; }` [download] 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" ) )` [download] did you intend to say `$x !~ m/^Patient/` instead? -- Your left-hand veeblefetzer is calibrated to the wrong frammistan coefficient. Pass me that finklegruber.	[reply] [d/l] [select]
Re^3: Break perl foreach loop by pvecchio (Initiate) on Mar 03, 2009 at 18:34 UTC
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"` [download] 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; }` [download] 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> [download]	[reply] [d/l] [select]
Re^2: Break perl foreach loop by pvecchio (Initiate) on Mar 03, 2009 at 18:02 UTC
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> [download]	[reply] [d/l]