view release on metacpan or  search on metacpan

lib/App/Greple/Grep.pm  view on Meta::CPAN

	if ($self->{stretch}) {
	    my $b = $bp->[$bi];
	    my $m = $matched[0];
	    my $i = min map { $_->[2] // 0 } @matched;
	    @matched = [ $b->min, $b->max, $i, $m->[3] ];
	}
	if ($self->{only}) {
	    push @list, map({ [ $_, $_ ] } @matched);
	} elsif ($self->{all}) {
	    push @list, [ [ 0, length ] ] if @list == 0;
	    push @{$list[0]}, @matched;
	} else {
	    push @list, [ $bp->[$bi], @matched ];
	}
    }
    for my $r (@list) {
	bless $r, 'App::Greple::Grep::Result';
	bless $r->block, 'App::Greple::Grep::Block';
	for my $m ($r->matched) {
	    bless $m, 'App::Greple::Grep::Match';
	}
    }

    ##
    ## --join-blocks
    ##
    if ($self->{join_blocks} and @list > 1) {
	reduce {
	    if ($a->[-1][0]->max == $b->[0]->min) {
		$a->[-1][0]->max  = $b->[0]->max;
		push @{$a->[-1]}, splice @$b, 1;
	    } else {
		push @$a, $b;
	    }
	    $a;
	} \@list, splice @list, 1;
    }

    ##
    ## ( [ [blockstart, blockend, number ], [start, end], [start, end], ... ],
    ##   [ [blockstart, blockend, number ], [start, end], [start, end], ... ], ... )
    ##
    $self->{RESULT} = \@list;

    $self;
}

sub borders {
    my $self = shift;
    local $SIG{ALRM};
    my $alarm_start;
    if ($self->{alert_size} and length >= $self->{alert_size}) {
	$alarm_start = time;
	$SIG{ALRM} = sub {
	    $SIG{ALRM} = undef;
	    STDERR->printflush(
		$self->{filename} .
		": Counting lines, and it may take longer...\n");
	};
	alarm $self->{alert_time};
        warn "alert timer start ($alarm_start)\n" if $debug{a};
    }
    my @borders = do {
	if ($self->{BORDERS_CHILD}) {
	    my @b = $self->read_borders;
	    @b ? @b : match_borders $self->{border};
	} else {
	    match_borders $self->{border};
	}
    };
    if (defined $alarm_start) {
	if ($SIG{ALRM}) {
	    alarm 0;
	    warn "reset alert timer\n" if $debug{a};
	} else {
	    STDERR->printflush(sprintf("Count %d lines in %d seconds.\n",
				       @borders - 1,
				       time - $alarm_start));
	}
    }
    @borders;
}

sub result_ref {
    my $obj = shift;
    $obj->{RESULT};
}

sub result {
    my $obj = shift;
    @{ $obj->{RESULT} };
}

sub matched {
    my $obj = shift;
    sum(map { $_->@* - 1 } $obj->result) // 0;
}

sub blocks {
    my $obj = shift;
    $obj->{BLOCKS}->@*;
}

##
## Cut all result blocks (and gaps between them) from the text in a
## single pass.  Returns ( gap0, block0, gap1, block1, ..., rest ),
## or an empty list when not applicable.  Character based substr on
## a large utf8 string requires linear scan for every call to convert
## character offset to byte offset, so cutting each block separately
## makes the output routine quadratic.
##
sub slice_blocks {
    my $self = shift;
    my @blocks = map { $_->block } $self->result;
    return () if @blocks < 2;
    my $pos = 0;
    for (@blocks) {
	return () if $_->[0] < $pos;	# not in order
	$pos = $_->[1];
    }
    my $template = unpack_template(\@blocks, 0);
    unpack $template, ${ $self->{text} };
}

sub slice_result {
    my $obj = shift;
    my $result = shift;
    my($block, @list) = @$result;
    my $text = @_ ? shift : $obj->cut(@$block);
    my $template = unpack_template(\@list, $block->min);
    unpack($template, $text);
}

sub slice_index {