summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm362
1 files changed, 362 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm
new file mode 100644
index 00000000000..c7ad3d69770
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/JustPod.pm
@@ -0,0 +1,362 @@
+use 5;
+package Pod::Simple::JustPod;
+# ABSTRACT: Pod::Simple formatter that extracts POD from a file containing
+# other things as well
+use strict;
+use warnings;
+
+use Pod::Simple::Methody ();
+our @ISA = ('Pod::Simple::Methody');
+
+sub new {
+ my $self = shift;
+ my $new = $self->SUPER::new(@_);
+
+ $new->accept_targets('*');
+ $new->keep_encoding_directive(1);
+ $new->preserve_whitespace(1);
+ $new->complain_stderr(1);
+ $new->_output_is_for_JustPod(1);
+
+ return $new;
+}
+
+#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+sub check_that_all_is_closed {
+
+ # Actually checks that the things we depend on being balanced in fact are,
+ # so that we can continue in spit of pod errors
+
+ my $self = shift;
+ while ($self->{inL}) {
+ $self->end_L(@_);
+ }
+ while ($self->{fcode_end} && @{$self->{fcode_end}}) {
+ $self->_end_fcode(@_);
+ }
+}
+
+sub handle_text {
+
+ # Add text to the output buffer. This is skipped if within a L<>, as we use
+ # the 'raw' attribute of that tag instead.
+
+ $_[0]{buffer} .= $_[1] unless $_[0]{inL} ;
+}
+
+sub spacer {
+
+ # Prints the white space following things like =head1. This is normally a
+ # blank, unless BlackBox has told us otherwise.
+
+ my ($self, $arg) = @_;
+ return unless $arg;
+
+ my $spacer = ($arg->{'~orig_spacer'})
+ ? $arg->{'~orig_spacer'}
+ : " ";
+ $self->handle_text($spacer);
+}
+
+sub _generic_start {
+
+ # Called from tags like =head1, etc.
+
+ my ($self, $text, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text($text);
+ $self->spacer($arg);
+}
+
+sub start_Document { shift->_generic_start("=pod\n\n"); }
+sub start_head1 { shift->_generic_start('=head1', @_); }
+sub start_head2 { shift->_generic_start('=head2', @_); }
+sub start_head3 { shift->_generic_start('=head3', @_); }
+sub start_head4 { shift->_generic_start('=head4', @_); }
+sub start_encoding { shift->_generic_start('=encoding', @_); }
+# sub start_Para
+# sub start_Verbatim
+
+sub start_item_bullet { # Handle =item *
+ my ($self, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text('=item');
+
+ # It can be that they said simply '=item', and it is inferred that it is to
+ # be a bullet.
+ if (! $arg->{'~orig_content'}) {
+ $self->handle_text("\n\n");
+ }
+ else {
+ $self->spacer($arg);
+ if ($arg->{'~_freaky_para_hack'}) {
+
+ # See Message Id <87y3gtcwa2.fsf@hope.eyrie.org>
+ my $item_text = $arg->{'~orig_content'};
+ my $trailing = quotemeta $arg->{'~_freaky_para_hack'};
+ $item_text =~ s/$trailing$//;
+ $self->handle_text($item_text);
+ }
+ else {
+ $self->handle_text("*\n\n");
+ }
+ }
+}
+
+sub start_item_number { # Handle '=item 2'
+ my ($self, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text("=item");
+ $self->spacer($arg);
+ $self->handle_text("$arg->{'~orig_content'}\n\n");
+}
+
+sub start_item_text { # Handle '=item foo bar baz'
+ my ($self, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text('=item');
+ $self->spacer($arg);
+}
+
+sub _end_item {
+ my $self = shift;
+ $self->check_that_all_is_closed();
+ $self->emit;
+}
+
+*end_item_bullet = *_end_item;
+*end_item_number = *_end_item;
+*end_item_text = *_end_item;
+
+sub _start_over { # Handle =over
+ my ($self, $arg) = @_;
+ $self->check_that_all_is_closed();
+ $self->handle_text("=over");
+
+ # The =over amount is optional
+ if ($arg->{'~orig_content'}) {
+ $self->spacer($arg);
+ $self->handle_text("$arg->{'~orig_content'}");
+ }
+ $self->handle_text("\n\n");
+}
+
+*start_over_bullet = *_start_over;
+*start_over_number = *_start_over;
+*start_over_text = *_start_over;
+*start_over_block = *_start_over;
+
+sub _end_over {
+ my $self = shift;
+ $self->check_that_all_is_closed();
+ $self->handle_text('=back');
+ $self->emit;
+}
+
+*end_over_bullet = *_end_over;
+*end_over_number = *_end_over;
+*end_over_text = *_end_over;
+*end_over_block = *_end_over;
+
+sub end_Document {
+ my $self = shift;
+ $self->emit; # Make sure buffer gets flushed
+ print {$self->{'output_fh'} } "=cut\n"
+}
+
+sub _end_generic {
+ my $self = shift;
+ $self->check_that_all_is_closed();
+ $self->emit;
+}
+
+*end_head1 = *_end_generic;
+*end_head2 = *_end_generic;
+*end_head3 = *_end_generic;
+*end_head4 = *_end_generic;
+*end_encoding = *_end_generic;
+*end_Para = *_end_generic;
+*end_Verbatim = *_end_generic;
+
+sub _start_fcode {
+ my ($type, $self, $flags) = @_;
+
+ # How many brackets is set by BlackBox unless the count is 1
+ my $bracket_count = (exists $flags->{'~bracket_count'})
+ ? $flags->{'~bracket_count'}
+ : 1;
+ $self->handle_text($type . ( "<" x $bracket_count));
+
+ my $rspacer = "";
+ if ($bracket_count > 1) {
+ my $lspacer = (exists $flags->{'~lspacer'})
+ ? $flags->{'~lspacer'}
+ : " ";
+ $self->handle_text($lspacer);
+
+ $rspacer = (exists $flags->{'~rspacer'})
+ ? $flags->{'~rspacer'}
+ : " ";
+ }
+
+ # BlackBox doesn't output things for for the ending code callbacks, so save
+ # what we need.
+ push @{$self->{'fcode_end'}}, [ $bracket_count, $rspacer ];
+}
+
+sub start_B { _start_fcode('B', @_); }
+sub start_C { _start_fcode('C', @_); }
+sub start_E { _start_fcode('E', @_); }
+sub start_F { _start_fcode('F', @_); }
+sub start_I { _start_fcode('I', @_); }
+sub start_S { _start_fcode('S', @_); }
+sub start_X { _start_fcode('X', @_); }
+sub start_Z { _start_fcode('Z', @_); }
+
+sub _end_fcode {
+ my $self = shift;
+ my $fcode_end = pop @{$self->{'fcode_end'}};
+ my $bracket_count = 1;
+ my $rspacer = "";
+
+ if (! defined $fcode_end) { # If BlackBox is working, this shouldn't
+ # happen, but verify
+ $self->whine($self->{line_count}, "Extra '>'");
+ }
+ else {
+ $bracket_count = $fcode_end->[0];
+ $rspacer = $fcode_end->[1];
+ }
+
+ $self->handle_text($rspacer) if $bracket_count > 1;
+ $self->handle_text(">" x $bracket_count);
+}
+
+*end_B = *_end_fcode;
+*end_C = *_end_fcode;
+*end_E = *_end_fcode;
+*end_F = *_end_fcode;
+*end_I = *_end_fcode;
+*end_S = *_end_fcode;
+*end_X = *_end_fcode;
+*end_Z = *_end_fcode;
+
+sub start_L {
+ _start_fcode('L', @_);
+ $_[0]->handle_text($_[1]->{raw});
+ $_[0]->{inL}++
+}
+
+sub end_L {
+ my $self = shift;
+ $self->{inL}--;
+ if ($self->{inL} < 0) { # If BlackBox is working, this shouldn't
+ # happen, but verify
+ $self->whine($self->{line_count}, "Extra '>' ending L<>");
+ $self->{inL} = 0;
+ }
+
+ $self->_end_fcode(@_);
+}
+
+sub emit {
+ my $self = shift;
+
+ if ($self->{buffer} ne "") {
+ print { $self->{'output_fh'} } "",$self->{buffer} ,"\n\n";
+
+ $self->{buffer} = "";
+ }
+
+ return;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Pod::Simple::JustPod -- just the Pod, the whole Pod, and nothing but the Pod
+
+=head1 SYNOPSIS
+
+ my $infile = "mixed_code_and_pod.pm";
+ my $outfile = "just_the_pod.pod";
+ open my $fh, ">$outfile" or die "Can't write to $outfile: $!";
+
+ my $parser = Pod::Simple::JustPod->new();
+ $parser->output_fh($fh);
+ $parser->parse_file($infile);
+ close $fh or die "Can't close $outfile: $!";
+
+=head1 DESCRIPTION
+
+This class returns a copy of its input, translated into Perl's internal
+encoding (UTF-8), and with all the non-Pod lines removed.
+
+This is a subclass of L<Pod::Simple::Methody> and inherits all its methods.
+And since, that in turn is a subclass of L<Pod::Simple>, you can use any of
+its methods. This means you can output to a string instead of a file, or
+you can parse from an array.
+
+This class strives to return the Pod lines of the input completely unchanged,
+except for any necessary translation into Perl's internal encoding, and it makes
+no effort to return trailing spaces on lines; these likely will be stripped.
+If the input pod is well-formed with no warnings nor errors generated, the
+extracted pod should generate the same documentation when formatted by a Pod
+formatter as the original file does.
+
+By default, warnings are output to STDERR
+
+=head1 SEE ALSO
+
+L<Pod::Simple>, L<Pod::Simple::Methody>
+
+=head1 SUPPORT
+
+Questions or discussion about POD and Pod::Simple should be sent to the
+L<mailto:pod-people@perl.org> mail list. Send an empty email to
+L<mailto:pod-people-subscribe@perl.org> to subscribe.
+
+This module is managed in an open GitHub repository,
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+to clone L<git://github.com/theory/pod-simple.git> and send patches!
+
+Patches against Pod::Simple are welcome. Please send bug reports to
+L<mailto:<bug-pod-simple@rt.cpan.org>.
+
+=head1 COPYRIGHT AND DISCLAIMERS
+
+Copyright (c) 2002 Sean M. Burke.
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+This program is distributed in the hope that it will be useful, but
+without any warranty; without even the implied warranty of
+merchantability or fitness for a particular purpose.
+
+=head1 AUTHOR
+
+Pod::Simple was created by Sean M. Burke <sburke@cpan.org>.
+But don't bother him, he's retired.
+
+Pod::Simple is maintained by:
+
+=over
+
+=item * Allison Randal C<allison@perl.org>
+
+=item * Hans Dieter Pearcey C<hdp@cpan.org>
+
+=item * David E. Wheeler C<dwheeler@cpan.org>
+
+=back
+
+Pod::Simple::JustPod was developed by John SJ Anderson
+C<genehack@genehack.org>, with contributions from Karl Williamson
+C<khw@cpan.org>.
+
+=cut