use warnings;
use strict;
use Data::Dumper;

my @foo;
my $flag = 0;
for (qw<eval DBIC::3 DBIC::2 DBIC::1 MyApp::3 MyApp::2 MyApp::1 Dancer
+::3 Dancer::2 Dancer::1>) {
    last if /Dancer/;
    $flag = 1 if /DBIC/;
    $flag = 2 if $flag and !/DBIC/;
    push @foo, $_ if $flag == 2;
}

print Dumper(\@foo);

__END__

$VAR1 = [
          'MyApp::3',
          'MyApp::2',
          'MyApp::1'
        ];
[download]

If you are sure that both regexes will be found, you can write something like this:

use List::MoreUtils qw/first_index last_index/;
use 5.010;
use strict;
use warnings;
my @a = qw<eval DBIC::3 DBIC::2 DBIC::1 MyApp::3 MyApp::2 MyApp::1 Dan
+cer::3 Dancer::2 Dancer::1>;
my $from = last_index  { /DBIC/ }   @a;
my $to   = first_index { /Dancer/ } @a;
say for @a[$from + 1..$to - 1];
[download]

If one or both regexes might not match, you'd need to special-case undefined $from and $to.

This looks like the most readable to me, thanks Moritz!

I'm surprised you didn't post a Perl 6 version too ... I love those!



- Boldra

I just didn't think of coming up with a Perl 6 solution, and even now I don't see a particularly elegant and readable way.

So I've just ported toolic's solution to Perl 6, making the returned list of found values lazy:

my @a = <eval DBIC::3 DBIC::2 DBIC::1 MyApp::3 MyApp::2 MyApp::1 Dance
+r::3 Dancer::2 Dancer::1>;
my @filtered := gather {
    my $flag = 0;
    for @a {
        last if /Dancer/;
        $flag = 1 if /DBIC/;
        $flag = 2 if $flag && !/DBIC/;
        take $_ if $flag == 2;
    }
}
.say for @filtered;
[download]

(Tested with current Niecza)

Perl 6 - second systems done right

Your specific example is more simply accomplished with grep:

@foo = grep /MyApp/, qw<eval DBIC::3 DBIC::2 DBIC::1 MyApp::3 MyApp::2
+ MyApp::1 Dancer::3 Dancer::2 Dancer::1>;;

print for @foo;;
MyApp::3
MyApp::2
MyApp::1
[download]

This assumes that it is *known* that we search for "MyApp". I understood the problem in the following way: Throw away everything in the beginning of the list up to, and including, DBIC. Then keep everythin which follows, up to (but not including) the first Dancer. Then throw away what follows. For instance, a MyApp which precedes a DBIC or follows a Dancer, should also be thrown away. This can't be done with your grep solution.

-- 
Ronald Fischer <ynnor@mm.st>

Your specific example...

my @stack;
for my $level (  qw<
    eval DBIC::3 DBIC::2 DBIC::1 MyApp::3
    MyApp::2 MyApp::1 Dancer::3 Dancer::2 Dancer::1
>  ) {
    last
        if  $level =~ /Dancer/;
    push @stack, $level;
    @stack = ()
        if  $level =~ /DBIC/;
}
say for @stack;
[download]

(Updated to move 'last' statement above 'push' statement. Thanks, AnomalousMonk.)

List::MoreUtils::after_incl {
    $_ !~ /DBIC/
} List::MoreUtils::after_incl {
    /DBIC/    
} List::MoreUtils::before { 
    /Dancer/
} @YourList
[download]

my $partition=0;
my @parts =
List::MoreUtils::part {
    if($pivots[0]) {
        if($partition % 2 == 0) {
            if($_ =~ $pivots[0]) {
                ++$partition;
            } 
        } else { 
            if($_ !~ $pivots[0]) {
                ++$partition;
                shift @pivots;
            }
        }
    }
    $partition
} qw<eval DBIC::3 DBIC::2 DBIC::1 MyApp::3 MyApp::2 MyApp::1 Dancer::3
+ Dancer::2 Dancer::1>;
print join(',',@{ $parts[2] }),"\n";
[download]

Another solution (which does not use reverse) would be

