Question regardin Pod::Simple usage

[atcroft]

Fellow monks, I humbly return, still seeking enlightenment on handling POD content in the proper manner. As before, I have a variable that contains mixed code/pod content, and this time I have tried to use Pod::Simple. And, as before, I wish to extract the pod content into another variable. The documentation for the module suggested this was feasable, but I am still having no luck with doing so. For testing purposes below, I have had the code search for the copy of Find.pm on the machine, and read it for the input string.

I apologize if I keep asking on this, but it is bothersome that I cannot determine why this is occurring (or not occurring, depending on your point of view). My many thanks to any who can help shed some light on the issue in question, and to those who I have talked to in the CB regarding it previously.

Output:

$ perl test.6.pl
Testing using /usr/lib/perl5/5.8.3/File/Find.pm
Attempt 1:
Content-seen:
1
Original content length: 35380
Content (length=0):

Attempt 2:
Content-seen:
1
Original content length: 35380
Content (length=0):

Source:

#!/usr/bin/perl

use strict;
use vars qw(@files);
use warnings;
use Data::Dumper;
use File::Find;
use File::Glob qw(:glob);
use Pod::Simple;
no warnings
  'File::Find';    # per suggestion of the docs for File::Find

$| = 1;

my (@searchpath);
foreach my $i ( 0 .. $#INC ) {
    push( @searchpath,
        File::Glob::bsd_glob( $INC[$i], GLOB_TILDE | GLOB_ERR )
    );
}
find( { wanted => \&wanted, no_chdir => 1 }, @searchpath );

sub wanted {
    if ( $File::Find::name =~ m/Find\.pm$/ ) {
        push( @files, $File::Find::name );
    }
}

print "Testing using ", $files[0], "\n";

print "Attempt 1:\n";
{
    my (@content);
    open( DF, $files[0] )
      or die("Can't open $files[0] for input: $!\n");
    {
        @content = <DF>;
    }
    close(DF);

    my $podcontent = '';
    my $parser     = Pod::Simple->new();
    $parser->output_string( \$podcontent );
    $parser->parse_lines(@content);
    $parser->parse_lines(undef);

    print "Content-seen:\n", $parser->content_seen, "\n";
    print "Original content length: ",
      length( join( '', @content ) ), "\n";
    print "Content (length=", length($podcontent), "):\n",
      $podcontent, "\n";

    # print Data::Dumper->Dump( [ \$parser, \@content, \$podcontent ],
    #   [qw(*parser *content *podcontent)] ), "\n";
}
print "Attempt 2:\n";
{
    my ($content);
    open( DF, $files[0] )
      or die("Can't open $files[0] for input: $!\n");
    {
        local ( $/ = undef );
        $content = <DF>;
    }
    close(DF);

    my $podcontent = '';
    my $parser     = Pod::Simple->new();
    $parser->output_string( \$podcontent );
    $parser->parse_string_document($content);
    $parser->parse_lines(undef);

    print "Content-seen:\n", $parser->content_seen, "\n";
    print "Original content length: ", length($content), "\n";
    print "Content (length=", length($podcontent), "):\n",
      $podcontent, "\n";

    # print Data::Dumper->Dump( [ \$parser, \$content, \$podcontent ],
    #   [qw(*parser *content *podcontent)] ), "\n";
}

Results of 'perl -v': "This is perl, v5.8.3 built for i386-linux-thread-multi"

System is running on Mandrake Linux 10.0

(And yes, this question is in follow-up to that I posted in How best to extract POD from content in one variable, placing it in another variable .)

[chromatic]

I haven't dug into this very deeply, but don't you have to subclass Pod::Simple to handle the start, text, and end events for all of the POD directives you want to handle?

[jmcnamara]

Here is an example that uses Pod::Select. It doesn't preserve the =cut directives but that probably isn't a big concern.

Since you wanted to have the output in a string this example uses perl 5.8's really useful feature of opening a scalar as a filehandle. For older perls you could use IO::Scalar instead.

#!/usr/bin/perl -w

use strict;
use Pod::Select;

# perl 5.8 feature, open a scalar as a filehandle
open my $fh_out, '>', \my $pod or die "Couldn't open filehandle: $!";

my $fh_in = \*DATA;

my $parser = Pod::Select->new();
   $parser->parse_from_filehandle($fh_in, $fh_out);


print $pod;


__DATA__

# Some code
my $foo = 'bar';

=head1 This is a B<heading>

This is a paragraph.

    This is a verbatim section.

This is I<B<another>> paragraph

=cut

--
John.

[jmcnamara]

Finally, here is the poor man's approach in the spirit of TIMTOWTDI:

#!/usr/bin/perl -w

# perl 5.8 feature, open a scalar as a filehandle
open my $fh, '>', \my $pod or die "Couldn't open filehandle: $!";


while (<DATA>) {
    print $fh $_ if /^=/ .. /^=cut/
}

print $pod;



__DATA__

# Some code
my $foo = 'bar';

=head1 This is a B<heading>

This is a paragraph.

    This is a verbatim section.

This is I<B<another>> paragraph

=cut

--
John.

[jmcnamara]

When I read your previous node I started working on a Pod::Simple example since that is currently my Pod weapon of choice. However, I couldn't find an easy way to make it do what you wanted. So instead I turned it around and marked all of the code lines and then removed them from the content.

I think that the Pod::Select example above is more elegant, for this case, but here is the Pod::Simple example for the record:

#!/usr/bin/perl -w

package MyParser;

use Pod::Simple;
@ISA = qw(Pod::Simple);
use strict;

sub new {
    my $self = shift->SUPER::new(@_);

    $self->{_lines}      = [];

    # Add a callback for code lines
    $self->code_handler (
        sub {
            my $line_num = $_[1];
            my $parser   = $_[2];

            # Replace code lines with undef.
            $parser->{_lines}->[$line_num -1] = undef;
            return;
        }
     );

    return $self;
}


#
# Override parse_lines to store a copy of the input.
#
sub parse_lines {
    my $self = shift;

    push @{$self->{_lines}}, @_;

    $self->SUPER::parse_lines(@_);
}


#
# Filter out the undef lines that replace the code lines.
#
sub pod_only {
    my $self = shift;

    my @pod  = grep {defined} @{$self->{_lines}};

    print {$self->{'output_fh'}} @pod;
    return @pod;
}


1;


#
# Back to our scheduled program.
#
package main;

use strict;

my $pod;

my $parser =MyParser->new();
   $parser->parse_file(*DATA);
   $parser->output_string(\$pod);
   $parser->pod_only();

print $pod;


__DATA__

# Some code
my $foo = 'bar';

=head1 This is a B<heading>

This is a paragraph.

    This is a verbatim section.

This is I<B<another>> paragraph

=cut

--
John.