mzs: adjust relative paths to match ipreg repo
[ipreg/sccs2rcs2cvs2git.git] / files2rcs
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5
6 use POSIX;
7
8 sub usage () {
9         die <<USAGE;
10 usage: files2rcs [-m<usermap>] [-w<user>] <file,v> <files>
11
12 files2rcs adds revisions to an RCS file consisting of the given files
13 in order. The RCS file is created if it does not already exist. This
14 command overwrites and deletes a temporary working file in the current
15 directory with the same basename as the RCS file.
16
17 The file modification times are used for the revision timestamps, so
18 the files must be listed from older to newer. (RCS rejects checkins
19 with an older date than the latest revision.)
20
21 The commit message is empty.
22
23 The committer userid comes from an entry in the usermap file, if the
24 usermap is provided and if there is an entry in it. (See tar2usermap)
25 Otherwise it comes from the -w option if that is provided, otherwise
26 the file's owner.
27
28 USAGE
29 }
30
31 sub shite { die "files2rcs: @_: $!\n"; }
32 sub shit  { die "files2rcs: @_\n"; }
33
34 sub sysx {
35         system @_;
36         shit "failed: @_" if $?;
37 }
38
39 usage unless @ARGV > 1;
40 warn "\e[34m$0 @ARGV\e[0m\n";
41
42 our $usermap;
43 if ($ARGV[0] =~ m{^-m(.*)}) {
44         do $1 or shite "read $1";
45         shit "missing usermap in $1" unless defined $usermap;
46         shift;
47 }
48 my $wuser;
49 if ($ARGV[0] =~ m{^-w}) {
50         $wuser = shift;
51 }
52
53 my $filev = shift @ARGV;
54
55 # hack to work around files whose names start with a comma
56 my $target = $filev;
57 undef $target unless $filev =~ s{^,}{COMMA.};
58
59 usage unless $filev =~ m{^([^/]+),v$};
60 my $file = $1;
61
62 # create RCS file in binary mode (to avoid keyword expansion)
63 # with no lock enforcement (to avoid lock/unlock faff)
64 sysx 'rcs', '-i', '-kb', '-U', '-t-', $filev
65     unless -f $filev;
66
67 # give rcs ci an empty stdin to read for empty commit messages
68 open STDIN, '<', '/dev/null'
69     or shite "open STDIN < /dev/null";
70
71 for my $src (@ARGV) {
72         my @stat = stat $src or shite "stat $src";
73         my $mtime = strftime "%Y/%m/%d %H:%M:%S", localtime($stat[9]);
74         my $wopt = $usermap->{$src} if defined $usermap;
75         $wopt = defined $wopt ? "-w$wopt" : $wuser;
76         $wopt = getpwuid($stat[4]) if not defined $wopt;
77         my $basename = $src;
78         $basename =~ s{^.*/([^/]+)$}{$1};
79         sysx 'cp', $src, $file;
80         sysx 'ci', '-f', $wopt, "-d$mtime", $filev, $file;
81         unlink $file;
82 }
83
84 if ($target) {
85         rename $filev, $target
86             or shite "rename $filev -> $target";
87 }