my @input=qw<eval DBIC::3 DBIC::2 DBIC::1 MyApp::3 MyApp::2 MyApp::1 D
+ancer::3 Dancer::2 Dancer::1>;
my @firsts=@input[0..@input-2];
my @seconds=@input[1..@input-1];
my $inside=0;
my @result;
List::MoreUtils::pairwise { 
    if($inside == 1) {
        my $pat=qr(Dancer);
        push @result,$a;
        if($a !~ $pat && $b =~ $pat) {
            $inside=-1;
        }
    } elsif($inside == 0) {
        my $pat=qr(DBIC);
        if($a =~ $pat && $b !~ $pat) {
            $inside=1;
        }
    }
} @firsts, @seconds;
print("@result\n");
[download]

How about something along these lines?

shift @array while($array[0] ~~ /DBIC/); 
pop @array while ($array[$#array] ~~ /Dancer/);
[download]

I think you overlooked the first element of my sample array: 'eval'. It's worse than that, I can get an non-DBIC element in the middle of the DBIC elements.

Well, obviously you can change the regex to match whatever you need.

You didn't mention that about the DBICs, that's a more difficult and messy problem.

It's probably going to be much more successful to look for what you do want, rather than what you don't, so I'd design a regex to do just that ;)

This should be close:

  DB<134> @list= ("a".."c","DBIC","A".."C","DANCER","a".."c")
 => ("a", "b", "c", "DBIC", "A", "B", "C", "DANCER", "a", "b", "c")
 
  DB<135> grep { /DBIC/.. /DANCER/  } @list 
 => ("DBIC", "A", "B", "C", "DANCER")
[download]

That's not the requested output.

...This should be close..

UPDATE:

Still not sure what the requested output is, but if it's only about eliminating the edges try

   DB<101> @list= ("a".."c","DBIC","A".."C","DANCER","a".."c")
 => ("a", "b", "c", "DBIC", "A", "B", "C", "DANCER", "a", "b", "c")
 
  DB<102> grep { /DBIC/ .. /DANCER/ and ! /DBIC/ and ! /DANCER/ } @lis
+t
 => ("A", "B", "C")
[download]

not DRY but effective.

I don't know if this counts as better or worse...

@list  = qw<eval DBIC::3 DBIC::2 DBIC::1 MyApp::3 MyApp::2 MyApp::1 Da
+ncer::3 Dancer::2 Dancer::1>;
$begin =   1  + last_index  { /^(DBIC|eval)/ } @list;
$end   = (-1) + first_index { /^Dancer/ }      @list;
@foo2  = @list[ $begin .. $end ];
say for @foo2;
[download]

  DB<152> @list= ("a".."c","DBIC","A".."C","DANCER","a".."c")
 => ("a", "b", "c", "DBIC", "A", "B", "C", "DANCER", "a", "b", "c")
 
  DB<153> $list = join "\0", @list
 => "a\0b\0c\0DBIC\0A\0B\0C\0DANCER\0a\0b\0c"
 
  DB<154> ($match)=  $list =~ /DBIC\0(.*)\0DANCER/
 => "A\0B\0C"
 
  DB<155> split /\0/,$match
 => ("A", "B", "C")
[download]

this will find the longest interval between the first DBIC and the last Dancer and you are free to use more powerful regexes.

UPDATE: hmm maybe newlines are here a better choice as delimiter.

Heh, I like that solution. Note that adding a second 'DBIC' and/or a second 'Dancer' demonstrates flaws in the exact regex you chose. But both of those flaws are easily overcome:

$list =~ /.*DBIC\0(.*?)\0DANCER/
#         ^^         ^
[download]

But perhaps people less comfortable with regexes would like it less...

- tye        

And did you think about the edgecase of choosing a wrong delimiter which already appears in the elements? ;)

FWIW, I'm quite often in a situation where I would prefere to apply regexes on lists, so I started meditating yesterday about a module abstracting the delimiter problem away by locally redefining a special var like $; or $\ for the delimiter and $_ for flattened list.

something like

@newlist = flat { s/START$;(.*)$;END/$1/ } @list
 
sub flat (&@) {
  my ($code,@list) = @_;
 
  local ( $;, $_ ) = join_reliably (@list);
 
  $code->();
 
  return split $;, $_
}
[download]

untested.

Cheers Rolf

This looks great, because the list is generated by splitting a string on newlines in the first place:

eval { confess }; 
my @stack = split /\n/, $@;
[download]

The regex becomes a bit more complicated, but that usually also means I'm a bit more certain about what I'm matching.

Thanks!

Wow, so many complicated solutions! It's actually quite simple:

1. Find start of opening bound, then
2. Find start of data, then
3. Find start of closing bound

my ($seen_opening, $seen_data, $seen_closing);
my @filtered =
   grep
      {     ($seen_opening ||= /DBIC/)    # Find opening bound
        &&  ($seen_data    ||= !/DBIC/)   # Find data
        && !($seen_closing ||= /Dancer/)  # Find closing bound
      }
      @list;
[download]

Using the range operator is possible too.

my @filtered =
   grep { (/DBIC/ .. /Dancer/) && !/DBIC/ && !/Dancer/ }
      @list;
[download]

Update: Added range operator solution.

I guess some definitions of "quite simple" can be applied to that code. It looks more like "clever" to me. (:

I rejected using 'grep' at all since it seems likely to me that there could be cases where there is nothing to trim from the front. Your solution (and any simple 'grep' solution) will produce nothing for that case (or else can't deal with extra, unexpected leading garbage). I also dislike solutions that I can tell will require fundamental changes in the face of simple changes to the requirements.

- tye        

> it seems likely to me that there could be cases where there is nothing to trim from the front.

Well not clearly phrased in the OP but at least the way the example was coded!

But maybe that's the real bug???

Please notice the word "between" in this thread's title.

> I rejected using 'grep' at all

Maybe you mean mean "grep w/o reverse" ?

  DB<130> @list= ("a".."c","DBIC","A".."C","DANCER","a".."c") => ("a",
+ "b", "c", "DBIC", "A", "B", "C", "DANCER", "a", "b", "c")
 
  DB<131> reverse grep { not /DBIC/ .. 1   } reverse grep { not /DANCE
+R/ .. 1   } @list 
 => ("A", "B", "C")
 
  DB<132> reverse grep { not /DBIC/ .. 1   } reverse grep { not /NONSE
+NSE/ .. 1   } @list 
 => ("A", "B", "C", "DANCER", "a", "b", "c")
[download]

... or maybe not ?

Personally, I reject posting solutions for every possible interpretation of a poorly phrased question.

Human discussions are an iterative process.

Cheers Rolf

I guess some definitions of "quite simple" can be applied to that code.

Linear, clear, concise.

I did not mean to include yours in the set of "not simple". I wasn't paying much attention by the time I got that far.

will produce nothing for that case

I was viewing the problem as "print the stuff between the bounds", in which case it *should* print nothing for the case with no bound.

But it also shouldn't print anything for a missing trailing bound (while it does), so point made.

I rejected using 'grep' at all since it seems likely to me that there could be cases where there is nothing to trim from the front. Your solution (and any simple 'grep' solution) ...

So, you reject simple now, in favour of complicated, because of what might be the requirement in some speculative future.

Yep! That just about sums up all that is wrong with the software industry. Throwing good money after bad chasing what-if scenarios and may-be requirements instead of just taking care of the real requirements as they exist now; and dealing with future requirements -- actual future requirements -- when and if they actually arise.

---

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.

"Science is about questioning the status quo. Questioning authority".

In the absence of evidence, opinion is indistinguishable from prejudice.

The start of some sanity?

FYI, looking at this a second time, I noticed that both of those solutions would handle input containing qw< DBIC::4 eval DBIC::3 > in a manner that seems to me rather clearly against the stated wish (of removing leading/trailing "rubbish" from a stack trace).

- tye        

Well spotted. That is a realistic possibility for me.


- Boldra

BTW: If the your main concern with your method, is the time taken to perform the reverses, don't even consider it unless your list is huge. Reverse is a particularly efficient operation. 1000 items take a just 2/10s of a millisecond:

@a = 1 .. 1e3;;

$t = time; @a = reverse @a; print time() - $t;;
0.000192165374755859

$t = time; @a = reverse @a; print time() - $t;;
0.000243186950683594

$t = time; @a = reverse @a; print time() - $t;;
0.000186920166015625
[download]

No good for one-liners, but this looks pretty sweet:

use 5.010;
use strict;
use List::MoreUtils qw/first_index last_index/;

sub narrow
{
    my ($from, $to) = map { $_->(@_) } @{(pop)};
    return @_[$from .. $to];
}

sub from (&$)  { [ @_[0..1] ] }
sub to (&)     { $_[0] }

my @list = qw/eval DBIC::1 DBIC::2 My::1 My::2 My::3 Dancer::1 Dancer:
+:2 Dancer::3 Dancer::4/;

say foreach
    narrow @list,
    from   {   1  + last_index  { /^DBIC/ }   @_ }
    to     { (-1) + first_index { /^Dancer/ } @_ };
[download]

Obviously you'd want to factor narrow, from and to out into a separate module rather than defining them inline.

And given that from and to are quite generic names, perhaps something like start_at and finish_at might be better in practice.