Initial commit of tools.

clean-perllocal

@@ -0,0 +1,103 @@
+#!/usr/bin/perl
+#
+# Clean up a perllocal.pod by removing outdated and duplicate entries.
+# Taken from: http://www.perlmonks.org/?node_id=483020
+#
+
+use strict;
+use warnings;
+$|=1;
+
+use Pod::Perldoc;
+
+MAIN:
+{
+    # Find perllocal.pod
+    my ($pod) = Pod::Perldoc->new()->grand_search_init([ 'perllocal' ]);
+    if (! $pod) {
+        print(STDERR "WARNING: 'perllocal.pod' not found\n");
+        exit(1);
+    }
+
+    # Parse perllocal.pod
+    my %pod;
+    my $removed = 0;
+    if (open(my $IN, $pod)) {
+        my ($line, $module, $order);
+
+        # Read up to first 'head2' line
+        while ($line = readline($IN)) {
+            if ($line =~ /^=head2/) {
+                last;
+            }
+        }
+
+        # Parse each module entry
+        # Duplicates will be overwritten by later entries in the file
+        do {
+            # New module entry encountered
+            if ($line =~ /^=head2/) {
+                # Extract module name from 'head2' line
+                ($module) = $line =~ /L<([^|]+)\|/;
+                # See if it's a duplicate
+                if (exists($pod{$module})) {
+                    $removed++;
+                }
+                # Remember this module's order in the file
+                $pod{$module}{'order'} = ++$order;
+                # Save the text
+                $pod{$module}{'text'} = $line;
+
+            } else {
+                # Concatenate text for current module entry
+                $pod{$module}{'text'} .= $line;
+            }
+        } while ($line = readline($IN));
+        close($IN);
+
+    } else {
+        print(STDERR "ERROR: Failure opening '$pod': $!\n");
+        exit(1);
+    }
+
+    # Check for uninstalls
+    if (@ARGV) {
+        my $arg = shift(@ARGV);
+        if ($arg eq '-u') {
+            for my $mod (@ARGV) {
+                if (delete($pod{$mod})) {
+                    print("$mod removed from 'perllocal'\n");
+                    $removed++;
+                } else {
+                    print("$mod not found in 'perllocal'\n");
+                }
+            }
+        }
+    }
+
+    # Output the cleaned up results
+    my $cnt = 0;
+    if (open(my $OUT, "> $pod")) {
+        # Sort by original order
+        for my $module (sort { $pod{$a}{'order'} <=> $pod{$b}{'order'} }
+                          keys(%pod))
+        {
+            # Output the module entry
+            print($OUT $pod{$module}{'text'});
+            $cnt++;
+        }
+        close($OUT);
+
+    } else {
+        print(STDERR "ERROR: Failure opening '$pod': $!\n");
+        exit(1);
+    }
+
+    # Report on results
+    print("'perllocal' now contains $cnt entries.  ($removed removed.)\n");
+}
+
+exit(0);
+
+# EOF
+