From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Mon, 17 Sep 2001 12:55:53 +0000 (+0000)
Subject: Add a script for being 8.3-polite.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9e371ce52563b387ab3a179d3e9ef29da90acdf1;p=p5sagit%2Fp5-mst-13.2.git

Add a script for being 8.3-polite.
The found conflicts are being worked on.

p4raw-id: //depot/perl@12051
---

diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod
index a816c48..44fde71 100644
--- a/Porting/pumpkin.pod
+++ b/Porting/pumpkin.pod
@@ -158,6 +158,7 @@ settled elsewhere.
 
 If feasible, try to keep filenames 8.3-compliant to humor those poor
 souls that get joy from running Perl under such dire limitations.
+There's a script, check83.pl, for keeping your nose 8.3-clean.
 
 =head2 Seek consensus on major changes
 
diff --git a/check83.pl b/check83.pl
new file mode 100644
index 0000000..69e00c6
--- /dev/null
+++ b/check83.pl
@@ -0,0 +1,41 @@
+sub eight_dot_three {
+    my ($dir, $base, $ext) = ($_[0] =~ m!^(?:(.+)/)?([^/.]+)(?:\.([^/.]+))?$!);
+    $base = substr($base, 0, 8);
+    $ext  = substr($ext,  0, 3) if defined $ext;
+    if (defined $dir) {
+	return ($dir, defined $ext ? "$dir/$base.$ext" : "$dir/$base");
+    } else {
+	return ('.', defined $ext ? "$base.$ext" : $base);
+    }
+}
+
+my %dir;
+
+if (open(MANIFEST, "MANIFEST")) {
+    while (<MANIFEST>) {
+	chomp;
+	s/\s.+//;
+	unless (-f) {
+	    warn "$_: missing\n";
+	    next;
+	}
+	if (tr/././ > 1) {
+	    warn "$_: more than one dot\n";
+	    next;
+	}
+	my ($dir, $edt) = eight_dot_three($_);
+	next if $edt eq $_;
+	push @{$dir{$dir}->{$edt}}, $_;
+    }
+} else {
+    die "$0: MANIFEST: $!\n";
+}
+
+for my $dir (sort keys %dir) {
+    for my $edt (keys %{$dir{$dir}}) {
+	my @files = @{$dir{$dir}->{$edt}};
+	if (@files > 1) {
+	    print "$dir $edt @files\n";
+	}
+    }
+}