sccscheck: find weirdness in an SCCS tree
authorTony Finch <dot@dotat.at>
Tue, 28 Oct 2014 14:58:32 +0000 (14:58 +0000)
committerTony Finch <dot@dotat.at>
Tue, 28 Oct 2014 14:58:32 +0000 (14:58 +0000)
sccscheck [new file with mode: 0755]

diff --git a/sccscheck b/sccscheck
new file mode 100755 (executable)
index 0000000..d6b8499
--- /dev/null
+++ b/sccscheck
@@ -0,0 +1,65 @@
+#!/usr/bin/perl
+
+use warnings;
+use strict;
+
+use feature 'switch';
+
+use File::Find;
+
+unless (@ARGV) {
+       die <<USAGE;
+usage: sccscheck [directory]
+
+Scan the directory tree for anomalies:
+
+gzipped files
+backup ~ files
+symlinks
+SCCS files without working files
+working files without SCCS files
+working files which do not match the latest SCCS revision
+
+USAGE
+}
+
+find { wanted => \&found, no_chdir => 1}, @ARGV;
+
+sub found {
+       given ($File::Find::name) {
+               when (m{^(.*)/SCCS/s\.([^/]+)$}s) {
+                       when (m{~$}) {
+                               print "SCCS BACK $_\n";
+                       }
+                       when (m{\.gz$}) {
+                               print "SCCS GZIP $_\n";
+                       }
+                       when (! -f "$1/$2") {
+                               print "SCCS UNGET $_\n";
+                       }
+               }
+               when (m{~$}) {
+                       print "BACK $_\n";
+               }
+               when (m{\.gz$}) {
+                       print "GZIP $_\n";
+               }
+               when (-l) {
+                       print "LINK $_\n";
+               }
+               when (-d) {
+                       # skip
+               }
+               default {
+                       m{^(.*)/([^/]+)$}s;
+                       my $sccs = "$1/SCCS/S.$2";
+                       when (! -f $sccs) {
+                               print "NO SCCS $_\n";
+                       }
+                       my $qsccs = quotemeta $sccs;
+                       my $qfile = quotemeta $_;
+                       system "sccs get -k -p $qsccs | diff -u - $qfile";
+                       print "DIFF $_\n" if $?;
+               }
+       }
+}