mail-uplift fix lines before and after message separator
[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
41 our $usermap;
42 if ($ARGV[0] =~ m{^-m(.*)}) {
43 do $1 or shite "read $1";
44 shit "missing usermap in $1" unless defined $usermap;
45 shift;
46 }
47 my $wuser;
48 if ($ARGV[0] =~ m{^-w}) {
49 $wuser = shift;
50 }
51
52 my $filev = shift @ARGV;
53
54 # hack to work around files whose names start with a comma
55 my $target = $filev;
56 undef $target unless $filev =~ s{^,}{COMMA.};
57
58 usage unless $filev =~ m{^([^/]+),v$};
59 my $file = $1;
60
61 # create RCS file in binary mode (to avoid keyword expansion)
62 # with no lock enforcement (to avoid lock/unlock faff)
63 sysx 'rcs', '-i', '-kb', '-U', '-t-', $filev
64 unless -f $filev;
65
66 # give rcs ci an empty stdin to read for empty commit messages
67 open STDIN, '<', '/dev/null'
68 or shite "open STDIN < /dev/null";
69
70 for my $src (@ARGV) {
71 my @stat = stat $src or shite "stat $src";
72 my $mtime = strftime "%Y/%m/%d %H:%M:%S", localtime($stat[9]);
73 my $wopt = $usermap->{$src} if defined $usermap;
74 $wopt = defined $wopt ? "-w$wopt" : $wuser;
75 $wopt = getpwuid($stat[4]) if not defined $wopt;
76 my $basename = $src;
77 $basename =~ s{^.*/([^/]+)$}{$1};
78 sysx 'cp', $src, $file;
79 sysx 'ci', '-f', $wopt, "-d$mtime", $filev, $file;
80 unlink $file;
81 }
82
83 if ($target) {
84 rename $filev, $target
85 or shite "rename $filev -> $target";
86 }