0: #!/usr/bin/perl -w
1: ## This thing is on CPAN RIGHT NOW (well finished product)
2: 
3: use strict;
4: use Pod::Parser;
5: 
6: package Pod::Stripper; # this one is a little more stylish (see perlstyle)
7: 
8: use vars qw/ @ISA $VERSION/;
9: 
10: $VERSION = 0.2;
11: 
12: sub Version { $VERSION };
13: 
14: @ISA = qw(Pod::Parser); # Pod'Parser is also legal
15: 
16: sub begin_input {
17:     my ($Stripper) = @_;
18: 
19: ## SUPER cause I override parseopts, so the user can't mess w/it
20:     $Stripper->SUPER::parseopts('-want_nonPODs'    => 1,
21:                                 '-process_cut_cmd' => 9,
22:                               ,);
23: 
24:     return undef;
25: }
26: 
27: sub cutting {
28:    my ($Stripper, $cutting) = @_;
29: 
30:    $Stripper->{_CUTTING} = $cutting  if defined $cutting;
31: 
32:    return $$Stripper{_CUTTING};
33: }
34: 
35: sub begin_pod {
36:     my ($Stripper) = @_;
37: 
38:     $Stripper->cutting(1);
39: 
40:     return undef;
41: }
42: 
43: sub end_pod {
44:     my ($Stripper) = @_;
45: 
46:     $Stripper->cutting(0);
47: 
48:     return;
49: }
50: 
51: sub preprocess_paragraph
52: {
53:     my ($Stripper, $text) = @_;
54: 
55:     if( $Stripper->cutting() ) {
56:         my $out_fh = $Stripper->output_handle();
57:         print $out_fh $text;
58:     }
59:     else {
60:         return $text;
61:     }
62: }
63: 
64: sub command
65: {
66:     my ($Stripper, $command, $paragraph) = @_;
67: 
68:     if ($command =~ /cut/i) {
69:         $Stripper->cutting(1);
70:     }
71:     else {
72:         $Stripper->cutting(0);
73:     }
74: }
75: 
76: sub verbatim {undef}
77: sub textblock {undef}
78: sub parseopts {undef}
79: 1;
80: ################################################################################
81: ################################################################################
82: ################################################################################
83: 
84: package main;
85: 
86: unless ( caller() ) {
87:     ## if you say perl Stripper.pm
88:     ## Create a Stripper object and have it parse from \*DATA
89: 
90:     my $Stripper = new Pod::Stripper();
91: 
92:     seek DATA,0,0;
93: 
94:     $Stripper->parse_from_filehandle(\*DATA);
95: }
96: 
97: "here we go again";
98: __END__
99: 
100: =head1 NAME
101: 
102: Pod::Stripper - strip all pod, and output what's left
103: 
104: =head1 SYNOPSIS
105: 
106:     $>perl Stripper.pm
107: 
108: or
109: 
110:     #!/usr/bin/perl -w
111: 
112:     use strict;
113:     use Pod::Stripper;
114: 
115:     my $Stripper = new Pod::Stripper();
116: 
117:     $Stripper->parse_from_filehandle(\*STDIN) unless (@ARGV);
118: 
119:     for my $ARGV (@ARGV) {
120:         $Stripper->parse_from_file($ARGV);
121:     }
122: 
123: =head1 DESCRIPTION
124: 
125: This be C<Pod::Stripper>, a subclass of C<Pod::Parser>.  It parses perl files,
126: stripping out the pod, and dumping the rest (presumably code) to wherever
127: you point it to (like you do with C<Pod::Parser>).
128: 
129: You could probably subclass it, but I don't see why.
130: 
131: =head2 MOTIVATION
132: 
133: I basically re-wrote C<Pod::Stripper> on two separate occasions, and I know
134: at least 2 other people who'd use it, and thought It'd make a nice addition.
135: 
136: C<perl -MPod::Stripper -e"Pod::Stripper-E<gt>new()-E<gt>parse_from_file(shift)">
137: C<  Stripper.pm>
138: 
139: =head2 EXPORTS
140: 
141: None.
142: This one be object oriented (at least I'm under the impression that it is).
143: 
144: =head2 SEE ALSO
145: 
146: C<Pod::Parser> and L<Pod::Parser>, esp. the C<input_*> and C<output_*> methods
147: 
148: =head1 AUTHOR
149: 
150: D.H. aka crazyinsomniac|at|yahoo.com.
151: http://crazyinsomniac.perlmonk.org/perl/
152: 
153: =head1 LICENSE
154: 
155: Copyright (c) 2002 by D.H. aka crazyinsomniac|at|yahoo.com.
156: All rights reserved.
157: 
158: This module is free software;
159: you can redistribute it and/or modify it under
160: the same terms as Perl itself.
161: 
162: =head1 PROPS
163: 
164: props to all the perlmonks at perlmonks.org, and especially danger, jmcnamara, and gmax (they squash bugs)
165: 
166: =cut