view release on metacpan or  search on metacpan

script/greple  view on Meta::CPAN

our %opt_d;
@opt_d = map { split // } @opt_d;
@opt_d{@opt_d} = @opt_d;

if ($opt_d{o}) {
    warn "\@ARGV = ", join(' ', shellquote(@SAVEDARGV)), "\n";
}

## -m option
my @splicer = (not defined $opt_m) ? () : do {
    my @param = split /,/, $opt_m, -1;
    push @param, '' if @param % 2;
    if (notall { /^(-?\d+)?$/ } @param) {
	die "$opt_m: option format error.\n";
    }
    map {
	my($offset, $length) = @$_;
	if ($length ne '') {
	    sub { splice @{+shift}, $offset || 0, $length }
	} else {
	    sub { splice @{+shift}, $offset || 0 }
	}
    }
    pairs @param;
};

my $file_code;
my $default_icode = 'utf8';	# default input encoding
my @default_icode_list = qw(euc-jp 7bit-jis);
my $output_code;
my $default_ocode = 'utf8';	# default output encoding

$output_code = $opt_ocode || $default_ocode;
binmode STDOUT, ":encoding($output_code)";

## show unused option characters
if ($opt_d{u}) {
    my $s = join('','0'..'9',"\n",'a'..'z',"\n",'A'..'Z',"\n");
    map { /\|([0-9a-zA-Z])\b/ && $s =~ s/$1/./ } @optargs;
    die $s;
}

## show man pages
if ($opt_man or $opt_show or $opt_path) {
    my @module = map {
	/^-M(\w+(::\w++(?![=(]))*)/ ? "App::Greple::$1" : ()
    } @ORIG_ARGV;
    if (@module) {
	my $module = $module[-1];
	my $jp = first { -x "$_/perldocjp" } split /:/, $ENV{PATH};
	my $perldoc = $jp ? "perldocjp" : "perldoc";
	$ENV{PERL5LIB} = join ':', @INC;
	my $file = $module =~ s[::][/]gr . '.pm';
	die unless $INC{$file};
	if ($opt_man) {
	    exec "$perldoc $module" or die $!;
	} else {
	    chomp(my $file = `$perldoc -ml $module`);
	    if ($opt_path) {
		say $file;
	    } else {
		my $pager = $ENV{PAGER} || 'less';
		exec "$pager $file" or die $!;
	    }
	}
	exit;
    }
    pod2usage({-verbose => 2});
    die;
}

sub default_module {
    my $mod = shift;
    my $module = $mod->module;
    return 1 if $module =~ /\b \.greplerc $/x;
    return 1 if $module =~ /\b default $/x;
    return 0;
}

## setup file encoding
if (@opt_icode) {
    @opt_icode = map { split /[,\s]+/ } @opt_icode;
    if (grep { s/^\+// } @opt_icode) {
	unshift @opt_icode, @default_icode_list;
    }
    @opt_icode = uniq @opt_icode;
    if (@opt_icode > 1) {
	@opt_icode = grep { !/(?:auto|guess)$/i } @opt_icode;
	Encode::Guess->set_suspects(@opt_icode);
	$file_code = 'Guess';
    }
    elsif ($opt_icode[0] =~ /^(?:guess|auto)$/i) {
	Encode::Guess->set_suspects(@default_icode_list);
	$file_code = 'Guess';
    } else {
	$file_code = $opt_icode[0];
    }
}
else {
    $file_code = $default_icode;
}

##
## --filter
##
if ($opt_filter) {
    $opt_all = 1;
    push @opt_need, '0';
    $opt_exit //= 0;
}

##
## Patterns
##

my $pat_holder = App::Greple::Pattern::Holder->new;

my $FLAG_BASE = FLAG_NONE;
$FLAG_BASE |= FLAG_IGNORECASE if $opt_i;