diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | doio.c | 18 | ||||
| -rw-r--r-- | pod/perlrun.pod | 36 | ||||
| -rwxr-xr-x | t/io/iprefix.t | 30 |
4 files changed, 74 insertions, 11 deletions
@@ -772,6 +772,7 @@ t/io/argv.t See if ARGV stuff works t/io/dup.t See if >& works right t/io/fs.t See if directory manipulations work t/io/inplace.t See if inplace editing works +t/io/iprefix.t See if inplace editing works with prefixes t/io/pipe.t See if secure pipes work t/io/print.t See if print commands work t/io/read.t See if read works @@ -421,11 +421,19 @@ nextargv(register GV *gv) continue; } if (*inplace) { -#ifdef SUFFIX - add_suffix(sv,inplace); -#else - sv_catpv(sv,inplace); -#endif + char *star = strchr(inplace, '*'); + if (star) { + char *begin = inplace; + sv_setpvn(sv, "", 0); + do { + sv_catpvn(sv, begin, star - begin); + sv_catpvn(sv, oldname, oldlen); + begin = ++star; + } while ((star = strchr(begin, '*'))); + } + else { + sv_catpv(sv,inplace); + } #ifndef FLEXFILENAMES if (PerlLIO_stat(SvPVX(sv),&statbuf) >= 0 && statbuf.st_dev == filedev diff --git a/pod/perlrun.pod b/pod/perlrun.pod index fa41351e80..2a84fdf090 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -298,12 +298,36 @@ prints a summary of the options. =item B<-i>[I<extension>] -specifies that files processed by the C<E<lt>E<gt>> construct are to be edited -in-place. It does this by renaming the input file, opening the output -file by the original name, and selecting that output file as the default -for print() statements. The extension, if supplied, is added to the name -of the old file to make a backup copy. If no extension is supplied, no -backup is made. From the shell, saying +specifies that files processed by the C<E<lt>E<gt>> construct are to be +edited in-place. It does this by renaming the input file, opening the +output file by the original name, and selecting that output file as the +default for print() statements. The extension, if supplied, is used to +modify the name of the old file to make a backup copy, following these +rules: + +If no extension is supplied, no backup is made and the current file is +overwritten. + +If the extension doesn't contain a C<*> then it is appended to the end +of the current filename as a suffix. + +If the extension does contain one or more C<*> characters, then each C<*> +is replaced with the current filename. In perl terms you could think of +this as: + + ($old_file_name = $extension) =~ s/\*/$file_name/g; + +This allows you to add a prefix to the backup file, instead of (or in +addition to) a suffix: + + $ perl -pi'bak_*' -e 's/bar/baz/' fileA # backup to 'bak_fileA' + +Or even to place backup copies of the original files into another +directory (provided the directory already exists): + + $ perl -pi'old/*.bak' -e 's/bar/baz/' fileA # backup to 'old/fileA.bak' + +From the shell, saying $ perl -p -i.bak -e "s/foo/bar/; ... " diff --git a/t/io/iprefix.t b/t/io/iprefix.t new file mode 100755 index 0000000000..b7ade31576 --- /dev/null +++ b/t/io/iprefix.t @@ -0,0 +1,30 @@ +#!./perl + +$^I = 'bak*'; + +# Modified from the original inplace.t to test adding prefixes + +print "1..2\n"; + +@ARGV = ('.a','.b','.c'); +if ($^O eq 'MSWin32') { + $CAT = '.\perl -e "print<>"'; + `.\\perl -le "print 'foo'" > .a`; + `.\\perl -le "print 'foo'" > .b`; + `.\\perl -le "print 'foo'" > .c`; +} +else { + $CAT = 'cat'; + `echo foo | tee .a .b .c`; +} +while (<>) { + s/foo/bar/; +} +continue { + print; +} + +if (`$CAT .a .b .c` eq "bar\nbar\nbar\n") {print "ok 1\n";} else {print "not ok 1\n";} +if (`$CAT bak.a bak.b bak.c` eq "foo\nfoo\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} + +unlink '.a', '.b', '.c', 'bak.a', 'bak.b', 'bak.c'; |