#!/usr/bin/perl -w use strict; use Pod::Parser; package Pod::Stripper; # this one is a little more stylish (see perlstyle) 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, 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 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