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