view release on metacpan or  search on metacpan

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

    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 '';

    if (my $suffix = $opt_suffix) {
	$newname = $filename . $suffix;
	for (my $i = 1; -f $newname; $i++) {
	    $newname = $filename . $suffix . "_$i";
	}
    }

    my $create = do {
	if ($arg{replace}) {
	    if ($newname ne '') {
		warn "rename $filename -> $newname\n";
		rename $filename, $newname or die "rename: $!\n";
		die if -f $filename;
	    } else {
		warn "overwrite $filename\n";
	    }
	    $filename;
	} else {
	    warn "create $newname\n";
	    $newname;
	}
    };

    open my $fh, ">", $create or die "open: $create $!\n";
    $fh->print($divert_buffer);
    $fh->close;
}

1;

__DATA__

builtin diffcmd=s     $opt_update_diffcmd
builtin update-suffix=s      $opt_suffix
builtin U=i           $opt_U
builtin remember!     $remember_data
builtin with-backup:s $opt_backup

option default \
	--prologue update_initialize \
	--begin    update_begin

expand ++dump --all -h --color=never --no-newline --no-line-number
option --update::diff    ++dump --of &update_diff
option --update::create  ++dump --begin update_divert --end update_file() --update-suffix=.new
option --update::update  ++dump --begin update_divert --end update_file(replace)
option --update::discard        --begin update_divert --end update_file(discard)

option --diff    --update::diff
option --create  --update::create
option --update  --update::update
option --discard --update::discard

#  LocalWords:  greple diff sdif cdif