This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a script for being 8.3-polite.
authorJarkko Hietaniemi <jhi@iki.fi>
Mon, 17 Sep 2001 12:55:53 +0000 (12:55 +0000)
committerJarkko Hietaniemi <jhi@iki.fi>
Mon, 17 Sep 2001 12:55:53 +0000 (12:55 +0000)
The found conflicts are being worked on.

p4raw-id: //depot/perl@12051

Porting/pumpkin.pod
check83.pl [new file with mode: 0644]

index a816c48..44fde71 100644 (file)
@@ -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 (file)
index 0000000..69e00c6
--- /dev/null
@@ -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";
+       }
+    }
+}