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

Replies are listed 'Best First'.
Re: Pod::Stripper
by gmax (Abbot) on Feb 02, 2002 at 15:13 UTC
    Sample perl script to strip.
    #!/usr/bin/perl -w
# testpod.pl
use strict;

=head1 test
to be stripped
=cut

print "everything fine\n";

=head1 another test
to be stripped

=cut

print "end\n";

    [download]
    I made a stripper.pl script with 
    #!/usr/bin/perl -w
use strict;
use Stripper;
my $Stripper = new Pod::Stripper();
$Stripper->parse_from_filehandle(\*STDIN) unless (@ARGV);
for my $ARGV (@ARGV) {
    $Stripper->parse_from_file($ARGV);
}

    [download]
    The Stripper will output 
    #!/usr/bin/perl -w
use strict;

print "end\n";

    [download]
    (missing one line of code)
    Then I made a poor man's stripper, as follows:
    #!/usr/bin/perl -w
use strict;
my $inside_pod = 0;
while (<>){
    if ($inside_pod) { 
      $inside_pod = ! /^=cut/;
      next;
    }
    else {
      $inside_pod = /^=\w/;
    }
    print unless $inside_pod;
}

    [download]
    and the output contains the print "everything fine\n"; line.
    However, the poor man's stripper will be fooled by such a sequence:
    my $var ='
=test
';

    [download]
    I know that POD tags should be isolated (i.e separated by "\n" before and after) but what if they don't? (As I found in some modules)
    These POD tags are correctly ignored by the compiler, but make perldoc fail.
    Is there any way of dealing with such tags?
     _  _ _  _  
(_|| | |(_|><
 _|

    [download]
[reply]
[d/l]
[select]
      First off, thank you for your interest. This is a fundamental issue with perl pod.

      I will now quote from perlsyn

      PODs: Embedded Documentation

      Perl has a mechanism for intermixing documentation with source code. While it's expecting the beginning of a new statement, if the compiler encounters a line that begins with an equal sign and a word, like this

          =head1 Here There Be Pods!

      Then that text and all remaining text up through and including a line beginning with =cut will be ignored. The format of the intervening text is described in the perlpod manpage.

      This allows you to intermix your source code and your documentation text freely, as in

          =item snazzle($)
          The snazzle() function will behave in the most spectacular
    form that you can possibly imagine, not even excepting
    cybernetic pyrotechnics.
          =cut back to the compiler, nuff of this pod stuff!
          sub snazzle($) {
        my $thingie = shift;
        .........
    }

      Note that pod translators should look at only paragraphs beginning with a pod directive (it makes parsing easier), whereas the compiler actually knows to look for pod escapes even in the middle of a paragraph. This means that the following secret stuff will be ignored by both the compiler and the translators.

          $a=3;
    =secret stuff
     warn "Neither POD nor CODE!?"
    =cut back
    print "got $a\n";

      You probably shouldn't rely upon the warn() being podded out forever. Not all pod translators are well-behaved in this regard, and perhaps the compiler will become pickier.

      Now I will quote from perlpod

      Pod translators usually will require paragraphs to be separated by completely empty lines. If you have an apparently empty line with some spaces on it, this can cause odd formatting.
      Most people, and more importantly, parsers, choose to keep within the guidelines as demonstrated and explained by the pod above, and therefore so does Pod::Parser, and in turn Pod::Stripper as well.

      Is there any way of dealing with such tags?

      Why yes there is. I will probably be able to solve this issue by tinkering with Pod::Parser->preprocess_line and Pod::Parser->preprocess_paragraph and when I do, I will update Pod::Stripper to do a better job of stripping the pod, for all those dummies out there who can't follow guidelines. In the meantime, an immediate solution is to use Algorithm::Diff, and compare the output of Pod::Stripper and O->Deparse, as Deparse will strip "comments", but it is as smart as perl in figuring out what is actual code, and what is actual pod.

      Good looking out.

       
      ______crazyinsomniac_____________________________
      Of all the things I've lost, I miss my mind the most.
      perl -e "$q=$_;map({chr unpack qq;H*;,$_}split(q;;,q*H*));print;$q/$q;"

[reply]
[d/l]
[select]
[reply]
[d/l]

Back to Craft