#!/usr/bin/perl -w

use strict;
use Pod::Parser;

package Pod::Stripper; # this one is a little more stylish (see perlst
+yle)

use vars qw/ @ISA $VERSION/;

$VERSION = 0.2;

@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) = @_;

=head1 ABANDONMENT

    if( $text =~ m/^=cut/m ) {
        warn "JESUS FUCKING CHRIST";
        $text =~ s/^=cut/\n=cut/m;
        return undef;
        return $text;
    }

=cut

    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) = @_;
require Data::Dumper;
warn Data::Dumper::Dumper($pod_para);
warn "PARA FUCKING(".$paragraph;

    if($paragraph =~ m/^=cut/mg) {
        $Stripper->{__2hidden_code} = 1 ;
        warn " THE HIDDEN CUT";
    }


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

sub verbatim {
    warn "VERBATIM @_";
    &textblock(@_);
    }

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

require Data::Dumper;
warn Data::Dumper::Dumper($pod_para);
warn "PARA FUCKING(".$paragraph;

    warn "CUTTING(".$Stripper->{__2hidden_code}
            .")(".$Stripper->{_CUTTING}."___TEXTFUCKINGBLOCK: @_";
    if($Stripper->{__2hidden_code}) {
        $Stripper->{__2hidden_code} = 0;
        my $out_fh = $Stripper->output_handle();
        print $out_fh $paragraph;
    }

}
    

sub parseopts {undef}

=head1 NOT FUCKING WORKING 

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

    if( $text =~ /^=cut/m) {

#        $Stripper->cutting(1);

        warn "PREPROCESS_LINE: NO MORE POD";

        $Stripper->command('cut', $text, $line_num);
        $Stripper->cutting(1);

        return undef;
    }

    warn "PREPROCESS_LINE: TEXT";
    return $text;
}

=cut

1;
######################################################################
+##########
######################################################################
+##########
######################################################################
+##########

package main;

unless(caller()) {
    ## use Devel::TraceMethods qw(Pod::Stripper);
    ## if you say perl Stripper.pm
    ## Create a Stripper object and have it parse from \*DATA
    
    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)

=head1 ABTEST
print "I AM HIDDEN POD FUCKER!!!!!!!";
=cut

print ">>>>>>>>>>>>>>> I AM NOT POD FUCKER!!!!";

=head1 CUT

had to make sure

=cut

}

1;

__END__

=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<Pod::Stripper>, a subclass of C<Pod::Parser>.  It parses per
+l files,
stripping out the pod, and dumping the rest (presumably code) to where
+ver
you point it to (like you do with C<Pod::Parser>).

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

=head2 MOTIVATION

I basically re-wrote C<Pod::Stripper> on two separate occasions, and I
+ know
at least 2 other people who'd use it, and thought It'd make a nice add
+ition.

C<perl -MPod::Stripper -e"Pod::Stripper-E<gt>new()-E<gt>parse_from_fil
+e(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<Pod::Parser> and L<Pod::Parser>, esp. the C<input_*> and C<output_*>
+ methods

=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

=cut

=head1 WELL IF WE DIDN'T PASS _END__
"this would still be hidden pod";
=cut

print "AND THIS WOULD STILL BE HIDDEN CODE";

=head1 THIS REALLY IS AN UGLY HACK

yes, it is

=cut
[download]