Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

podinherit - Imports pod from superclasses

by rvosa (Curate)
on Aug 20, 2007 at 18:34 UTC ( #633903=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info rvosa
Description:

DESCRIPTION

When object-oriented perl classes use inheritance, child classes will have additional methods not immediately apparent to users unfamiliar to effectively navigating perldoc and inheritance trees. For example, IO::File inherits from IO::Handle, and so an IO::File object "does" anything an IO::Handle object does.

Novice users are sometimes confused by this, and think that APIs are more limited than they really are (on a personal note: I found this to be the case when bug reports came in that some object no longer had the "set_name" method, when really I had re-factored it into a superclass).

This script remedies that by analyzing a class (provided on the command line), recursing up the class's inheritance tree, collecting the methods in the superclasses and importing the pod for the methods in those superclasses. The resulting concatenated pod is written to STDOUT. That output can then be re-directed to a file, or formatted, e.g. by doing:
podinherit -class Some::Class | pod2text | more
Module authors might use this script during the packaging of their release by doing something like:
podinherit -class Some::Class >> Some/Class.pm

IMPLEMENTATION

This script contains a subclass of Pod::Parser, which implements a stream parser for pod. The appropriate documentation for superclass methods is identified by the "command" method, which takes the following arguments:
my ( $parser, $command, $paragraph, $line_num ) = @_;
To recognize pod, the method name needs to be part of a $paragraph start token, e.g. to find pod for 'method', permutations of the following will be recognized:
=item method =head1 method() =item method( $arg ) =item $obj->method( $arg )
Or, specifically, anything that matches:
/^(?:\$\w+->)?$method(?:\(|\b)/
I.e. an optional object reference with method arrow ($self->), a method name, and an optional opening parenthesis or token delimiter \b, to be matched against the $paragraph argument to the C<command> call in subclasses of Pod::Parser.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;

my $SKIPME  = qr/./;
my $VERBOSE = 0;
my $CLASS;
my $ALL_CAPS_REGEX  = '[A-Z]+';
my $INTERNALS_REGEX = '_.+';
my $WITH_OVERRIDES;
my $ISA   = {};
my $LOCAL = {};
my $equals = '=';

GetOptions(
    'class=s'        => \$CLASS,
    'verbose'        => \$VERBOSE,
    'with-overrides' => \$WITH_OVERRIDES,
    'with-all-caps'  => sub { $ALL_CAPS_REGEX  = '' },
    'with-internals' => sub { $INTERNALS_REGEX = '' },    
    'help|?'         => sub { pod2usage(2) },
    'man'            => sub { pod2usage(0) },
);
pod2usage( "Need a class name to analyze!" ) if not $CLASS;

if ( $ALL_CAPS_REGEX || $INTERNALS_REGEX ) {
    my $regex = join '|', $ALL_CAPS_REGEX, $INTERNALS_REGEX;
    $SKIPME = qr/^(?:$regex)$/;
}

eval "require $CLASS";
if ( $@ ) {
    pod2usage( "Can't analyze $CLASS: $@" );
}

$ISA->{$CLASS} = 1;
recurse_isa( $CLASS );
delete $ISA->{$CLASS};
my @classes = ( $CLASS );
push @classes, keys %{ $ISA };

if ( scalar @classes > 1 ) {
    my $script = $0;
    my $time = localtime;
    print << "HEADER";
# AUTOGENERATED pod created by $script on $time
# DO NOT EDIT the code below, rerun $script instead.

${equals}pod

${equals}head1 INHERITED METHODS

$CLASS inherits from one or more superclasses. This means that objects
+ of class
$CLASS also "do" the methods from the superclasses in addition to the 
+ones 
implemented in this class. Below is the documentation for those additi
+onal 
methods, organized by superclass.

HEADER

    for my $c ( @classes ) {
        if ( $c ne $CLASS ) {
        print << "CLASSHEADER";
${equals}head2 SUPERCLASS $c

$CLASS inherits from superclass L<$c>. 
Below are the public methods from this superclass.

${equals}over

CLASSHEADER
}
        my @methods = sort { $a cmp $b } get_methods( $c );
        for my $method ( @methods ) {
            my $pod = get_pod( $c, $method );
            print $pod if $pod;
        }
        print "=back\n\n" if $c ne $CLASS;        
    }
    print "=cut\n\n";
}

sub recurse_isa {
    my $class = shift;
    msg( "recursing up superclass $class" );
    my @isa;
    eval "\@isa = \@${class}::ISA";
    for ( @isa ) {
        if ( not exists $ISA->{$_} ) {
            recurse_isa($_);
        }
        $ISA->{$_} = 1;
    }
}

sub get_methods {
    my $class = shift;
    msg( "getting methods for superclass $class" );
    eval "require $class";
    if ( $@ ) {
        warn "Can't load superclass $class: $@";
    }
    my %symbol_table_for_class;
    my @methods;
    eval "\%symbol_table_for_class = \%${class}::";
    for my $entry ( keys %symbol_table_for_class ) {
        my $can = $class->can( $entry );
        if ( UNIVERSAL::isa( $can, 'CODE' ) ) {
            if ( $class eq $CLASS ) {
                $LOCAL->{$entry} = 1 if not $WITH_OVERRIDES;
                msg( "found local method $entry" );
            }    
            else {
                if ( $entry !~ $SKIPME and not exists $LOCAL->{$entry}
+ ) {
                    push @methods, $entry;
                    msg( "found method $entry in ${class}'s symbol tab
+le" );
                }
                else {
                    msg( "skipping method $entry in ${class}'s symbol 
+table" );
                }
            }
        }
    }
    return @methods;
}

sub get_pod {
    my ( $class, $method ) = @_;
    msg( "getting pod for method $method in class $class" );
    my $canon_class = $class;
    $canon_class =~ s/::/\//g;
    $canon_class .= ".pm";
    my $path = $INC{$canon_class};
    msg( "going to parse pod from file $path" );
    my $parser = ItemParser->new;
    $parser->method_to_find( $method );
    $parser->parse_from_file( $path );
    my $pod = $parser->get_pod_for_method;
    return $pod;
}

sub msg {
    my ( $msg, $level ) = @_;
    print STDERR $msg, "\n" if $VERBOSE;
}

BEGIN {
    package ItemParser;
    use Pod::Parser;
    @ItemParser::ISA = qw(Pod::Parser);
    
    sub command {
        my ( $parser, $command, $paragraph, $line_num ) = @_;
        my $method = $parser->{'method'};
        if ( $paragraph =~ m/^(?:\$\w+->)?$method(?:\(|\b)/ ) {
            $parser->{'para'} = "=item " . $paragraph;
            $parser->{'concat'} = 1;
        }
        else {
            $parser->{'concat'} = 0;
        }
    }
    
    sub verbatim {
        my ( $parser, $paragraph, $line_num ) = @_;
        if ( $parser->{'concat'} ) {
            $parser->{'para'} .= $paragraph;
        }
    }
    
    sub method_to_find {
        my ( $parser, $method ) = @_;
        $parser->{'method'} = $method;
    }
    
    sub get_pod_for_method { shift->{'para'} }
    
    sub textblock {
        my ( $parser, $text, $line_num, $pod_para ) = @_;
        if ( $parser->{'concat'} ) {
            $parser->{'para'} .= $text;
        }
    }
    
    sub interior_sequence {}
}

__END__

=head1 NAME

podinherit - Imports pod from superclasses

=head1 SYNOPSIS

 podinherit [-verbose] [-help] [-man] -class <Some::Class> 
            [-with-overrides] [-with-all-caps] [-with-internals]

=head1 OPTIONS

=over 8

=item B<-verbose>

Print verbose feedback to STDERR

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-class> C<Some::Class>

Class name of child class.

=item B<-with-overrides>

Also import pod from superclasses for methods that Some::Class overrid
+es.

=item B<-with-all-caps>

Also import pod for methods with names in all capitals (typically inte
+rnal
methods such as DESTROY or TIEARRAY).

=item B<-with-internals>

Also import pod for methods with names starting with underscores (conv
+entionally
these are private/internal methods).

=back

=head1 DESCRIPTION

When object-oriented perl classes use inheritance, child classes will 
+have
additional methods not immediately apparent to users unfamiliar to eff
+ectively
navigating perldoc and inheritance trees. For example, L<IO::File> inh
+erits
from L<IO::Handle>, and so an IO::File object "does" anything an IO::H
+andle
object does. Novice users are sometimes confused by this, and think th
+at APIs
are more limited than they really are (on a personal note: I found thi
+s to be
the case when bug reports came in that some object no longer had the "
+set_name"
method, when really I had re-factored it into a superclass).

This script remedies that by analyzing
a class (provided on the command line), recursing up the class's inher
+itance
tree, collecting the methods in the superclasses and importing the pod
+ for the
methods in those superclasses. The resulting concatenated pod is writt
+en to 
STDOUT. That output can then be re-directed to a file, or formatted, e
+.g.
by doing:

 podinherit -class Some::Class | pod2text | more
 
=head1 IMPLEMENTATION

This script contains a subclass of L<Pod::Parser>, which implements a 
+stream
parser for pod. The appropriate documentation for superclass methods i
+s 
identified by the C<command> method, which takes the following argumen
+ts:

 my ( $parser, $command, $paragraph, $line_num ) = @_;

To recognize pod, the method name needs to be part of a $paragraph sta
+rt token,
e.g. to find pod for 'method', permutations of the following will be r
+ecognized:

 =item method
 =head1 method()
 =item method( $arg )
 =item $obj->method( $arg )

Or, specifically, anything that matches:
 
 /^(?:\$\w+->)?$method(?:\(|\b)/

I.e. an optional object reference with method arrow ($self->), a metho
+d name, 
and an optional opening parenthesis or token delimiter \b, to be match
+ed against
the $paragraph argument to the C<command> call in subclasses of L<Pod:
+:Parser>.

=cut

Comment on podinherit - Imports pod from superclasses
Download Code
Re: podinherit - Imports pod from superclasses
by Anonymous Monk on Aug 21, 2007 at 06:38 UTC
    You might have saved yourself a little time if you used Pod::Select
      Mmmmm... I looked into it, but had the impression it only selects =head* paragraphs, not =items.
Re: podinherit - Imports pod from superclasses
by rogueFalcon (Beadle) on Sep 07, 2007 at 20:10 UTC
    So the goal of this software is to reduce the number of newbie questions ;-)

    -- rogueFalcon
    Why do you people insist on doing things sdrawkcab?

      Exactly :)

Back to Code Catacombs

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2014-08-30 00:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (290 votes), past polls