mzs: adjust relative paths to match ipreg repo
[ipreg/sccs2rcs2cvs2git.git] / sccscheck
1 #!/usr/bin/perl
2
3 use warnings;
4 use strict;
5
6 use feature 'switch';
7
8 no warnings 'experimental::smartmatch';
9
10 use File::Find;
11 use POSIX;
12
13 unless (@ARGV) {
14 die <<USAGE;
15 usage: sccscheck [directory]
16
17 Scan the directory tree for anomalies:
18
19 gzipped files
20 backup ~ files
21 symlinks
22 SCCS files without working files
23 working files without SCCS files
24 working files which do not match the latest SCCS revision
25
26 USAGE
27 }
28
29 # case-sensitive -f
30 sub _f {
31 my $f = shift;
32 return -f $f && 1 == grep { $_ eq $f } glob "$f*";
33 }
34
35 find { wanted => \&found, no_chdir => 1}, @ARGV;
36
37 sub found {
38 given ($File::Find::name) {
39 when (m{^(.*)/SCCS/s\.([^/]+)$}s) {
40 when (m{~$}) {
41 print "SCCS BACK $_\n";
42 }
43 when (m{\.gz$}) {
44 print "SCCS GZIP $_\n";
45 }
46 when (! _f "$1/$2") {
47 print "SCCS UNGET $_\n";
48 }
49 }
50 when (m{^(.*)/SCCS/p\.([^/]+)$}s) {
51 print "SCCS LOCK $_\n";
52 }
53 when (m{^(.*)/([^/]+)~$}s) {
54 my $sccs = "$1/SCCS/s.$2";
55 when (_f $sccs) {
56 # was the backup checked in?
57 my $mtime = strftime "%Y-%m-%d.%H:%M:%S%z",
58 localtime((stat)[9]);
59 my $qsccs = quotemeta $sccs;
60 my $qback = quotemeta $_;
61 my @revs = qx{sccs prs -e -d:I: $qsccs};
62 for my $rev (@revs) {
63 chomp $rev;
64 system "sccs get -s -k -p -r$rev $qsccs | diff -u - $qback >/dev/null";
65 if ($? == 0) {
66 print "BACKSCCS $rev $_\n";
67 break;
68 }
69 }
70 my $time1 = qx{sccs prs -r1.1 -d':D:.:T:' $qsccs};
71 chomp $time1;
72 $time1 =~ s{^([789])}{19$1} or $time1 =~ s{^}{20};
73 if ($mtime lt $time1) {
74 print "BACKSCCS PREDATE $_\n";
75 } else {
76 print "BACKSCCS NOMATCH $mtime $time1 $_\n";
77 }
78 continue;
79 }
80 when (_f "$1/$2") {
81 my $qback = quotemeta $_;
82 my $qfile = quotemeta "$1/$2";
83 system "diff -u $qback $qfile >/dev/null";
84 if (not $?) {
85 print "BACKSAME $_\n"
86 } else {
87 my $backtime = (stat $_)[9];
88 my $filetime = (stat "$1/$2")[9];
89 if ($backtime < $filetime) {
90 print "BACKDIFF $_\n";
91 } else {
92 print "BACKTIMEWARP $_\n";
93 }
94 }
95 }
96 print "BACKLESS $_\n";
97 }
98 when (m{\.gz$}) {
99 print "GZIP $_\n";
100 }
101 when (-l) {
102 print "LINK $_\n";
103 }
104 when (-d) {
105 # skip
106 }
107 default {
108 m{^(.*)/([^/]+)$}s;
109 my $sccs = "$1/SCCS/s.$2";
110 when (! _f $sccs) {
111 print "NO SCCS $_\n";
112 }
113 my $qsccs = quotemeta $sccs;
114 my $qfile = quotemeta $_;
115 system "sccs get -s -k -p $qsccs | diff -u - $qfile >/dev/null";
116 print "SCCS DIFF $_\n" if $?;
117 }
118 }
119 }