added patch for -i'foo*bar', made code somewhat simpler, tweaked doc

	Message-ID: <Pine.GSO.3.96.980707093457.28681A-100000@pdxue150.cadence.com>
	Subject: Corrected -i prefix patch

p4raw-id: //depot/perl@1368

diff --git a/MANIFEST b/MANIFEST
index 30d25fc..3873709 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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

diff --git a/doio.c b/doio.c
index ff8384c..f74f0ea 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -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 fa41351..2a84fdf 100644 (file)
--- 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 (executable)
index 0000000..b7ade31
--- /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';