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


line stmt bran cond sub pod time code
1            
2             =pod
3            
4             =head1 NAME
5            
6             Pod::Stripper - strip all pod, and output what's left
7            
8             =head1 SYNOPSIS
9            
10             $>perl Stripper.pm
11            
12             or
13            
14             #!/usr/bin/perl -w
15            
16             use strict;
17             use Pod::Stripper;
18            
19             my $Stripper = new Pod::Stripper();
20            
21             $Stripper->parse_from_filehandle(\*STDIN) unless (@ARGV);
22            
23             for my $ARGV (@ARGV) {
24             $Stripper->parse_from_file($ARGV);
25             }
26            
27             =head1 DESCRIPTION
28            
29             This be C, a subclass of C. It parses perl files,
30             stripping out the pod, and dumping the rest (presumably code) to wherever
31             you point it to (like you do with C).
32            
33             You could probably subclass it, but I don't see why.
34            
35             =head2 MOTIVATION
36            
37             I basically re-wrote C on two separate occasions, and I know
38             at least 2 other people who'd use it, and thought It'd make a nice addition.
39            
40             Cnew()-Eparse_from_file(shift)">
41             C< Stripper.pm>
42            
43             =head2 EXPORTS
44            
45             None.
46             This one be object oriented (at least I'm under the impression that it is).
47            
48             =head2 SEE ALSO
49            
50             C and L, esp. the C and C methods
51            
52             =head1 CAVEAT
53            
54             This module will correctly strip out get rid of hidden pod,
55             and preserve hiddencode, but like all pod parsers except C,
56             it will be fooled by pod in heredocs (or things like that).
57            
58             see L and read F for more information.
59            
60             =head1 AUTHOR
61            
62             D.H. aka crazyinsomniac|at|yahoo.com.
63            
64             =head1 LICENSE
65            
66             Copyright (c) 2002 by D.H. aka crazyinsomniac|at|yahoo.com.
67             All rights reserved.
68            
69             This module is free software;
70             you can redistribute it and/or modify it under
71             the same terms as Perl itself.
72            
73             =head1 PROPS
74            
75             props to all the perlmonks at perlmonks.org, and especiall danger
76             and the ones who showed interest in Pod::Stripper
77            
78             http://perlmonks.org/index.pl?node=Pod::Stripper
79            
80             =cut
81            
82            
83             package Pod::Stripper; # this one is a little more stylish (see perlstyle)
84 1     1   567228 use strict;
  1         2  
  1         53  
85 1     1   6 use Pod::Parser;
  1         3  
  1         90  
86             local $^W = 1; # flip on teh warnings
87            
88 1     1   7 use vars qw/ @ISA $VERSION/;
  1         8  
  1         1514  
89            
90             $VERSION = 0.22;
91            
92             @ISA = qw(Pod::Parser); # Pod'Parser is also legal
93            
94             sub begin_input {
95 2     2 0 5 my ($Stripper) = @_;
96            
97             ## SUPER cause I override parseopts, so the user can't mess w/it
98 2         32 $Stripper->SUPER::parseopts('-want_nonPODs' => 1,
99             '-process_cut_cmd' => 9,
100            
101             ,);
102            
103 2         5 $Stripper->{__2hidden_code}=0;
104 2         119 return undef;
105             }
106            
107             sub cutting {
108 32     32 0 39 my ($Stripper, $cutting) = @_;
109            
110 32 100       74 $Stripper->{_CUTTING} = $cutting if defined $cutting;
111            
112 32         198 return $$Stripper{_CUTTING};
113             }
114            
115             sub begin_pod {
116 2     2 0 1148 my ($Stripper) = @_;
117            
118 2         6 $Stripper->cutting(1);
119            
120 2         7 return undef;
121             }
122            
123             sub end_pod {
124 2     2 0 3 my ($Stripper) = @_;
125            
126 2         23 $Stripper->cutting(0);
127            
128 2         141 return;
129             }
130            
131             sub preprocess_paragraph
132             {
133 24     24 0 41 my ($Stripper, $text) = @_;
134            
135 24 100       45 if( $Stripper->cutting() ) {
136 18         54 my $out_fh = $Stripper->output_handle();
137 18         47 print $out_fh $text;
138 18         646 return undef;
139             }
140             else {
141 6         220 return $text;
142             }
143             }
144            
145             sub command
146             {
147 4     4 0 10 my ($Stripper, $command, $paragraph, $line_num, $pod_para) = @_;
148            
149 4 50       16 if($paragraph =~ m/^=cut/mg) {
150 0         0 $Stripper->{__2hidden_code} = 1 ;
151             ## it's hidden code (the unseen =cut command)
152             }
153            
154            
155 4 100       10 if ($command eq 'cut') {
156 2         6 $Stripper->cutting(1);
157             ## it's non-pod now
158             }
159             else {
160 2         6 $Stripper->cutting(0);
161             ## it's pod now
162             }
163             }
164            
165 0     0 0 0 sub verbatim { &textblock(@_); } ## cause hidden code can be either
166            
167             sub textblock {
168 2     2 0 6 my ($Stripper, $paragraph, $line_num, $pod_para) = @_;
169            
170             ## guess what we got? that's right, hidden code
171 2 50       58 if($Stripper->{__2hidden_code}) {
172 0           $Stripper->{__2hidden_code} = 0;
173 0           my $out_fh = $Stripper->output_handle();
174 0           print $out_fh $paragraph;
175             }
176            
177             }
178            
179            
180 0     0 0   sub parseopts {undef}
181            
182             1;
183             ################################################################################
184             ################################################################################
185            
186             =head1 The Following is more interesting if you read Stripper.pm raw
187            
188             =cut
189            
190             package main;
191            
192             unless(caller()) {
193             my $Stripper = new Pod::Stripper();
194            
195             seek DATA,0,0;
196            
197             $Stripper->parse_from_filehandle(\*DATA);
198            
199             =head1 TEST CASE FOLLOWS - NOT POD NOR CODE
200            
201             ==head2 HEY THIS POD TOO (REALLy, == is valid, although some parsers might disagree)
202            
203             podchecker will not complain
204            
205             =head2 ABTEST
206             print "THIS IS HIDDEN POD";
207             =cut
208            
209             print ">>>>>>>>>>>>>>> I AM NOT HIDDEN POD. PERL WILL EXECUTE ME";
210            
211             =head2 CUT
212            
213             had to make sure
214            
215             =cut
216            
217             my $BUT_BEFORE_THE_MODULE_ENDS = <<'A_TEST';
218            
219             =head2 I AM INSIDE A HEREDOC
220            
221             WHERE ARE YOU?
222            
223             =cut
224            
225             =head2 I AM HIDDEN POD INSIDE A HEREDOC
226             warn "really, I am"
227             =cut
228            
229             print "AND I AM HIDDEN CODE INSIDE A HEREDOC";
230            
231             =head2 BOO
232            
233             but hey, if the pod inside a heredoc gets eaten by a pod parser (as it shoulD)
234             I see no problem here
235            
236             =cut
237            
238             A_TEST
239            
240             }
241            
242             1; ### end of modules
243            
244             __END__