Re^4: Loop Array - If $var is something write values until $var is something else

Sorry for confusing, should have removed the reference part as its not really important to my question. I removed it, use strict and warnings and now here is it:

my @result;
foreach my $x (@cleared) {
    if ($x =~ /JOB::(.*)/){
        print $x, "\n";
        } 
        else {
                unless ($x =~ m/^Something/){
                    print "~~Something~~", $x, "\n";
                } 
                else {
                    unless ($x =~ m/^Something Else/){
                    print "~~Something Else~~", $x, "\n";
                    }
        }
    }
}
[download]

Lets see the @cleared (Dump):

$VAR1 = 'JOB::HEREISASTRING';
$VAR2 = 'Something';
$VAR3 = 'StringA';
$VAR4 = 'StringB';
$VAR5 = 'StringC';
$VAR6 = 'StringD';
$VAR7 = 'Something Else';
$VAR8 = 'StringE';
$VAR9 = 'StringF';
$VAR10 = 'StringG';
$VAR11 = 'StringH ';
$VAR12 = 'JOB::HEREISANOTHERSTRING';
$VAR13 = 'Something';
$VAR14 = 'StringI';
$VAR15 = 'StringJ';
$VAR16 = 'StringK';
$VAR17 = 'StringL';
$VAR18 = 'Something Else';
$VAR19 = 'StringM';
$VAR20 = 'StringN';
$VAR21 = 'StringO';
$VAR22 = 'StringP ';
[download]

Output:

JOB::HEREISASTRING
~~Something Else~~Something
~~Something~~StringA
~~Something~~StringB
~~Something~~StringC
~~Something~~StringD
~~Something~~Something Else
~~Something~~StringE
~~Something~~StringF
~~Something~~StringG
~~Something~~StringH
JOB::HEREISANOTHERSTRING
~~Something Else~~Something
~~Something~~StringI
~~Something~~StringJ
~~Something~~StringK
~~Something~~StringL
~~Something~~Something Else
~~Something~~StringM
~~Something~~StringN
~~Something~~StringO
~~Something~~StringP
[download]

I wish output:

JOB::HEREISASTRING
~~Something Else~~Something Else (could be removed)
~~Something~~StringA
~~Something~~StringB
~~Something~~StringC
~~Something~~StringD
~~Something Else~~Something Else (could be removed)
~~Something Else~~StringE
~~Something Else~~StringF
~~Something Else~~StringG
~~Something Else~~StringH
JOB::HEREISANOTHERSTRING
~~Something Else~~Something Else (could be removed)
~~Something~~StringI
~~Something~~StringJ
~~Something~~StringK
~~Something~~StringL
~~Something Else~~Something Else (could be removed)
~~Something Else~~StringM
~~Something Else~~StringN
~~Something Else~~StringO
~~Something Else~~StringP
[download]

In fact i want to tag my values from a start until a match occurs and tag it different and so on.... What comes to my mind is that with foreach loop variable $x changes and in the loop is again "Something"!?

Comment on Re^4: Loop Array - If $var is something write values until $var is something else Select or Download Code

