mzs: adjust relative paths to match ipreg repo
[ipreg/sccs2rcs2cvs2git.git] / sccscheck
CommitLineData
430a32a5
TF
1#!/usr/bin/perl
2
3use warnings;
4use strict;
5
6use feature 'switch';
7
635da65a
TF
8no warnings 'experimental::smartmatch';
9
430a32a5 10use File::Find;
409dfd31 11use POSIX;
430a32a5
TF
12
13unless (@ARGV) {
14 die <<USAGE;
15usage: sccscheck [directory]
16
17Scan the directory tree for anomalies:
18
19gzipped files
20backup ~ files
21symlinks
22SCCS files without working files
23working files without SCCS files
24working files which do not match the latest SCCS revision
25
26USAGE
27}
28
072baecf
TF
29# case-sensitive -f
30sub _f {
31 my $f = shift;
32 return -f $f && 1 == grep { $_ eq $f } glob "$f*";
33}
34
430a32a5
TF
35find { wanted => \&found, no_chdir => 1}, @ARGV;
36
37sub 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 }
072baecf 46 when (! _f "$1/$2") {
430a32a5
TF
47 print "SCCS UNGET $_\n";
48 }
49 }
1d19c466 50 when (m{^(.*)/SCCS/p\.([^/]+)$}s) {
b94f735c 51 print "SCCS LOCK $_\n";
1d19c466 52 }
1c7b6725 53 when (m{^(.*)/([^/]+)~$}s) {
409dfd31 54 my $sccs = "$1/SCCS/s.$2";
072baecf 55 when (_f $sccs) {
409dfd31
TF
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 }
7608db43 70 my $time1 = qx{sccs prs -r1.1 -d':D:.:T:' $qsccs};
cdc503df 71 chomp $time1;
7608db43
TF
72 $time1 =~ s{^([789])}{19$1} or $time1 =~ s{^}{20};
73 if ($mtime lt $time1) {
27246ca3 74 print "BACKSCCS PREDATE $_\n";
7608db43
TF
75 } else {
76 print "BACKSCCS NOMATCH $mtime $time1 $_\n";
77 }
409dfd31 78 continue;
d8e7a84a 79 }
072baecf 80 when (_f "$1/$2") {
848f3df9 81 my $qback = quotemeta $_;
d8e7a84a 82 my $qfile = quotemeta "$1/$2";
2edcbb1f 83 system "diff -u $qback $qfile >/dev/null";
d4070992 84 if (not $?) {
848f3df9 85 print "BACKSAME $_\n"
d4070992
TF
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 }
848f3df9
TF
94 }
95 }
96 print "BACKLESS $_\n";
430a32a5
TF
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;
409dfd31 109 my $sccs = "$1/SCCS/s.$2";
072baecf 110 when (! _f $sccs) {
430a32a5
TF
111 print "NO SCCS $_\n";
112 }
113 my $qsccs = quotemeta $sccs;
114 my $qfile = quotemeta $_;
cdc503df
TF
115 system "sccs get -s -k -p $qsccs | diff -u - $qfile >/dev/null";
116 print "SCCS DIFF $_\n" if $?;
430a32a5
TF
117 }
118 }
119}