mzs: adjust relative paths to match ipreg repo
[ipreg/sccs2rcs2cvs2git.git] / rcsdeadify
1 #!/usr/bin/perl
2 #
3 # See http://cvsbook.red-bean.com/cvsbook.html#What%20Happens%20When%20You%20Remove%20A%20File
4
5 use warnings;
6 use strict;
7
8 sub usage () {
9         die <<USAGE;
10 usage: rcsdeadify <target,v> <date> <user>
11
12 rcsdeadify marks a file as deleted in the same way as CVS. It adds a
13 revision to the RCS file with the given date, marks that revision's
14 state dead, and moves the file to the Attic subdirectory. It
15 overwrites and deletes a temporary working file in the same directory
16 as <target,v> with the basename <target>.
17
18 USAGE
19 }
20
21 sub shite { die "rcsdeadify: @_: $!\n"; }
22 sub shit  { die "rcsdeadify: @_\n"; }
23
24 sub sysx {
25         system @_;
26         shit "failed: @_" if $?;
27 }
28
29 usage unless @ARGV == 3;
30
31 my $filev = shift;
32
33 # hack to work around files whose names start with a comma
34 my $target = $filev;
35 undef $target unless $filev =~ s{^,}{COMMA.};
36
37 usage unless $filev =~ m{^([^/]*),v$};
38 my $file = $1;
39
40 my $date = shift;
41 my $user = shift;
42
43 if ($target) {
44         rename $target, $filev
45             or shite "rename $target -> $filev";
46 }
47
48 # give rcs ci an empty stdin to read for empty commit messages
49 open STDIN, '<', '/dev/null'
50     or shite "open STDIN < /dev/null";
51
52 # no keyword expansion please
53 sysx 'co', '-kb', $filev, $file;
54 sysx 'ci', '-f', "-d$date", "-w$user", $filev, $file;
55 sysx 'rcs', '-sdead', $filev;
56 mkdir 'Attic';
57 sysx 'mv', $filev, 'Attic';
58 unlink $file;
59
60 if ($target) {
61         rename "Attic/$filev", "Attic/$target"
62             or shite "rename $filev -> $target";
63 }