File Coverage

blib/lib/Pod/Stripper.pm

Criterion	Covered	Total	%
statement	35	41	85.3
branch	8	10	80.0
condition			n/a
subroutine	10	12	83.3
pod	0	9	0.0
total	53	72	73.6

=pod

=head1 NAME

Pod::Stripper - strip all pod, and output what's left

=head1 SYNOPSIS

    $>perl Stripper.pm

or

    #!/usr/bin/perl -w

    use strict;
    use Pod::Stripper;

    my $Stripper = new Pod::Stripper();

    $Stripper->parse_from_filehandle(\*STDIN) unless (@ARGV);

    for my $ARGV (@ARGV) {
        $Stripper->parse_from_file($ARGV);
    }

=head1 DESCRIPTION

This be C, a subclass of C.  It parses perl files,
stripping out the pod, and dumping the rest (presumably code) to wherever
you point it to (like you do with C).

You could probably subclass it, but I don't see why.

=head2 MOTIVATION

I basically re-wrote C on two separate occasions, and I know
at least 2 other people who'd use it, and thought It'd make a nice addition.

Cnew()-Eparse_from_file(shift)">
C<  Stripper.pm>

=head2 EXPORTS

None.
This one be object oriented (at least I'm under the impression that it is).

=head2 SEE ALSO

C and L, esp. the C and C methods

=head1 CAVEAT

This module will correctly strip out get rid of hidden pod,
and preserve hiddencode, but like all pod parsers except C,
it will be fooled by pod in heredocs (or things like that).

see L and read F for more information.

=head1 AUTHOR

D.H. aka crazyinsomniac|at|yahoo.com.

=head1 LICENSE

Copyright (c) 2002 by D.H. aka crazyinsomniac|at|yahoo.com.
All rights reserved.

This module is free software;
you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 PROPS

props to all the perlmonks at perlmonks.org, and especiall danger
and the ones who showed interest in Pod::Stripper

http://perlmonks.org/index.pl?node=Pod::Stripper

=cut


package Pod::Stripper; # this one is a little more stylish (see perlstyle)
use strict;
use Pod::Parser;
local $^W = 1; # flip on teh warnings

use vars qw/ @ISA $VERSION/;

$VERSION = 0.22;

@ISA = qw(Pod::Parser); # Pod'Parser is also legal

sub begin_input {
    my ($Stripper) = @_;

## SUPER cause I override parseopts, so the user can't mess w/it
    $Stripper->SUPER::parseopts('-want_nonPODs'    => 1,
                                '-process_cut_cmd' => 9,

                              ,);

    $Stripper->{__2hidden_code}=0;
    return undef;
}

sub cutting {
   my ($Stripper, $cutting) = @_;

   $Stripper->{_CUTTING} = $cutting  if defined $cutting;

   return $$Stripper{_CUTTING};
}

sub begin_pod {
    my ($Stripper) = @_;

    $Stripper->cutting(1);

    return undef;
}

sub end_pod {
    my ($Stripper) = @_;

    $Stripper->cutting(0);

    return;
}

sub preprocess_paragraph
{
    my ($Stripper, $text) = @_;

    if( $Stripper->cutting() ) {
        my $out_fh = $Stripper->output_handle();
        print $out_fh $text;
        return undef;
    }
    else {
        return $text;
    }
}

sub command
{
    my ($Stripper, $command, $paragraph, $line_num, $pod_para) = @_;

    if($paragraph =~ m/^=cut/mg) {
        $Stripper->{__2hidden_code} = 1 ;
        ## it's hidden code (the unseen =cut command)
    }


    if ($command eq 'cut') {
        $Stripper->cutting(1);
        ## it's non-pod now
    }
    else {
        $Stripper->cutting(0);
        ## it's pod now
    }
}

sub verbatim { &textblock(@_); } ## cause hidden code can be either

sub textblock {
    my ($Stripper, $paragraph, $line_num, $pod_para) = @_;

## guess what we got? that's right, hidden code
    if($Stripper->{__2hidden_code}) {
        $Stripper->{__2hidden_code} = 0;
        my $out_fh = $Stripper->output_handle();
        print $out_fh $paragraph;
    }

}


sub parseopts {undef}

1;
################################################################################
################################################################################

=head1 The Following is more interesting if you read Stripper.pm raw

=cut

package main;

unless(caller()) {
    my $Stripper = new Pod::Stripper();

    seek DATA,0,0;

    $Stripper->parse_from_filehandle(\*DATA);

=head1 TEST CASE FOLLOWS - NOT POD NOR CODE

==head2 HEY THIS POD TOO (REALLy, == is valid, although some parsers might disagree)

podchecker will not complain

=head2 ABTEST
print "THIS IS HIDDEN POD";
=cut

print ">>>>>>>>>>>>>>> I AM NOT HIDDEN POD.  PERL WILL EXECUTE ME";

=head2 CUT

had to make sure

=cut

my $BUT_BEFORE_THE_MODULE_ENDS = <<'A_TEST';

=head2 I AM INSIDE A HEREDOC

WHERE ARE YOU?

=cut

=head2 I AM HIDDEN POD INSIDE A HEREDOC
warn "really, I am"
=cut

print "AND I AM HIDDEN CODE INSIDE A HEREDOC";

=head2 BOO

but hey, if the pod inside a heredoc gets eaten by a pod parser (as it shoulD)
I see no problem here

=cut

A_TEST

}

1; ### end of modules

__END__