Replies are listed 'Best First'.
Re^5: Loop Array - If $var is something write values until $var is something else by AnomalousMonk (Archbishop) on Sep 29, 2018 at 22:36 UTC
Here's a variation on Marshall's approach. I've excluded from the output all lines tagged `'(could be removed)'` in the desired output shown here. c:\@Work\Perl\monks>perl -wMstrict -e "my @cleared = ( 'JOB::HEREISASTRING', 'Something', 'StringA', 'StringB', 'StringC', 'StringD', 'Something Else', 'StringE', 'StringF', 'StringG', 'StringH ', 'JOB::HEREISANOTHERSTRING', 'Something', 'StringI', 'StringJ', 'StringK', 'StringL', 'Something Else', 'StringM', 'StringN', 'StringO', 'StringP', ); ;; my $rx_job = qr{ \A JOB:: [[:upper:]]+ \z }xms; ;; my $rx_thing = qr{ Something \| Something \s+ Else }xms; ;; my $prefix = ''; CLEARED: for my $clear (@cleared) { if (my ($pre) = $clear =~ m{ \A ($rx_thing) \z }xms) { $prefix = $pre; next CLEARED; } ;; if ($clear =~ $rx_job) { print $clear, qq{\n}; next CLEARED; } ;; print qq{~~$prefix~~$clear\n}; } " JOB::HEREISASTRING ~~Something~~StringA ~~Something~~StringB ~~Something~~StringC ~~Something~~StringD ~~Something Else~~StringE ~~Something Else~~StringF ~~Something Else~~StringG ~~Something Else~~StringH JOB::HEREISANOTHERSTRING ~~Something~~StringI ~~Something~~StringJ ~~Something~~StringK ~~Something~~StringL ~~Something Else~~StringM ~~Something Else~~StringN ~~Something Else~~StringO ~~Something Else~~StringP [download] (BTW: This format is something like what I'd have liked to have seen for your SSCCE.) Give a man a fish: `<%-{-{-{-<`	[reply] [d/l] [select]
Re^5: Loop Array - If $var is something write values until $var is something else by Marshall (Canon) on Sep 29, 2018 at 20:53 UTC
If this doesn't quite do what you want, see if you can modify it so that it does: #!/usr/bin/perl use strict; use warnings; while (defined (my $x= <DATA>)) { chomp $x; if ($x =~ /^JOB::/) { print $x, "\n"; } elsif ($x =~ m/^Something\s*$/) { print "~~Something~~ ", $x, "\n"; } else { print "~~Something Else~~ ", $x, "\n"; } } =prints JOB::HEREISASTRING ~~Something~~ Something ~~Something Else~~ StringA ~~Something Else~~ StringB ~~Something Else~~ StringC ~~Something Else~~ StringD ~~Something Else~~ Something Else ~~Something Else~~ StringE ~~Something Else~~ StringF ~~Something Else~~ StringG ~~Something Else~~ StringH JOB::HEREISANOTHERSTRING ~~Something~~ Something ~~Something Else~~ StringI ~~Something Else~~ StringJ ~~Something Else~~ StringK ~~Something Else~~ StringL ~~Something Else~~ Something Else ~~Something Else~~ StringM ~~Something Else~~ StringN ~~Something Else~~ StringO ~~Something Else~~ StringP =cut __DATA__ JOB::HEREISASTRING Something StringA StringB StringC StringD Something Else StringE StringF StringG StringH JOB::HEREISANOTHERSTRING Something StringI StringJ StringK StringL Something Else StringM StringN StringO StringP [download]	[reply] [d/l]
Re^5: Loop Array - If $var is something write values until $var is something else by johngg (Canon) on Sep 29, 2018 at 23:02 UTC
Here's my take on what I think you are after, I have omitted the "(could be removed)" items. The code:- use strict; use warnings; use feature qw{ say }; open my $dataFH, q{<}, \ <<__EOD__ or die $!; JOB::HEREISASTRING Something StringA StringB StringC StringD Something Else StringE StringF StringG StringH JOB::HEREISANOTHERSTRING Something StringI StringJ StringK StringL Something Else StringM StringN StringO StringP __EOD__ chomp( my @cleared = <$dataFH> ); close $dataFH or die $!; my $flag; foreach my $item ( @cleared ) { if ( $item =~ m{^JOB} ) { say $item; next; } elsif ( $item !~ m{^String} ) { $flag = $item; next; } else { say qq{~~$flag~~$item}; } } [download] The output:- `JOB::HEREISASTRING ~~Something~~StringA ~~Something~~StringB ~~Something~~StringC ~~Something~~StringD ~~Something Else~~StringE ~~Something Else~~StringF ~~Something Else~~StringG ~~Something Else~~StringH JOB::HEREISANOTHERSTRING ~~Something~~StringI ~~Something~~StringJ ~~Something~~StringK ~~Something~~StringL ~~Something Else~~StringM ~~Something Else~~StringN ~~Something Else~~StringO ~~Something Else~~StringP` [download] I hope this is helpful. Cheers, JohnGG	[reply] [d/l] [select]
Re^6: Loop Array - If $var is something write values until $var is something else by AnomalousMonk (Archbishop) on Sep 30, 2018 at 02:01 UTC
`elsif ( $item !~ m{^String} ) { ... }` My interpretation is that the `StringA` etc. input items are supposed to represent any input strings at all rather than strings that all start with `'String'`. I think that only the `'JOB::...'`, `'Something'` and `'Something Else'` strings are supposed to be constants. Give a man a fish: `<%-{-{-{-<`	[reply] [d/l] [select]
Re^5: Loop Array - If $var is something write values until $var is something else by Marshall (Canon) on Sep 30, 2018 at 03:00 UTC
I am not quite sure about your "rules" for parsing the input. Here is one possibility: Update: I did the following code rather quickly. I changed my mind during the middle of coding and didn't revise the previously written code. process_record() could be shortened by calling process_sub_record() a couple of times instead of just once. This is a small detail and should be obvious how to do. The OP is still not completely clear as to whether these "Something" and "Something Else" strings are standard invariant sub-headers or whether they can vary. Also not spec'd is whether the number of lines in the record can vary or not. Well, Ok, another update... The change to call process_sub_record() twice was so extremely trivial, that I did it and put original code in a readmore block. Perhaps it is not obvious but this implementation allows blank and comment lines at the beginning or end of the file - I have often found that feature useful in my work. #!/usr/bin/perl use strict; use warnings; while (defined (my $x= <DATA>)) { process_record ($x) if ($x =~ /^JOB::/) } sub process_record { my $job = shift; chomp $job; print "$job\n"; process_sub_record(); process_sub_record(); } sub process_sub_record { my $sub_record = <DATA>; chomp $sub_record; for (1..4) { my $nextLine = <DATA>; chomp $nextLine; print "~~$sub_record~~ ", "$nextLine\n"; } } =PRINTS: JOB::HEREISASTRING ~~Something~~ StringA ~~Something~~ StringB ~~Something~~ StringC ~~Something~~ StringD ~~Something Else~~ StringE ~~Something Else~~ StringF ~~Something Else~~ StringG ~~Something Else~~ StringH JOB::HEREISANOTHERSTRING ~~Something~~ StringI ~~Something~~ StringJ ~~Something~~ StringK ~~Something~~ StringL ~~Something Else~~ StringM ~~Something Else~~ StringN ~~Something Else~~ StringO ~~Something Else~~ StringP =cut __DATA__ JOB::HEREISASTRING Something StringA StringB StringC StringD Something Else StringE StringF StringG StringH JOB::HEREISANOTHERSTRING Something StringI StringJ StringK StringL Something Else StringM StringN StringO StringP [download] Read more... (2 kB)	[reply] [d/l] [select]
Re^5: Loop Array - If $var is something write values until $var is something else by Marshall (Canon) on Oct 03, 2018 at 22:08 UTC
I looked back over this thread. You seem to have a misunderstanding of what "unless" does. "unless X" means the same thing as "if not X". I recommend that you use this 2nd syntax because it is often easier for beginners to understand. This makes no difference (or at least not any significant difference) in the execution speed of the compiled code. I've given other solutions as have others in this thread. You have an overly complex "if" code block. Your "else" layer is not needed. In this code version, there is something to be done with a JOB line, a SOMETHING line or a SOMETHING ELSE line. Otherwise the current line is printed with the current header prepended. Somewhere else in this thread I gave a solution where these sub-header tags were not fixed in advance but has the limitation that each sub-section must have exactly 4 lines of "other strings". In general the better your specify the problem, the better the answers tend to be. #!/usr/bin/perl use strict; use warnings; my $header =""; while (defined (my $line= <DATA>)) { next if $line =~ /^\s$/; # skip blank lines chomp $line; if ($line =~ /^JOB::/) { print "$line\n"; } elsif ($line =~ /^Something\s$\|^Something Else\s*$/ ) { $header = $line; # don't print this line } else { print "$header $line\n"; #print line with current sub-header } } =PRINTS: JOB::HEREISASTRING Something StringA Something StringB Something StringC Something StringD Something Else StringE Something Else StringF Something Else StringG Something Else StringH JOB::HEREISANOTHERSTRING Something StringI Something StringJ Something StringK Something StringL Something Else StringM Something Else StringN Something Else StringO Something Else StringP =cut __DATA__ JOB::HEREISASTRING Something StringA StringB StringC StringD Something Else StringE StringF StringG StringH JOB::HEREISANOTHERSTRING Something StringI StringJ StringK StringL Something Else StringM StringN StringO StringP [download]	[reply] [d/l]