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 = 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}->@*;
}

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

sub slice_index {
    my $obj = shift;
    my $result = shift;
    my($block, @list) = @$result;
    map { $_ * 2 + 1 } keys @list;
}

sub unpack_template {
    ##
    ## make template to split result text into matched and unmatched parts
    ##
    my($matched, $offset) = @_;
    my @len;
    for (@$matched) {
	my($s, $e) = @$_;
	$s = $offset if $s < $offset;
	push @len, $s - $offset, $e - $s;
	$offset = $e;
    }
    join '', map "a$_", @len, '*';
}

sub show_match_table {