mzs: adjust relative paths to match ipreg repo
[ipreg/sccs2rcs2cvs2git.git] / sccsprefix
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5
6 use feature 'switch';
7
8 use File::Find;
9 use POSIX;
10
11 unless (@ARGV == 2) {
12         die <<USAGE;
13 usage: sccsprefix <old> <new>
14
15 Verify that the old SCCS file is a prefix of the new SCCS file.
16
17 USAGE
18 }
19
20 sub shit  { die "sccsprefix: @_\n"; }
21
22 sub 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
30 sub 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
37 sub getrev {
38         my $f = shift;
39         my $r = shift;
40         chomp $r;
41         return popen qq{sccs get -s -k -p -r$r $f->{qname}};
42 }
43
44 my $f1 = getfile;
45 my $f2 = getfile;
46
47 shit "old file $f1->{name} has more revisions than new file $f2->{name}"
48     if @{$f1->{rev}} > @{$f2->{rev}};
49
50 for 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 }