Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical

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 - Cleans up perllocal.pod

use strict;
use warnings;

use Pod::Perldoc;

    # Find perllocal.pod
    my ($pod) = Pod::Perldoc->new()->grand_search_init([ 'perllocal' ]
    if (! $pod) {
        print(STDERR "WARNING: 'perllocal.pod' not found\n");

    # 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/) {

        # 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})) {
                # 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));

    } else {
        print(STDERR "ERROR: Failure opening '$pod': $!\n");

    # 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");
                } 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'}
+ }
            # Output the module entry
            print($OUT $pod{$module}{'text'});

    } else {
        print(STDERR "ERROR: Failure opening '$pod': $!\n");

    # Report on results
    print("'perllocal' now contains $cnt entries.  ($removed removed.)


Replies are listed 'Best First'.
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.
Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://483020]
[marto]: meh, that's the last time I reply to finddata, I don't see an improvement in attitude or approach
Discipulus there are none so deaf as those who will not hear..
Discipulus who do not want to ear
[Corion]: marto: No, I haven't seen anything either and I'm not sure if learning-by- osmosis will work here
[marto]: I've experienced the behavior LanX described, outsourcing really opens your eyes to the situation :)
[Discipulus]: ;=)

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (7)
As of 2017-03-30 07:06 GMT
Find Nodes?
    Voting Booth?
    Should Pluto Get Its Planethood Back?

    Results (353 votes). Check out past polls.