mail-uplift fix lines before and after message separator
[ipreg/sccs2rcs2cvs2git.git] / sccsprefix
CommitLineData
30e5cb41
TF
1#!/usr/bin/perl
2
3use warnings;
4use strict;
5
6use feature 'switch';
7
8use File::Find;
9use POSIX;
10
11unless (@ARGV == 2) {
12 die <<USAGE;
13usage: sccsprefix <old> <new>
14
15Verify that the old SCCS file is a prefix of the new SCCS file.
16
17USAGE
18}
19
20sub shit { die "sccsprefix: @_\n"; }
21
22sub popen ($) {
23 my $cmd = shift;
24 my @out = qx{$cmd};
25 shit "failed: $cmd" if $?;
26 if (wantarray) { return @out }
27 else { return join '', @out }
28}
29
30sub getfile {
31 my $file = shift @ARGV;
32 my $qfile = quotemeta $file;
33 my @rev = popen qq{sccs prs -e -d:I: $qfile};
34 return { name => $file, qname => $qfile, rev => \@rev };
35}
36
37sub getrev {
38 my $f = shift;
39 my $r = shift;
15bfe0a2 40 chomp $r;
30e5cb41
TF
41 return popen qq{sccs get -s -k -p -r$r $f->{qname}};
42}
43
44my $f1 = getfile;
45my $f2 = getfile;
46
47shit "old file $f1->{name} has more revisions than new file $f2->{name}"
48 if @{$f1->{rev}} > @{$f2->{rev}};
49
50for my $rev (@{$f1->{rev}}) {
51 my $t1 = getrev $f1, $rev;
52 my $t2 = getrev $f2, $rev;
53 shit "mismatch at revision $rev" if $t1 ne $t2;
54}