Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
Problems? Is your data what you think it is?
 
PerlMonks  

Clean up perllocal.pod

by jdhedden (Deacon)
on Aug 11, 2005 at 16:18 UTC ( #483020=snippet: print w/ replies, xml ) Need Help??

Description: The code below cleans up perllocal.pod, removing outdated and duplicate entries. Just run it from the command line:
perllocal
#!/usr/bin/perl
#####
#
# perllocal - Cleans up perllocal.pod
#
#####

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
Comment on Clean up perllocal.pod
Download Code
Re: Clean up perllocal.pod
by rvosa (Curate) on Aug 11, 2005 at 16:51 UTC
    Yup, this works a treat. Nice one. I used to have 100s of duplicate entries for Bio::Phylo (my pet project). Now it's just the one. Thanks!
Re: Clean up perllocal.pod
by zakame (Scribe) on Jul 15, 2011 at 04:17 UTC
    I'm surprised this hasn't become a CPAN module for the longest time (this becomes quite useful in these days of perlbrew and cpanminus.) I'll change that ;)
      I had a few duplicate entries in mine, this cleaned it all up nicely. My OCD thanks you.

Back to Snippets Section

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://483020]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (5)
As of 2014-04-19 13:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (480 votes), past polls