mail-uplift fix lines before and after message separator
[ipreg/sccs2rcs2cvs2git.git] / sccs2cvs
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5
6 use feature 'switch';
7
8 use Cwd 'realpath';
9 use File::Basename;
10 use File::Find;
11 use File::Path;
12 use POSIX;
13
14 sub usage {
15 die <<USAGE;
16 usage: sccs2cvs [-m<usermap>] [-w<user>] <source> <target>
17
18 Create a CVS repository at the target, and convert the source
19 directory tree into a module in the CVS repository.
20
21 Commits from SCCS are transferred to the CVS repository. Commits are
22 synthesized for files which are not checked in to SCCS, attribued to
23 the give, user.
24
25 This is a destructive conversion, to make it easier to see what was
26 not converted.
27
28 If a file was not checked out in the SCCS working tree, a tombstone is
29 left behind in the form of a symlink pointing at 'Attic'. The caller
30 can then invoke rcsdeadify if necessary.
31
32 Names within the CVS repo are relative to the parent directory of the
33 source directory tree, so the basename of the source tree becomes the
34 module name within the repository.
35
36 USAGE
37 }
38
39 sub shite { die "sccs2cvs: @_: $!\n"; }
40 sub shit { die "sccs2cvs: @_\n"; }
41 sub whoa { warn "sccs2cvs: \e[32m@_\e[0m\n"; }
42
43 sub sysx {
44 system @_;
45 shit "failed: @_" if $?;
46 }
47
48 sub popen ($) {
49 my $cmd = shift;
50 my @out = qx{$cmd};
51 shit "failed: $cmd" if $?;
52 if (wantarray) { return @out }
53 else { return join '', @out }
54 }
55
56 usage unless @ARGV > 2 and @ARGV < 5;
57
58 my @useropt = ();
59 push @useropt, shift while $ARGV[0] =~ m{^-[mw]};
60
61 # because we change directory below
62 for (@useropt) {
63 $_ = "-m" . realpath($1) if m{^-m(.*)};
64 }
65
66 my $usrc = shift;
67 my $udst = shift;
68
69 my $src = realpath $usrc;
70 my $dst = realpath $udst;
71
72 shit "target $udst already exists" if -d $dst;
73
74 # almost all the CVS we need :-)
75 my $qdst = quotemeta $dst;
76 sysx "cvs -d $qdst init";
77
78 my $pdir = dirname $src;
79 my $qpdir = quotemeta $pdir;
80
81 # case-sensitive -f
82 sub _f {
83 my $f = shift;
84 return -f $f && 1 == grep { $_ eq $f } glob "$f*";
85 }
86
87 # executable by anyone?
88 sub _x {
89 my $f = shift;
90 return (_f $f) && ((stat $f)[2] & 0111)
91 }
92
93 find { wanted => \&found, no_chdir => 1}, $src;
94
95 sub found {
96 # only interested in files
97 return unless -f;
98
99 shit "unable to uplift gzip files" if m{\.gz$};
100
101 m{^$qpdir/(.+?)/(SCCS/[sp]\.)?([^/]+)~?$}
102 or shit "could not parse $_";
103 my $subdir = $1;
104 my $name = $3;
105
106 mkpath "$dst/$subdir";
107 chdir "$dst/$subdir" or shite "chdir $dst/$subdir";
108
109 my $file = "$pdir/$subdir/$name";
110 my $back = "$pdir/$subdir/$name~";
111 my $sccs = "$pdir/$subdir/SCCS/s.$name";
112 my $lock = "$pdir/$subdir/SCCS/p.$name";
113 my $qfile = quotemeta $file;
114 my $qback = quotemeta $back;
115 my $qsccs = quotemeta $sccs;
116
117 unlink $lock and whoa "deleted lock $lock";
118
119 # SCCS conversion?
120 if (_f $sccs) {
121 whoa "converting $sccs";
122 sysx 'sccs2rcs1', $sccs;
123 if (_x $sccs or _x $file) {
124 whoa "executable $file";
125 chmod 0555, "$name,v";
126 }
127 # Any other files need fixups?
128 if (_f $file) {
129 system "sccs get -s -k -p $qsccs | diff - $qfile >/dev/null";
130 shit "diff $sccs $file failed"
131 if ! WIFEXITED($?) || WEXITSTATUS($?) > 1;
132 # edit in progress
133 if (WEXITSTATUS($?) == 1) {
134 whoa "merge $file";
135 sysx 'files2rcs', @useropt, "$name,v", $file
136 }
137 whoa "clean $file";
138 unlink $file;
139 } else {
140 # leave a tombstone
141 whoa "attic $file";
142 symlink 'Attic', $file;
143 }
144 if (_f $back) {
145 # does it match a revision in the SCCS file?
146 for my $rev (popen qq{sccs prs -e -d:I: $qsccs}) {
147 chomp $rev;
148 system "sccs get -s -k -p -r$rev $qsccs | diff - $qback >/dev/null";
149 if ($? == 0) {
150 whoa "clean $back";
151 unlink $back;
152 }
153 }
154 }
155 # no match in the SCCS file
156 if (_f $back) {
157 whoa "converting $back";
158 sysx 'files2rcs', @useropt, "$name~,v", $back;
159 # does it predate the SCCS file?
160 my $mtime = strftime "%Y-%m-%d.%H:%M:%S",
161 localtime((stat $back)[9]);
162 my $time1 = popen qq{sccs prs -r1.1 -d':D:.:T:' $qsccs};
163 chomp $time1;
164 $time1 =~ s{^([789])}{19$1} or $time1 =~ s{^}{20};
165 if ($mtime < $time1) {
166 whoa "append $file";
167 sysx 'rcsappend', "$name~,v", "$name,v";
168 unlink "$name,v";
169 rename "$name~,v", "$name,v";
170 }
171 whoa "clean $back";
172 unlink $back;
173 }
174 whoa "clean $sccs";
175 unlink $sccs;
176 }
177 if (_f $back) {
178 whoa "converting $back";
179 sysx 'files2rcs', @useropt, "$name~,v", $back;
180 whoa "clean $back";
181 unlink $back;
182 # so the next files2rcs appends to the same history
183 if (_f $file) {
184 rename "$name~,v", "$name,v"
185 or shite "rename $name~,v -> $name,v";
186 }
187 }
188 if (_f $file) {
189 whoa "converting $file";
190 sysx 'files2rcs', @useropt, "$name,v", $file;
191 whoa "clean $file";
192 unlink $file;
193 }
194 }
195
196 whoa "DONE sccs2cvs W00T";