Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
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 pondering the Monastery: (10)
As of 2014-11-27 09:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (182 votes), past polls