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