From: Colin Kuskie <ckuskie@cadence.com>
Date: Tue, 7 Jul 1998 09:44:33 +0000 (-0700)
Subject: added patch for -i'foo*bar', made code somewhat simpler, tweaked doc
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2d259d9294e79c03b1a69d3eaac3d6e5647468d7;p=p5sagit%2Fp5-mst-13.2.git

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