view release on metacpan or  search on metacpan

script/greple  view on Meta::CPAN

    [ "inside"  , \@opt_inside  , 1 ], # need &
    [ "outside" , \@opt_outside , 1 ], # need &
    [ "include" , \@opt_include , 1 ], # need &
    [ "exclude" , \@opt_exclude , 1 ], # need &
    ) {
    my($cat, $opt, $pattern) = @$set;
    for (@{$opt}) {
	next if callable $_;
	/^&\w+/ or next if $pattern;
	$_ = parse_func($_) or die "$cat function format error: $_\n";
    }
}

my $regions = App::Greple::Regions::Holder->new;
for my $set (
    [ \@opt_inside,  REGION_INSIDE  | REGION_UNION     ],
    [ \@opt_outside, REGION_OUTSIDE | REGION_UNION     ],
    [ \@opt_include, REGION_INSIDE  | REGION_INTERSECT ],
    [ \@opt_exclude, REGION_OUTSIDE | REGION_INTERSECT ])
{
    my($opt, $flag) = @$set;
    for my $spec (@$opt) {
	$regions->append(FLAG => $flag, SPEC => $spec);
    }
}

##------------------------------------------------------------

if ($opt_d{m}) {
    warn "Search pattern:\n";
    my $i;
    for my $pat ($pat_holder->patterns) {
	my $type =
	    $pat->is_required ? 'must' :
	    $pat->is_negative ? 'not' :
	    $pat->is_positive ? 'and' : 'else';
	my $target = $pat->regex // $pat->string;
	warn sprintf("  %4s %1s %s\n",
		     $type,
		     $pat->is_function ? '&' : '',
		     @colors > 1 ? index_color($i++, $target) : $target);
    }
    warn sprintf("must = %d, need = %d, allow = %d\n",
		 $count_must, $count_need, $count_allow);
}

## push post-process filter
if (@opt_pf) {
    push_output_filter(\*STDOUT, @opt_pf);
}

usage() and exit if defined $opt_usage;

open SAVESTDIN,  '<&', \*STDIN  or die "open: $!";
open SAVESTDOUT, '>&', \*STDOUT or die "open: $!";
open SAVESTDERR, '>&', \*STDERR or die "open: $!";

sub recover_stdin {
    open STDIN, '<&', \*SAVESTDIN or die "open: $!";
}
sub recover_stderr {
    open STDERR, '>&', \*SAVESTDERR or die "open: $!";
    binmode STDERR, ':encoding(utf8)';
}
sub recover_stdout {
    close STDOUT;
    open STDOUT, '>&', \*SAVESTDOUT or die "open: $!";
}
sub close_stdout {
    close SAVESTDOUT;
    close STDOUT;
}

sub read_stdin { <SAVESTDIN> }

my $slurp = do {
    ##
    ## Setting utf8 warnings fatal makes it easy to find code conversion
    ## error, so you can choose appropriate file code or automatic code
    ## recognition, but loose a chance to find string in unrelated area.
    ##
    if ($opt_error =~ /^(?: fatal | skip | retry )$/x) {
	if ($opt_warn{read}) {
	    sub {
		use warnings FATAL => 'utf8';
		my $stdin = eval { local $/; <STDIN> };
		warn $@ if $@;
		$stdin;
	    }
	} else {
	    sub {
		use warnings FATAL => 'utf8';
		eval { local $/; <STDIN> };
	    }
	}
    } elsif ($opt_error eq 'ignore') {
	if ($opt_warn{read}) {
	    sub { local $/; <STDIN> };
	} else {
	    sub {
		close STDERR;
		my $stdin = do { local $/; <STDIN> };
		recover_stderr;
		$stdin;
	    }
	}
    } else {
	die "$opt_error: invalid action.\n";
    }
};

use Term::ANSIColor::Concise qw(ansi_code);

use constant {
    EL  => ansi_code('{EL}'),    # Erase Line
    ED  => ansi_code('{ED}'),    # Erase Display
    SCP => ansi_code('{SCP}'),   # Save Cursor Position
    RCP => ansi_code('{RCP}'),   # Restore Cursor Position
    DSC => ansi_code('{DECSC}'), # DEC Save Cursor
    DRC => ansi_code('{DECRC}'), # DEC Restore Cursor
    CR  => "\r",
};

my($progress_show, $progress_reset) = do {
    my $n;
    my($s, $e) = ! $need_color ? ('', '') :
	( ansi_code $colormap{PROGRESS}, ansi_code 'Z');
    my $print = sub { STDERR->printflush(DSC, $s, @_, $e, CR, DRC) };
    my $start = do {
	if ($opt_d{n} and $opt_d{f}) {
	    sub { $print->(++$n, " ", $current_file, ED) }
	}
	elsif ($opt_d{n}) {
	    sub { $print->(++$n) }
	}
	elsif ($opt_d{f}) {
	    sub { STDERR->printflush($current_file, ":\n") }
	}
	else {
	    undef;
	}
    };
    my $end = do {
	if ($opt_d{n}) {
	    sub { STDERR->printflush(ED) if $n }
	} else {
	    undef;
	}
    };
    ($start, $end);
};

##------------------------------------------------------------
## now ready to run.
##

## record start time
if ($opt_d{s}) {
    $stat{time_start} = [times];
}

for (@opt_prologue) { $_->call() }