App-Greple-update

 view release on metacpan or  search on metacpan

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

our $opt_U = '';

my $current_file;
my $contents;
my @update_diffcmd;

sub debug {
    $debug = 1;
}

sub update_initialize {
    @update_diffcmd = shellwords $opt_update_diffcmd;
    if ($opt_U ne '') {
	@update_diffcmd = ('diff', "-U$opt_U");
    }
    if (defined $opt_backup) {
	$opt_suffix = $opt_backup ne '' ? $opt_backup : '.bak';
    }
}

sub update_begin {
    my %arg = @_;
    $current_file = delete $arg{&FILELABEL} or die;
    $contents = $_ if $remember_data;
}

#
# define &divert_stdout and &recover_stdout
#
{
    my $diverted = 0;

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

    sub recover_stdout {
	$diverted = $diverted == 1 ? 0 : return;
	close STDOUT;
	open  STDOUT, '>&', \*UPDATE_STDOUT or die "open: $!";
    }
}

use List::Util qw(first);

sub update_diff {
    my $orig = $current_file;
    my $fh;
    state $fdpath = do {
	my $fd = DATA->fileno;
	first { -r "$_/$fd" } qw( /dev/fd /proc/self/fd );
    };

    if ($fdpath and $remember_data) {
	use IO::File;
	use Fcntl;

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

	$orig = sprintf "%s/%d", $fdpath, $fh->fileno;
    }

    @update_diffcmd or confess "Empty diff command";
    exec @update_diffcmd, $orig, "-";
    die "exec: $!\n";
}

my $divert_buffer;

sub update_divert {
    my %arg = @_;
    my $filename = delete $arg{&FILELABEL};

    $divert_buffer = '';
    divert_stdout(\$divert_buffer);
}

sub update_file {
    my %arg = @_;
    my $filename = delete $arg{&FILELABEL};
    my $newname = '';

    recover_stdout() or die;
    return if $arg{discard};
    $divert_buffer = decode 'utf8', $divert_buffer;

    return if $divert_buffer eq $_;
    return if $divert_buffer eq '';

t/Util.pm  view on Meta::CPAN

my $greple_path = get_path('greple', 'App::Greple') or die Dumper \%INC;

sub greple {
    Runner->new($greple_path, @_);
}

sub run {
    greple(@_)->run;
}

sub update {
    greple '-Mupdate', @_;
}

sub slurp {
    my $file = shift;
    open my $fh, "<:utf8", $file or die "open: $!";
    do { local $/; <$fh> };
}

sub line {