diff --git a/docs/dev/how-to-fatpack-pod2rst b/docs/dev/how-to-fatpack-pod2rst new file mode 100644 index 00000000..3d06feab --- /dev/null +++ b/docs/dev/how-to-fatpack-pod2rst @@ -0,0 +1,21 @@ +$ cpanm App::FatPacker +$ mkdir /tmp/pod2rst +$ cp util/pod2rst-fixed /tmp/pod2rst/ +$ cd /tmp/pod2rst +$ mkdir lib +$ fatpack trace pod2rst-fixed +$ fatpack packlists-for `cat fatpacker.trace` >packlists +$ fatpack tree `cat packlists` +$ (fatpack file; cat pod2rst-fixed) > pod2rst-fixed.packed +$ cp pod2rst-fixed.packed ~/percona-toolkit/util/ +$ cd ~/ +$ rm -rf /tmp/pod2rst + + +Notes: +1. Don't do this from the root of the bzr repo. fatpack tries to be clever + and inlines everything under lib/ +2. mkdir lib/ is to get around a bug(?) in fatpack +3. these two lines are safe to ignore: +File /tmp/pod2rst/fatlib/darwin-thread-multi-2level/auto/HTML/Parser/Parser.bs isn't a .pm file - can't pack this and if you hoped we were going to things may not be what you expected later +File /tmp/pod2rst/fatlib/darwin-thread-multi-2level/auto/HTML/Parser/Parser.bundle isn't a .pm file - can't pack this and if you hoped we were going to things may not be what you expected later diff --git a/util/pod2rst-fixed.packed b/util/pod2rst-fixed.packed new file mode 100644 index 00000000..0d5e9032 --- /dev/null +++ b/util/pod2rst-fixed.packed @@ -0,0 +1,5769 @@ +# This chunk of stuff was generated by App::FatPacker. To find the original +# file's code, look for the end of this BEGIN block or the string 'FATPACK' +BEGIN { +my %fatpacked; + +$fatpacked{"Pod/POM.pm"} = <<'POD_POM'; + #============================================================= -*-Perl-*- + # + # Pod::POM + # + # DESCRIPTION + # Parses POD from a file or text string and builds a tree structure, + # hereafter known as the POD Object Model (POM). + # + # AUTHOR + # Andy Wardley + # + # Andrew Ford (co-maintainer as of 03/2009) + # + # COPYRIGHT + # Copyright (C) 2000-2009 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: POM.pm 88 2010-04-02 13:37:41Z ford $ + # + #======================================================================== + + package Pod::POM; + + require 5.004; + + use strict; + use Pod::POM::Constants qw( :all ); + use Pod::POM::Nodes; + use Pod::POM::View::Pod; + + use vars qw( $VERSION $DEBUG $ERROR $ROOT $TEXTSEQ $DEFAULT_VIEW ); + use base qw( Exporter ); + + $VERSION = '0.27'; + $DEBUG = 0 unless defined $DEBUG; + $ROOT = 'Pod::POM::Node::Pod'; # root node class + $TEXTSEQ = 'Pod::POM::Node::Sequence'; # text sequence class + $DEFAULT_VIEW = 'Pod::POM::View::Pod'; # default view class + + + #------------------------------------------------------------------------ + # allow 'meta' to be specified as a load option to activate =meta tags + #------------------------------------------------------------------------ + + use vars qw( @EXPORT_FAIL @EXPORT_OK $ALLOW_META ); + @EXPORT_OK = qw( meta ); + @EXPORT_FAIL = qw( meta ); + $ALLOW_META = 0; + + sub export_fail { + my $class = shift; + my $meta = shift; + return ($meta, @_) unless $meta eq 'meta'; + $ALLOW_META++; + return @_; + } + + + + #------------------------------------------------------------------------ + # new(\%options) + #------------------------------------------------------------------------ + + sub new { + my $class = shift; + my $config = ref $_[0] eq 'HASH' ? shift : { @_ }; + + bless { + CODE => $config->{ code } || 0, + WARN => $config->{ warn } || 0, + META => $config->{ meta } || $ALLOW_META, + WARNINGS => [ ], + FILENAME => '', + ERROR => '', + }, $class; + } + + + #------------------------------------------------------------------------ + # parse($text_or_file) + # + # General purpose parse method which attempts to Do The Right Thing in + # calling parse_file() or parse_text() according to the argument + # passed. A hash reference can be specified that contains a 'text' + # or 'file' key and corresponding value. Otherwise, the argument can + # be a reference to an input handle which is passed off to parse_file(). + # If the argument is a text string that contains '=' at the start of + # any line then it is treated as Pod text and passed to parse_text(), + # otherwise it is assumed to be a filename and passed to parse_file(). + #------------------------------------------------------------------------ + + sub parse { + my ($self, $input) = @_; + my $result; + + if (ref $input eq 'HASH') { + if ($input = $input->{ text }) { + $result = $self->parse_text($input, $input->{ name }); + } + elsif ($input = $input->{ file }) { + $result = $self->parse_file($input); + } + else { + $result = $self->error("no 'text' or 'file' specified"); + } + } + elsif (ref $input || $input !~ /^=/m) { # doesn't look like POD text + $result = $self->parse_file($input); + } + else { # looks like POD text + $result = $self->parse_text($input); + } + + return $result; + } + + + #------------------------------------------------------------------------ + # parse_file($filename_or_handle) + # + # Reads the content of a Pod file specified by name or file handle, and + # passes it to parse_text() for parsing. + #------------------------------------------------------------------------ + + sub parse_file { + my ($self, $file) = @_; + my ($text, $name); + + if (ref $file) { # assume open filehandle + local $/ = undef; + $name = ''; + $text = <$file>; + } + else { # a file which must be opened + local *FP; + local $/ = undef; + $name = ( $file eq '-' ? '' : $file ); + open(FP, $file) || return $self->error("$file: $!"); + $text = ; + close(FP); + } + + $self->parse_text($text, $name); + } + + + #------------------------------------------------------------------------ + # parse_text($text, $name) + # + # Main parser method. Scans the input text for Pod sections and splits + # them into paragraphs. Builds a tree of Pod::POM::Node::* objects + # to represent the Pod document in object model form. + #------------------------------------------------------------------------ + + sub parse_text { + my ($self, $text, $name) = @_; + my ($para, $paralen, $gap, $type, $line, $inpod, $code, $result, $verbatim); + my $warn = $self->{ WARNINGS } = [ ]; + + my @stack = ( ); + my $item = $ROOT->new($self); + return $self->error($ROOT->error()) + unless defined $item; + push(@stack, $item); + + $name = '' unless defined $name; + $self->{ FILENAME } = $name; + + $code = $self->{ CODE }; + $line = \$self->{ LINE }; + $$line = 1; + $inpod = 0; + + my @encchunks = split /^(=encoding.*)/m, $text; + $text = shift @encchunks; + while (@encchunks) { + my($encline,$chunk) = splice @encchunks, 0, 2; + require Encode; + my($encoding) = $encline =~ /^=encoding\s+(\S+)/; + Encode::from_to($chunk, $encoding, "utf8"); + Encode::_utf8_on($chunk); + # $text .= "xxx$encline"; + $text .= $chunk; + } + + # patch from JJ + # while ($text =~ /(?:(.*?)(\n{2,}))|(.+$)/sg) { + while ($text =~ /(?:(.*?)((?:\s*\n){2,}))|(.+$)/sg) { + ($para, $gap) = defined $1 ? ($1, $2) : ($3, ''); + + if ($para =~ s/^==?(\w+)\s*//) { + $type = $1; + # switch on for =pod or any other =cmd, switch off for =cut + if ($type eq 'pod') { $inpod = 1; next } + elsif ($type eq 'cut') { $inpod = 0; next } + else { $inpod = 1 }; + + if ($type eq 'meta') { + $self->{ META } + ? $stack[0]->metadata(split(/\s+/, $para, 2)) + : $self->warning("metadata not allowed", $name, $$line); + next; + } + } + elsif (! $inpod) { + next unless $code; + $type = 'code'; + $para .= $gap; + $gap = ''; + } + elsif ($para =~ /^\s+/) { + $verbatim .= $para; + $verbatim .= $gap; + next; + } + else { + $type = 'text'; + chomp($para); # catches last line in file + } + + if ($verbatim) { + while(@stack) { + $verbatim =~ s/\s+$//s; + $result = $stack[-1]->add($self, 'verbatim', $verbatim); + + if (! defined $result) { + $self->warning($stack[-1]->error(), $name, $$line); + undef $verbatim; + last; + } + elsif (ref $result) { + push(@stack, $result); + undef $verbatim; + last; + } + elsif ($result == REDUCE) { + pop @stack; + undef $verbatim; + last; + } + elsif ($result == REJECT) { + $self->warning($stack[-1]->error(), $name, $$line); + pop @stack; + } + elsif (@stack == 1) { + $self->warning("unexpected $type", $name, $$line); + undef $verbatim; + last; + } + else { + pop @stack; + } + } + } + + while(@stack) { + $result = $stack[-1]->add($self, $type, $para); + + if (! defined $result) { + $self->warning($stack[-1]->error(), $name, $$line); + last; + } + elsif (ref $result) { + push(@stack, $result); + last; + } + elsif ($result == REDUCE) { + pop @stack; + last; + } + elsif ($result == REJECT) { + $self->warning($stack[-1]->error(), $name, $$line); + pop @stack; + } + elsif (@stack == 1) { + $self->warning("unexpected $type", $name, $$line); + last; + } + else { + pop @stack; + } + } + } + continue { + $$line += ($para =~ tr/\n//); + $$line += ($gap =~ tr/\n//); + } + + if ($verbatim) { + while(@stack) { + $verbatim =~ s/\s+$//s; + $result = $stack[-1]->add($self, 'verbatim', $verbatim); + + if (! defined $result) { + $self->warning($stack[-1]->error(), $name, $$line); + undef $verbatim; + last; + } + elsif (ref $result) { + push(@stack, $result); + undef $verbatim; + last; + } + elsif ($result == REDUCE) { + pop @stack; + undef $verbatim; + last; + } + elsif ($result == REJECT) { + $self->warning($stack[-1]->error(), $name, $$line); + pop @stack; + } + elsif (@stack == 1) { + $self->warning("unexpected $type", $name, $$line); + undef $verbatim; + last; + } + else { + pop @stack; + } + } + } + + return $stack[0]; + } + + + #------------------------------------------------------------------------ + # parse_sequence($text) + # + # Parse a text paragraph to identify internal sequences (e.g. B) + # which may be nested within each other. Returns a simple scalar (no + # embedded sequences) or a reference to a Pod::POM::Text object. + #------------------------------------------------------------------------ + + sub parse_sequence { + my ($self, $text) = @_; + my ($cmd, $lparen, $rparen, $plain); + my ($name, $line, $warn) = @$self{ qw( FILENAME LINE WARNINGS ) }; + my @stack; + + push(@stack, [ '', '', 'EOF', $name, $line, [ ] ] ); + + while ($text =~ / + (?: ([A-Z]) (< (?:<+\s)?) ) # open + | ( (?:\s>+)? > ) # or close + | (?: (.+?) # or text... + (?= # ...up to + (?: [A-Z]< ) # open + | (?: (?: \s>+)? > ) # or close + | $ # or EOF + ) + ) + /gxs) { + if (defined $1) { + ($cmd, $lparen) = ($1, $2); + $lparen =~ s/\s$//; + ($rparen = $lparen) =~ tr//; + push(@stack, [ $cmd, $lparen, $rparen, $name, $line, [ ] ]); + } + elsif (defined $3) { + $rparen = $3; + $rparen =~ s/^\s+//; + if ($rparen eq $stack[-1]->[RPAREN]) { + $cmd = $TEXTSEQ->new(pop(@stack)) + || return $self->error($TEXTSEQ->error()); + push(@{ $stack[-1]->[CONTENT] }, $cmd); + } + else { + $self->warning((scalar @stack > 1 + ? "expected '$stack[-1]->[RPAREN]' not '$rparen'" + : "spurious '$rparen'"), $name, $line); + push(@{ $stack[-1]->[CONTENT] }, $rparen); + } + } + elsif (defined $4) { + $plain = $4; + push(@{ $stack[-1]->[CONTENT] }, $plain); + $line += ($plain =~ tr/\n//); + } + else { + $self->warning("unexpected end of input", $name, $line); + last; + } + } + + while (@stack > 1) { + $cmd = pop @stack; + $self->warning("unterminated '$cmd->[CMD]$cmd->[LPAREN]' starting", + $name, $cmd->[LINE]); + $cmd = $TEXTSEQ->new($cmd) + || $self->error($TEXTSEQ->error()); + push(@{ $stack[-1]->[CONTENT] }, $cmd); + } + + return $TEXTSEQ->new(pop(@stack)) + || $self->error($TEXTSEQ->error()); + } + + + #------------------------------------------------------------------------ + # default_view($viewer) + # + # Accessor method to return or update the $DEFVIEW package variable, + # loading the module for any package name specified. + #------------------------------------------------------------------------ + + sub default_view { + my ($self, $viewer) = @_; + return $DEFAULT_VIEW unless $viewer; + unless (ref $viewer) { + my $file = $viewer; + $file =~ s[::][/]g; + $file .= '.pm'; + eval { require $file }; + return $self->error($@) if $@; + } + + return ($DEFAULT_VIEW = $viewer); + } + + + #------------------------------------------------------------------------ + # warning($msg, $file, $line) + # + # Appends a string of the form " at $file line $line" to $msg if + # $file is specified and then stores $msg in the internals + # WARNINGS list. If the WARN option is set then the warning is + # raised, either via warn(), or by dispatching to a subroutine + # when WARN is defined as such. + #------------------------------------------------------------------------ + + sub warning { + my ($self, $msg, $file, $line) = @_; + my $warn = $self->{ WARN }; + $line = 'unknown' unless defined $line && length $line; + $msg .= " at $file line $line" if $file; + + push(@{ $self->{ WARNINGS } }, $msg); + + if (ref $warn eq 'CODE') { + &$warn($msg); + } + elsif ($warn) { + warn($msg, "\n"); + } + } + + + #------------------------------------------------------------------------ + # warnings() + # + # Returns a reference to the (possibly empty) list of warnings raised by + # the most recent call to any of the parse_XXX() methods + #------------------------------------------------------------------------ + + sub warnings { + my $self = shift; + return wantarray ? @{ $self->{ WARNINGS } } : $self->{ WARNINGS }; + } + + + #------------------------------------------------------------------------ + # error($msg) + # + # Sets the internal ERROR member and returns undef when called with an + # argument(s), returns the current value when called without. + #------------------------------------------------------------------------ + + sub error { + my $self = shift; + my $errvar; + + { + no strict qw( refs ); + if (ref $self) { + $errvar = \$self->{ ERROR }; + } + else { + $errvar = \${"$self\::ERROR"}; + } + } + if (@_) { + $$errvar = ref($_[0]) ? shift : join('', @_); + return undef; + } + else { + return $$errvar; + } + } + + + + sub DEBUG { + print STDERR "DEBUG: ", @_ if $DEBUG; + } + + 1; + + __END__ + + =head1 NAME + + Pod::POM - POD Object Model + + =head1 SYNOPSIS + + use Pod::POM; + + my $parser = Pod::POM->new(\%options); + + # parse from a text string + my $pom = $parser->parse_text($text) + || die $parser->error(); + + # parse from a file specified by name or filehandle + my $pom = $parser->parse_file($file) + || die $parser->error(); + + # parse from text or file + my $pom = $parser->parse($text_or_file) + || die $parser->error(); + + # examine any warnings raised + foreach my $warning ($parser->warnings()) { + warn $warning, "\n"; + } + + # print table of contents using each =head1 title + foreach my $head1 ($pom->head1()) { + print $head1->title(), "\n"; + } + + # print each section + foreach my $head1 ($pom->head1()) { + print $head1->title(), "\n"; + print $head1->content(); + } + + # print the entire document as HTML + use Pod::POM::View::HTML; + print Pod::POM::View::HTML->print($pom); + + # create custom view + package My::View; + use base qw( Pod::POM::View::HTML ); + + sub view_head1 { + my ($self, $item) = @_; + return '

', + $item->title->present($self), + "

\n", + $item->content->present($self); + } + + package main; + print My::View->print($pom); + + =head1 DESCRIPTION + + This module implements a parser to convert Pod documents into a simple + object model form known hereafter as the Pod Object Model. The object + model is generated as a hierarchical tree of nodes, each of which + represents a different element of the original document. The tree can + be walked manually and the nodes examined, printed or otherwise + manipulated. In addition, Pod::POM supports and provides view objects + which can automatically traverse the tree, or section thereof, and + generate an output representation in one form or another. + + Let's look at a typical Pod document by way of example. + + =head1 NAME + + My::Module - just another My::Module + + =head1 DESCRIPTION + + This is My::Module, a deeply funky piece of Perl code. + + =head2 METHODS + + My::Module implements the following methods + + =over 4 + + =item new(\%config) + + This is the constructor method. It accepts the following + configuration options: + + =over 4 + + =item name + + The name of the thingy. + + =item colour + + The colour of the thingy. + + =back + + =item print() + + This prints the thingy. + + =back + + =head1 AUTHOR + + My::Module was written by me Eme@here.orgE + + This document contains 3 main sections, NAME, DESCRIPTION and + AUTHOR, each of which is delimited by an opening C<=head1> tag. + NAME and AUTHOR each contain only a single line of text, but + DESCRIPTION is more interesting. It contains a line of text + followed by the C<=head2> subsection, METHODS. This contains + a line of text and a list extending from the C<=over 4> to the + final C<=back> just before the AUTHOR section starts. The list + contains 2 items, C, which itself contains some + text and a list of 2 items, and C. + + Presented as plain text and using indentation to indicate the element + nesting, the model then looks something like this : + + NAME + My::Module - just another My::Module + + DESCRIPTION + This is My::Module, a deeply funky piece of Perl code. + + METHODS + My::Module implements the following methods + + * new(\%config) + This is the constructor method. It accepts the + following configuration options: + + * name + The name of the thingy. + + * colour + The colour of the thingy. + + * item print() + This prints the thingy. + + AUTHOR + My::Myodule was written by me + + Those of you familiar with XML may prefer to think of it in the + following way: + + + +

My::Module - just another My::Module

+
+ + +

This is My::Module, a deeply funky piece of + Perl code.

+ + +

My::Module implements the following methods

+ + + +

This is the constructor method. It accepts + the following configuration options:

+ + + +

The name of the thingy.

+
+ + +

The colour of the thingy.

+
+
+
+ + +

This prints the thingy.

+
+
+
+
+ + +

My::Myodule was written by me <me@here.org> + + + + Notice how we can make certain assumptions about various elements. + For example, we can assume that any C<=head1> section we find begins a + new section and implicitly ends any previous section. Similarly, we + can assume an C<=item> ends when the next one begins, and so on. In + terms of the XML example shown above, we are saying that we're smart + enough to add a C/head1E> element to terminate any + previously opened Chead1E> when we find a new C<=head1> tag + in the input document. + + However you like to visualise the content, it all comes down to the + same underlying model. The job of the Pod::POM module is to read an + input Pod document and build an object model to represent it in this + structured form. + + Each node in the tree (i.e. element in the document) is represented + by a Pod::POM::Node::* object. These encapsulate the attributes for + an element (such as the title for a C<=head1> tag) and also act as + containers for further Pod::POM::Node::* objects representing the + content of the element. Right down at the leaf nodes, we have simple + object types to represent formatted and verbatim text paragraphs and + other basic elements like these. + + =head2 Parsing Pod + + The Pod::POM module implements the methods parse_file($file), + parse_text($text) and parse($file_or_text) to parse Pod files and + input text. They return a Pod::POM::Node::Pod object to represent the + root of the Pod Object Model, effectively the CpodE> element + in the XML tree shown above. + + use Pod::POM; + + my $parser = Pod::POM->new(); + my $pom = $parser->parse_file($filename) + || die $parser->error(); + + The parse(), parse_text() and parse_file() methods return + undef on error. The error() method can be called to retrieve the + error message generated. Parsing a document may also generate + non-fatal warnings. These can be retrieved via the warnings() method + which returns a reference to a list when called in scalar context or a + list of warnings when called in list context. + + foreach my $warn ($parser->warnings()) { + warn $warn, "\n"; + } + + Alternatively, the 'warn' configuration option can be set to have + warnings automatically raised via C as they are encountered. + + my $parser = Pod::POM->new( warn => 1 ); + + =head2 Walking the Object Model + + Having parsed a document into an object model, we can then select + various items from it. Each node implements methods (via AUTOLOAD) + which correspond to the attributes and content elements permitted + within in. + + So to fetch the list of '=head1' sections within our parsed document, + we would do the following: + + my $sections = $pom->head1(); + + Methods like this will return a list of further Pod::POM::Node::* + objects when called in list context or a reference to a list when + called in scalar context. In the latter case, the list is blessed + into the Pod::POM::Node::Content class which gives it certain + magical properties (more on that later). + + Given the list of Pod::POM::Node::Head1 objects returned by the above, + we can print the title attributes of each like this: + + foreach my $s (@$sections) { + print $s->title(); + } + + Let's look at the second section, DESCRIPTION. + + my $desc = $sections->[1]; + + We can print the title of each subsection within it: + + foreach my $ss ($desc->head2()) { + print $ss->title(); + } + + Hopefully you're getting the idea by now, so here's a more studly + example to print the title for each item contained in the first list + within the METHODS section: + + foreach my $item ($desc->head2->[0]->over->[0]->item) { + print $item->title(), "\n"; + } + + =head2 Element Content + + This is all well and good if you know the precise structure of a + document in advance. For those more common cases when you don't, + each node that can contain other nodes provides a 'content' method + to return a complete list of all the other nodes that it contains. + The 'type' method can be called on any node to return its element + type (e.g. 'head1', 'head2', 'over', item', etc). + + foreach my $item ($pom->content()) { + my $type = $item->type(); + if ($type eq 'head1') { + ... + } + elsif ($type eq 'head2') { + ... + } + ... + } + + The content for an element is represented by a reference to a list, + blessed into the Pod::POM::Node::Content class. This provides some + magic in the form of an overloaded stringification operator which + will automatically print the contents of the list if you print + the object itself. In plain English, or rather, in plain Perl, + this means you can do things like the following: + + foreach my $head1 ($pom->head1()) { + print '

', $head1->title(), "

\n\n"; + print $head1->content(); + } + + # print all the root content + foreach my $item ($pom->content()) { + print $item; + } + + # same as above + print $pom->content(); + + In fact, all Pod::POM::Node::* objects provide this same magic, and + will attempt to Do The Right Thing to present themselves in the + appropriate manner when printed. Thus, the following are all valid. + + print $pom; # entire document + print $pom->content; # content of document + print $pom->head1->[0]; # just first section + print $pom->head1; # print all sections + foreach my $h1 ($pom->head1()) { + print $h1->head2(); # print all subsections + } + + =head2 Output Views + + To understand how the different elements go about presenting + themselves in "the appropriate manner", we must introduce the concept + of a view. A view is quite simply a particular way of looking at the + model. In real terms, we can think of a view as being some kind of + output type generated by a pod2whatever converter. Notionally we can + think in terms of reading in an input document, building a Pod Object + Model, and then generating an HTML view of the document, and/or a + LaTeX view, a plain text view, and so on. + + A view is represented in this case by an object class which contains + methods for displaying each of the different element types that could + be encountered in any Pod document. There's a method for displaying + C<=head1> sections (view_head1()), another method for displaying + C<=head2> sections (view_head2()), one for C<=over> (view_over()), + another for C<=item> (view_item()) and so on. + + If we happen to have a reference to a $node and we know it's a 'head1' + node, then we can directly call the right view method to have it + displayed properly: + + $view = 'Pod::POM::View::HTML'; + $view->view_head1($node); + + Thus our earlier example can be modified to be I less laborious + and I more flexible. + + foreach my $node ($pom->content) { + my $type = $node->type(); + if ($type eq 'head1') { + print $view->view_head1($node); + } + elsif ($type eq 'head2') { + print $view->view_head2($node); + } + ... + } + + However, this is still far from ideal. To make life easier, each + Pod::POM::Node::* class inherits (or possibly redefines) a + C method from the Pod::POM::Node base class. This method + expects a reference to a view object passed as an argument, and it + simply calls the appropriate view_xxx() method on the view object, + passing itself back as an argument. In object parlance, this is known + as "double dispatch". The beauty of it is that you don't need to know + what kind of node you have to be able to print it. You simply pass + it a view object and leave it to work out the rest. + + foreach my $node ($pom->content) { + print $node->present($view); + } + + If $node is a Pod::POM::Node::Head1 object, then the view_head1($node) + method gets called against the $view object. Otherwise, if it's a + Pod::POM::Node::Head2 object, then the view_head2($node) method is + dispatched. And so on, and so on, with each node knowing what it is + and where it's going as if determined by some genetically pre-programmed + instinct. Fullfilling their destinies, so to speak. + + Double dispatch allows us to do away with all the explicit type + checking and other nonsense and have the node objects themselves worry + about where they should be routed to. At the cost of an extra method + call per node, we get programmer convenience, and that's usually + a Good Thing. + + Let's have a look at how the view and node classes might be + implemented. + + package Pod::POM::View::HTML; + + sub view_pod { + my ($self, $node) = @_; + return $node->content->present($self); + } + + sub view_head1 { + my ($self, $node) = @_; + return "

", $node->title->present($self), "

\n\n" + . $node->content->present($self); + } + + sub view_head2 { + my ($self, $node) = @_; + return "

", $node->title->present($self), "

\n\n" + . $node->content->present($self); + } + + ... + + package Pod::POM::Node::Pod; + + sub present { + my ($self, $view) = @_; + $view->view_pod($self); + } + + package Pod::POM::Node::Head1; + + sub present { + my ($self, $view) = @_; + $view->view_head1($self); + } + + package Pod::POM::Node::Head2; + + sub present { + my ($self, $view) = @_; + $view->view_head2($self); + } + + ... + + Some of the view_xxx methods make calls back against the node objects + to display their attributes and/or content. This is shown in, for + example, the view_head1() method above, where the method prints the + section title in Ch1E>...Ch1E> tags, followed by + the remaining section content. + + Note that the title() attribute is printed by calling its present() + method, passing on the reference to the current view. Similarly, + the content present() method is called giving it a chance to Do + The Right Thing to present itself correctly via the view object. + + There's a good chance that the title attribute is going to be regular + text, so we might be tempted to simply print the title rather than + call its present method. + + sub view_head1 { + my ($self, $node) = @_; + # not recommended, prefer $node->title->present($self) + return "

", $node->title(), "

\n\n", ... + } + + However, it is entirely valid for titles and other element attributes, + as well as regular, formatted text blocks to contain code sequences, + such like CthisE> and CthisE>. These are used + to indicate different markup styles, mark external references or index + items, and so on. What's more, they can be Cnested + IEindefinatelyEE>. Pod::POM takes care of all this by + parsing such text, along with any embedded sequences, into Yet Another + Tree, the root node of which is a Pod::POM::Node::Text object, + possibly containing other Pod::POM::Node::Sequence objects. When the + text is presented, the tree is automatically walked and relevant + callbacks made against the view for the different sequence types. The + methods called against the view are all prefixed 'view_seq_', e.g. + 'view_seq_bold', 'view_seq_italic'. + + Now the real magic comes into effect. You can define one view to + render bold/italic text in one style: + + package My::View::Text; + use base qw( Pod::POM::View::Text ); + + sub view_seq_bold { + my ($self, $text) = @_; + return "*$text*"; + } + + sub view_seq_italic { + my ($self, $text) = @_; + return "_$text_"; + } + + And another view to render it in a different style: + + package My::View::HTML; + use base qw( Pod::POM::View::HTML ); + + sub view_seq_bold { + my ($self, $text) = @_; + return "$text"; + } + + sub view_seq_italic { + my ($self, $text) = @_; + return "$text"; + } + + Then, you can easily view a Pod Object Model in either style: + + my $text = 'My::View::Text'; + my $html = 'My::View::HTML'; + + print $pom->present($text); + print $pom->present($html); + + And you can apply this technique to any node within the object + model. + + print $pom->head1->[0]->present($text); + print $pom->head1->[0]->present($html); + + In these examples, the view passed to the present() method has + been a class name. Thus, the view_xxx methods get called as + class methods, as if written: + + My::View::Text->view_head1(...); + + If your view needs to maintain state then you can create a view object + and pass that to the present() method. + + my $view = My::View->new(); + $node->present($view); + + In this case the view_xxx methods get called as object methods. + + sub view_head1 { + my ($self, $node) = @_; + my $title = $node->title(); + if ($title eq 'NAME' && ref $self) { + $self->{ title } = $title(); + } + $self->SUPER::view_head1($node); + } + + Whenever you print a Pod::POM::Node::* object, or do anything to cause + Perl to stringify it (such as including it another quoted string "like + $this"), then its present() method is automatically called. When + called without a view argument, the present() method uses the default + view specified in $Pod::POM::DEFAULT_VIEW, which is, by default, + 'Pod::POM::View::Pod'. This view regenerates the original Pod + document, although it should be noted that the output generated may + not be exactly the same as the input. The parser is smart enough to + detect some common errors (e.g. not terminating an C<=over> with a C<=back>) + and correct them automatically. Thus you might find a C<=back> + correctly placed in the output, even if you forgot to add it to the + input. Such corrections raise non-fatal warnings which can later + be examined via the warnings() method. + + You can update the $Pod::POM::DEFAULT_VIEW package variable to set the + default view, or call the default_view() method. The default_view() + method will automatically load any package you specify. If setting + the package variable directly, you should ensure that any packages + required have been pre-loaded. + + use My::View::HTML; + $Pod::POM::DEFAULT_VIEW = 'My::View::HTML'; + + or + + Pod::POM->default_view('My::View::HTML'); + + =head2 Template Toolkit Views + + One of the motivations for writing this module was to make it easier + to customise Pod documentation to your own look and feel or local + formatting conventions. By clearly separating the content + (represented by the Pod Object Model) from the presentation style + (represented by one or more views) it becomes much easier to achieve + this. + + The latest version of the Template Toolkit (2.06 at the time of + writing) provides a Pod plugin to interface to this module. It also + implements a new (but experimental) VIEW directive which can be used + to build different presentation styles for converting Pod to other + formats. The Template Toolkit is available from CPAN: + + http://www.cpan.org/modules/by-module/Template/ + + Template Toolkit views are similar to the Pod::POM::View objects + described above, except that they allow the presentation style for + each Pod component to be written as a template file or block rather + than an object method. The precise syntax and structure of the VIEW + directive is subject to change (given that it's still experimental), + but at present it can be used to define a view something like this: + + [% VIEW myview %] + + [% BLOCK view_head1 %] +

[% item.title.present(view) %]

+ [% item.content.present(view) %] + [% END %] + + [% BLOCK view_head2 %] +

[% item.title.present(view) %]

+ [% item.content.present(view) %] + [% END %] + + ... + + [% END %] + + A plugin is provided to interface to the Pod::POM module: + + [% USE pod %] + [% pom = pod.parse('/path/to/podfile') %] + + The returned Pod Object Model instance can then be navigated and + presented via the view in almost any way imaginable: + +

Table of Contents

+
    + [% FOREACH section = pom.head1 %] +
  • [% section.title.present(view) %] + [% END %] +
+ +
+ + [% FOREACH section = pom.head1 %] + [% section.present(myview) %] + [% END %] + + You can either pass a reference to the VIEW (myview) to the + present() method of a Pod::POM node: + + [% pom.present(myview) %] # present entire document + + Or alternately call the print() method on the VIEW, passing the + Pod::POM node as an argument: + + [% myview.print(pom) %] + + Internally, the view calls the present() method on the node, + passing itself as an argument. Thus it is equivalent to the + previous example. + + The Pod::POM node and the view conspire to "Do The Right Thing" to + process the right template block for the node. A reference to the + node is available within the template as the 'item' variable. + + [% BLOCK view_head2 %] +

[% item.title.present(view) %]

+ [% item.content.present(view) %] + [% END %] + + The Template Toolkit documentation contains further information on + defining and using views. However, as noted above, this may be + subject to change or incomplete pending further development of the + VIEW directive. + + =head1 METHODS + + =head2 new(\%config) + + Constructor method which instantiates and returns a new Pod::POM + parser object. + + use Pod::POM; + + my $parser = Pod::POM->new(); + + A reference to a hash array of configuration options may be passed as + an argument. + + my $parser = Pod::POM->new( { warn => 1 } ); + + For convenience, configuration options can also be passed as a list of + (key =E value) pairs. + + my $parser = Pod::POM->new( warn => 1 ); + + The following configuration options are defined: + + =over 4 + + =item code + + This option can be set to have all non-Pod parts of the input document + stored within the object model as 'code' elements, represented by + objects of the Pod::POM::Node::Code class. It is disabled by default + and code sections are ignored. + + my $parser = Pod::POM->new( code => 1 ); + my $podpom = $parser->parse(\*DATA); + + foreach my $code ($podpom->code()) { + print "
$code
\n"; + } + + __DATA__ + This is some program code. + + =head1 NAME + + ... + + This will generate the output: + +
This is some program code.
+ + Note that code elements are stored within the POM element in which + they are encountered. For example, the code element below embedded + within between Pod sections is stored in the array which can be + retrieved by calling C<$podpom-Ehead1-E[0]-Ecode()>. + + =head1 NAME + + My::Module::Name; + + =cut + + Some program code embedded in Pod. + + =head1 SYNOPSIS + + ... + + =item warn + + Non-fatal warnings encountered while parsing a Pod document are stored + internally and subsequently available via the warnings() method. + + my $parser = Pod::POM->new(); + my $podpom = $parser->parse_file($filename); + + foreach my $warning ($parser->warnings()) { + warn $warning, "\n"; + } + + The 'warn' option can be set to have warnings raised automatically + via C as and when they are encountered. + + my $parser = Pod::POM->new( warn => 1 ); + my $podpom = $parser->parse_file($filename); + + If the configuration value is specified as a subroutine reference then + the code will be called each time a warning is raised, passing the + warning message as an argument. + + sub my_warning { + my $msg = shift; + warn $msg, "\n"; + }; + + my $parser = Pod::POM->new( warn => \&my_warning ); + my $podpom = $parser->parse_file($filename); + + =item meta + + The 'meta' option can be set to allow C<=meta> tags within the Pod + document. + + my $parser = Pod::POM->new( meta => 1 ); + my $podpom = $parser->parse_file($filename); + + This is an experimental feature which is not part of standard + POD. For example: + + =meta author Andy Wardley + + These are made available as metadata items within the root + node of the parsed POM. + + my $author = $podpom->metadata('author'); + + See the L section below for further information. + + =back + + =head2 parse_file($file) + + Parses the file specified by name or reference to a file handle. + Returns a reference to a Pod::POM::Node::Pod object which represents + the root node of the Pod Object Model on success. On error, undef + is returned and the error message generated can be retrieved by calling + error(). + + my $podpom = $parser->parse_file($filename) + || die $parser->error(); + + my $podpom = $parser->parse_file(\*STDIN) + || die $parser->error(); + + Any warnings encountered can be examined by calling the + warnings() method. + + foreach my $warn ($parser->warnings()) { + warn $warn, "\n"; + } + + =head2 parse_text($text) + + Parses the Pod text string passed as an argument into a Pod Object + Model, as per parse_file(). + + =head2 parse($text_or_$file) + + General purpose method which attempts to Do The Right Thing in calling + parse_file() or parse_text() according to the argument passed. + + A hash reference can be passed as an argument that contains a 'text' + or 'file' key and corresponding value. + + my $podpom = $parser->parse({ file => $filename }) + || die $parser->error(); + + Otherwise, the argument can be a reference to an input handle which is + passed off to parse_file(). + + my $podpom = $parser->parse(\*DATA) + || die $parser->error(); + + If the argument is a text string that looks like Pod text (i.e. it + contains '=' at the start of any line) then it is passed to parse_text(). + + my $podpom = $parser->parse($podtext) + || die $parser->error(); + + Otherwise it is assumed to be a filename and is passed to parse_file(). + + my $podpom = $parser->parse($podfile) + || die $parser->error(); + + =head1 NODE TYPES, ATTRIBUTES AND ELEMENTS + + This section lists the different nodes that may be present in a Pod Object + Model. These are implemented as Pod::POM::Node::* object instances + (e.g. head1 =E Pod::POM::Node::Head1). To present a node, a view should + implement a method which corresponds to the node name prefixed by 'view_' + (e.g. head1 =E view_head1()). + + =over 4 + + =item pod + + The C node is used to represent the root node of the Pod Object Model. + + Content elements: head1, head2, head3, head4, over, begin, for, + verbatim, text, code. + + =item head1 + + A C node contains the Pod content from a C<=head1> tag up to the + next C<=head1> tag or the end of the file. + + Attributes: title + + Content elements: head2, head3, head4, over, begin, for, verbatim, text, code. + + =item head2 + + A C node contains the Pod content from a C<=head2> tag up to the + next C<=head1> or C<=head2> tag or the end of the file. + + Attributes: title + + Content elements: head3, head4, over, begin, for, verbatim, text, code. + + =item head3 + + A C node contains the Pod content from a C<=head3> tag up to the + next C<=head1>, C<=head2> or C<=head3> tag or the end of the file. + + Attributes: title + + Content elements: head4, over, begin, for, verbatim, text, code. + + =item head4 + + A C node contains the Pod content from a C<=head4> tag up to the + next C<=head1>, C<=head2>, C<=head3> or C<=head4> tag or the end of the file. + + Attributes: title + + Content elements: over, begin, for, verbatim, text, code. + + =item over + + The C node encloses the Pod content in a list starting at an C<=over> + tag and continuing up to the matching C<=back> tag. Lists may be nested + indefinately. + + Attributes: indent (default: 4) + + Content elements: over, item, begin, for, verbatim, text, code. + + =item item + + The C node encloses the Pod content in a list item starting at an + C<=item> tag and continuing up to the next C<=item> tag or a C<=back> tag + which terminates the list. + + Attributes: title (default: *) + + Content elements: over, begin, for, verbatim, text, code. + + =item begin + + A C node encloses the Pod content in a conditional block starting + with a C<=begin> tag and continuing up to the next C<=end> tag. + + Attributes: format + + Content elements: verbatim, text, code. + + =item for + + A C node contains a single paragraph containing text relevant to a + particular format. + + Attributes: format, text + + =item verbatim + + A C node contains a verbatim text paragraph which is prefixed by + whitespace in the source Pod document (i.e. indented). + + Attributes: text + + =item text + + A C node contains a regular text paragraph. This may include + embedded inline sequences. + + Attributes: text + + =item code + + A C node contains Perl code which is by default, not considered to be + part of a Pod document. The C configuration option must be set for + Pod::POM to generate code blocks, otherwise they are ignored. + + Attributes: text + + =back + + =head1 INLINE SEQUENCES + + Embedded sequences are permitted within regular text blocks (i.e. not + verbatim) and title attributes. To present these sequences, a view + should implement methods corresponding to the sequence name, prefixed + by 'view_seq_' (e.g. bold =E view_seq_bold()). + + =over 4 + + =item code + + Code extract, e.g. CEmy codeE + + =item bold + + Bold text, e.g. BEbold textE + + =item italic + + Italic text, e.g. IEitalic textE + + =item link + + A link (cross reference), e.g. LEMy::ModuleE + + =item space + + Text contains non-breaking space, e.g.SEBuffy The Vampire SlayerE + + =item file + + A filename, e.g. FE/etc/lilo.confE + + =item index + + An index entry, e.g. XEAngelE + + =item zero + + A zero-width character, e.g. ZEE + + =item entity + + An entity escape, e.g. EEltE + + =back + + =head1 BUNDLED MODULES AND TOOLS + + The Pod::POM module distribution includes a number of sample view + objects for rendering Pod Object Models into particular formats. These + are incomplete and may require some further work, but serve at present to + illustrate the principal and can be used as the basis for your own view + objects. + + =over 4 + + =item Pod::POM::View::Pod + + Regenerates the model as Pod. + + =item Pod::POM::View::Text + + Presents the model as plain text. + + =item Pod::POM::View::HTML + + Presents the model as HTML. + + =back + + A script is provided for converting Pod documents to other format by + using the view objects provided. The C script should be called + with two arguments, the first specifying the output format, the second + the input filename. e.g. + + $ pom2 text My/Module.pm > README + $ pom2 html My/Module.pm > ~/public_html/My/Module.html + + You can also create symbolic links to the script if you prefer and + leave it to determine the output format from its own name. + + $ ln -s pom2 pom2text + $ ln -s pom2 pom2html + $ pom2text My/Module.pm > README + $ pom2html My/Module.pm > ~/public_html/My/Module.html + + The distribution also contains a trivial script, C + (previously C), which checks a Pod document for + well-formedness by simply parsing it into a Pod Object Model with + warnings enabled. Warnings are printed to STDERR. + + $ podlint My/Module.pm + + The C<-f> option can be set to have the script attempt to fix any problems + it encounters. The regenerated Pod output is printed to STDOUT. + + $ podlint -f My/Module.pm > newfile + + =head1 METADATA + + This module includes support for an experimental new C<=meta> tag. This + is disabled by default but can be enabled by loading Pod::POM with the + C option. + + use Pod::POM qw( meta ); + + Alternately, you can specify the C option to be any true value when + you instantiate a Pod::POM parser: + + my $parser = Pod::POM->new( meta => 1 ); + my $pom = $parser->parse_file($filename); + + Any C<=meta> tags in the document will be stored as metadata items in the + root node of the Pod model created. + + For example: + + =meta module Foo::Bar + + =meta author Andy Wardley + + You can then access these items via the metadata() method. + + print "module: ", $pom->metadata('module'), "\n"; + print "author: ", $pom->metadata('author'), "\n"; + + or + + my $metadata = $pom->metadata(); + print "module: $metadata->{ module }\n"; + print "author: $metadata->{ author }\n"; + + Please note that this is an experimental feature which is not supported by + other POD processors and is therefore likely to be most incompatible. Use + carefully. + + =head1 AUTHOR + + Andy Wardley Eabw@kfs.orgE + + Andrew Ford EA.Ford@ford-mason.co.ukE (co-maintainer as of 03/2009) + + =head1 VERSION + + This is version 0.25 of the Pod::POM module. + + =head1 COPYRIGHT + + Copyright (C) 2000-2009 Andy Wardley. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + For the definitive reference on Pod, see L. + + For an overview of Pod::POM internals and details relating to subclassing + of POM nodes, see L. + + There are numerous other fine Pod modules available from CPAN which + perform conversion from Pod to other formats. In many cases these are + likely to be faster and quite possibly more reliable and/or complete + than this module. But as far as I know, there aren't any that offer + the same kind of flexibility in being able to customise the generated + output. But don't take my word for it - see your local CPAN site for + further details: + + http://www.cpan.org/modules/by-module/Pod/ + +POD_POM + +$fatpacked{"Pod/POM/Constants.pm"} = <<'POD_POM_CONSTANTS'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Constants + # + # DESCRIPTION + # Constants used by Pod::POM. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Constants.pm 78 2009-08-20 20:44:53Z ford $ + # + #======================================================================== + + package Pod::POM::Constants; + + require 5.004; + + use strict; + + use vars qw( $VERSION @SEQUENCE @STATUS @EXPORT_OK %EXPORT_TAGS ); + use parent qw( Exporter ); + + $VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/); + @SEQUENCE = qw( CMD LPAREN RPAREN FILE LINE CONTENT ); + @STATUS = qw( IGNORE REDUCE REJECT ); + @EXPORT_OK = ( @SEQUENCE, @STATUS ); + %EXPORT_TAGS = ( + status => [ @STATUS ], + seq => [ @SEQUENCE ], + all => [ @STATUS, @SEQUENCE ], + ); + + # sequence items + use constant CMD => 0; + use constant LPAREN => 1; + use constant RPAREN => 2; + use constant FILE => 3; + use constant LINE => 4; + use constant CONTENT => 5; + + # node add return values + use constant IGNORE => 0; + use constant REDUCE => 1; + use constant REJECT => 2; + + + 1; + + =head1 NAME + + Pod::POM::Constants + + =head1 DESCRIPTION + + Constants used by Pod::POM. + + =head1 AUTHOR + + Andy Wardley Eabw@kfs.orgE + + Andrew Ford Ea.ford@ford-mason.co.ukE + + =head1 COPYRIGHT AND LICENSE + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =cut +POD_POM_CONSTANTS + +$fatpacked{"Pod/POM/Node.pm"} = <<'POD_POM_NODE'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node + # + # DESCRIPTION + # Base class for a node in a Pod::POM tree. + # + # AUTHOR + # Andy Wardley + # + # COPYRIGHT + # Copyright (C) 2000-2003 Andy Wardley. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Node.pm 88 2010-04-02 13:37:41Z ford $ + # + #======================================================================== + + package Pod::POM::Node; + + require 5.004; + + use strict; + use Pod::POM::Nodes; + use Pod::POM::Constants qw( :all ); + use vars qw( $VERSION $DEBUG $ERROR $NODES $NAMES $AUTOLOAD ); + use constant DUMP_LINE_LENGTH => 80; + + $VERSION = sprintf("%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/); + $DEBUG = 0 unless defined $DEBUG; + $NODES = { + pod => 'Pod::POM::Node::Pod', + head1 => 'Pod::POM::Node::Head1', + head2 => 'Pod::POM::Node::Head2', + head3 => 'Pod::POM::Node::Head3', + head4 => 'Pod::POM::Node::Head4', + over => 'Pod::POM::Node::Over', + item => 'Pod::POM::Node::Item', + begin => 'Pod::POM::Node::Begin', + for => 'Pod::POM::Node::For', + text => 'Pod::POM::Node::Text', + code => 'Pod::POM::Node::Code', + verbatim => 'Pod::POM::Node::Verbatim', + }; + $NAMES = { + map { ( $NODES->{ $_ } => $_ ) } keys %$NODES, + }; + + # overload stringification to present node via a view + use overload + '""' => 'present', + fallback => 1, + 'bool' => sub { 1 }; + + # alias meta() to metadata() + *meta = \*metadata; + + + #------------------------------------------------------------------------ + # new($pom, @attr) + # + # Constructor method. Returns a new Pod::POM::Node::* object or undef + # on error. First argument is the Pod::POM parser object, remaining + # arguments are node attributes as specified in %ATTRIBS in derived class + # package. + #------------------------------------------------------------------------ + + sub new { + my $class = shift; + my $pom = shift; + my ($type, $attribs, $accept, $key, $value, $default); + + $type = $NAMES->{ $class }; + + { + no strict qw( refs ); + $attribs = \%{"$class\::ATTRIBS"} || [ ]; + $accept = \@{"$class\::ACCEPT"} || [ ]; + unless (%{"$class\::ACCEPT"}) { + %{"$class\::ACCEPT"} = ( + map { ( $_ => $NODES->{ $_ } ) } @$accept, + ); + } + } + + # create object with slots for each acceptable child and overall content + my $self = bless { + type => $type, + content => bless([ ], 'Pod::POM::Node::Content'), + map { ($_ => bless([ ], 'Pod::POM::Node::Content')) } + (@$accept, 'code'), + }, $class; + + # set attributes from arguments + keys %$attribs; # reset hash iterator + while(my ($key, $default) = each %$attribs) { + $value = shift || $default; + return $class->error("$type expected a $key") + unless $value; + $self->{ $key } = $value; + } + + return $self; + } + + + #------------------------------------------------------------------------ + # add($pom, $type, @attr) + # + # Adds a new node as a child element (content) of the current node. + # First argument is the Pod::POM parser object. Second argument is the + # child node type specified by name (e.g. 'head1') which is mapped via + # the $NODES hash to a class name against which new() can be called. + # Remaining arguments are attributes passed to the child node constructor. + # Returns a reference to the new node (child was accepted) or one of the + # constants REDUCE (child terminated node, e.g. '=back' terminates an + # '=over' node), REJECT (child rejected, e.g. '=back' expected to terminate + # '=over' but something else found instead) or IGNORE (node didn't expect + # child and is implicitly terminated). + #------------------------------------------------------------------------ + + sub add { + my $self = shift; + my $pom = shift; + my $type = shift; + my $class = ref $self; + my ($name, $attribs, $accept, $expect, $nodeclass, $node); + + $name = $NAMES->{ $class } + || return $self->error("no name for $class"); + { + no strict qw( refs ); + $accept = \%{"$class\::ACCEPT"}; + $expect = ${"$class\::EXPECT"}; + } + + # SHIFT: accept indicates child nodes that can be accepted; a + # new node is created, added it to content list and node specific + # list, then returned by reference. + + if ($nodeclass = $accept->{ $type }) { + defined($node = $nodeclass->new($pom, @_)) + || return $self->error($nodeclass->error()) + unless defined $node; + push(@{ $self->{ $type } }, $node); + push(@{ $self->{ content } }, $node); + $pom->{in_begin} = 1 if $nodeclass eq 'Pod::POM::Node::Begin'; + return $node; + } + + # REDUCE: expect indicates the token that should terminate this node + if (defined $expect && ($type eq $expect)) { + DEBUG("$name terminated by expected $type\n"); + $pom->{in_begin} = 0 if $name eq 'begin'; + return REDUCE; + } + + # REJECT: expected terminating node was not found + if (defined $expect) { + DEBUG("$name rejecting $type, expecting a terminating $expect\n"); + $self->error("$name expected a terminating $expect"); + return REJECT; + } + + # IGNORE: don't know anything about this node + DEBUG("$name ignoring $type\n"); + return IGNORE; + } + + + #------------------------------------------------------------------------ + # present($view) + # + # Present the node by making a callback on the appropriate method against + # the view object passed as an argument. $Pod::POM::DEFAULT_VIEW is used + # if $view is unspecified. + #------------------------------------------------------------------------ + + sub present { + my ($self, $view, @args) = @_; + $view ||= $Pod::POM::DEFAULT_VIEW; + my $type = $self->{ type }; + my $method = "view_$type"; + DEBUG("presenting method $method to $view\n"); + my $txt = $view->$method($self, @args); + if ($view->can("encode")){ + return $view->encode($txt); + } else { + return $txt; + } + } + + + #------------------------------------------------------------------------ + # metadata() + # metadata($key) + # metadata($key, $value) + # + # Returns the metadata hash when called without any arguments. Returns + # the value of a metadata item when called with a single argument. + # Sets a metadata item to a value when called with two arguments. + #------------------------------------------------------------------------ + + sub metadata { + my ($self, $key, $value) = @_; + my $metadata = $self->{ METADATA } ||= { }; + + return $metadata unless defined $key; + + if (defined $value) { + $metadata->{ $key } = $value; + } + else { + $value = $self->{ METADATA }->{ $key }; + return defined $value ? $value + : $self->error("no such metadata item: $key"); + } + } + + + #------------------------------------------------------------------------ + # error() + # error($msg, ...) + # + # May be called as a class or object method to set or retrieve the + # package variable $ERROR (class method) or internal member + # $self->{ _ERROR } (object method). The presence of parameters indicates + # that the error value should be set. Undef is then returned. In the + # abscence of parameters, the current error value is returned. + #------------------------------------------------------------------------ + + sub error { + my $self = shift; + my $errvar; + # use Carp; + + { + no strict qw( refs ); + if (ref $self) { + # my ($pkg, $file, $line) = caller(); + # print STDERR "called from $file line $line\n"; + # croak "cannot get/set error in non-hash: $self\n" + # unless UNIVERSAL::isa($self, 'HASH'); + $errvar = \$self->{ ERROR }; + } + else { + $errvar = \${"$self\::ERROR"}; + } + } + if (@_) { + $$errvar = ref($_[0]) ? shift : join('', @_); + return undef; + } + else { + return $$errvar; + } + } + + + #------------------------------------------------------------------------ + # dump() + # + # Returns a representation of the element and all its children in a + # format useful only for debugging. The structure of the document is + # shown by indentation (inspired by HTML::Element). + #------------------------------------------------------------------------ + + sub dump { + my($self, $depth) = @_; + my $output; + $depth = 0 unless defined $depth; + my $nodepkg = ref $self; + if ($self->isa('REF')) { + $self = $$self; + my $cmd = $self->[CMD]; + my @content = @{ $self->[CONTENT] }; + if ($cmd) { + $output .= (" " x $depth) . $cmd . $self->[LPAREN] . "\n"; + } + foreach my $item (@content) { + if (ref $item) { + $output .= $item->dump($depth+1); # recurse + } + else { # text node + $output .= _dump_text($item, $depth+1); + } + } + if ($cmd) { + $output .= (" " x $depth) . $self->[RPAREN] . "\n", ; + } + } + else { + no strict 'refs'; + my @attrs = sort keys %{"*${nodepkg}::ATTRIBS"}; + $output .= (" " x $depth) . $self->type . "\n"; + foreach my $attr (@attrs) { + if (my $value = $self->{$attr}) { + $output .= (" " x ($depth+1)) . "\@$attr\n"; + + if (ref $value) { + $output .= $value->dump($depth+1); + } + else { + $output .= _dump_text($value, $depth+2); + } + } + } + foreach my $item (@{$self->{content}}) { + if (ref $item) { # element + $output .= $item->dump($depth+1); # recurse + } + else { # text node + $output .= _dump_text($item, $depth+1); + } + } + } + + return $output; + } + + sub _dump_text { + my ($text, $depth) = @_; + + my $output = ""; + my $padding = " " x $depth; + my $max_text_len = DUMP_LINE_LENGTH - length($depth) - 2; + + foreach my $line (split(/\n/, $text)) { + $output .= $padding; + if (length($line) > $max_text_len or $line =~ m<[\x00-\x1F]>) { + # it needs prettyin' up somehow or other + my $x = (length($line) <= $max_text_len) ? $_ : (substr($line, 0, $max_text_len) . '...'); + $x =~ s<([\x00-\x1F])> + <'\\x'.(unpack("H2",$1))>eg; + $output .= qq{"$x"\n}; + } else { + $output .= qq{"$line"\n}; + } + } + return $output; + } + + + #------------------------------------------------------------------------ + # AUTOLOAD + #------------------------------------------------------------------------ + + sub AUTOLOAD { + my $self = shift; + my $name = $AUTOLOAD; + my $item; + + $name =~ s/.*:://; + return if $name eq 'DESTROY'; + + # my ($pkg, $file, $line) = caller(); + # print STDERR "called from $file line $line to return ", ref($item), "\n"; + + return $self->error("can't manipulate \$self") + unless UNIVERSAL::isa($self, 'HASH'); + return $self->error("no such member: $name") + unless defined ($item = $self->{ $name }); + + return wantarray ? ( UNIVERSAL::isa($item, 'ARRAY') ? @$item : $item ) + : $item; + } + + + #------------------------------------------------------------------------ + # DEBUG(@msg) + #------------------------------------------------------------------------ + + sub DEBUG { + print STDERR "DEBUG: ", @_ if $DEBUG; + } + + 1; + + + + =head1 NAME + + Pod::POM::Node - base class for a POM node + + =head1 SYNOPSIS + + package Pod::POM::Node::Over; + use base qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR ); + + %ATTRIBS = ( indent => 4 ); + @ACCEPT = qw( over item begin for text verbatim ); + $EXPECT = q( back ); + + package main; + my $list = Pod::POM::Node::Over->new(8); + $list->add('item', 'First Item'); + $list->add('item', 'Second Item'); + ... + + =head1 DESCRIPTION + + This documentation describes the inner workings of the Pod::POM::Node + module and gives a brief overview of the relationship between it and + its derived classes. It is intended more as a guide to the internals + for interested hackers than as general user documentation. See + L for information on using the modules. + + This module implements a base class node which is subclassed to + represent different elements within a Pod Object Model. + + package Pod::POM::Node::Over; + use base qw( Pod::POM::Node ); + + The base class implements the new() constructor method to instantiate + new node objects. + + my $list = Pod::POM::Node::Over->new(); + + The characteristics of a node can be specified by defining certain + variables in the derived class package. The C<%ATTRIBS> hash can be + used to denote attributes that the node should accept. In the case of + an C<=over> node, for example, an C attribute can be specified + which otherwise defaults to 4. + + package Pod::POM::Node::Over; + use base qw( Pod::POM::Node ); + use vars qw( %ATTRIBS $ERROR ); + + %ATTRIBS = ( indent => 4 ); + + The new() method will now expect an argument to set the indent value, + or will use 4 as the default if no argument is provided. + + my $list = Pod::POM::Node::Over->new(8); # indent: 8 + my $list = Pod::POM::Node::Over->new( ); # indent: 4 + + If the default value is undefined then the argument is mandatory. + + package Pod::POM::Node::Head1; + use base qw( Pod::POM::Node ); + use vars qw( %ATTRIBS $ERROR ); + + %ATTRIBS = ( title => undef ); + + package main; + my $head = Pod::POM::Node::Head1->new('My Title'); + + If a mandatory argument isn't provided then the constructor will + return undef to indicate failure. The $ERROR variable in the derived + class package is set to contain a string of the form "$type expected a + $attribute". + + # dies with error: "head1 expected a title" + my $head = Pod::POM::Node::Head1->new() + || die $Pod::POM::Node::Head1::ERROR; + + For convenience, the error() subroutine can be called as a class + method to retrieve this value. + + my $type = 'Pod::POM::Node::Head1'; + my $head = $type->new() + || die $type->error(); + + The C<@ACCEPT> package variable can be used to indicate the node types + that are permitted as children of a node. + + package Pod::POM::Node::Head1; + use base qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $ERROR ); + + %ATTRIBS = ( title => undef ); + @ACCEPT = qw( head2 over begin for text verbatim ); + + The add() method can then be called against a node to add a new child + node as part of its content. + + $head->add('over', 8); + + The first argument indicates the node type. The C<@ACCEPT> list is + examined to ensure that the child node type is acceptable for the + parent node. If valid, the constructor for the relevant child node + class is called passing any remaining arguments as attributes. The + new node is then returned. + + my $list = $head->add('over', 8); + + The error() method can be called against the I node to retrieve + any constructor error generated by the I node. + + my $list = $head->add('over', 8); + die $head->error() unless defined $list; + + If the child node is not acceptable to the parent then the add() + method returns one of the constants IGNORE, REDUCE or REJECT, as + defined in Pod::POM::Constants. These return values are used by the + Pod::POM parser module to implement a simple shift/reduce parser. + + In the most common case, IGNORE is returned to indicate that the + parent node doesn't know anything about the new child node. The + parser uses this as an indication that it should back up through the + parse stack until it finds a node which I accept this child node. + Through this mechanism, the parser is able to implicitly terminate + certain POD blocks. For example, a list item initiated by a C<=item> + tag will I accept another C<=item> tag, but will instead return IGNORE. + The parser will back out until it finds the enclosing C<=over> node + which I accept it. Thus, a new C<=item> implicitly terminates any + previous C<=item>. + + The C<$EXPECT> package variable can be used to indicate a node type + which a parent expects to terminate itself. An C<=over> node, for + example, should always be terminated by a matching C<=back>. When + such a match is made, the add() method returns REDUCE to indicate + successful termination. + + package Pod::POM::Node::Over; + use base qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR ); + + %ATTRIBS = ( indent => 4 ); + @ACCEPT = qw( over item begin for text verbatim ); + $EXPECT = q( back ); + + package main; + my $list = Pod::POM::Node::Over->new(); + my $item = $list->add('item'); + $list->add('back'); # returns REDUCE + + If a child node isn't specified in the C<@ACCEPT> list or doesn't match + any C<$EXPECT> specified then REJECT is returned. The parent node sets + an internal error of the form "$type expected a terminating $expect". + The parser uses this to detect missing POD tags. In nearly all cases + the parser is smart enough to fix the incorrect structure and downgrades + any errors to warnings. + + # dies with error 'over expected terminating back' + ref $list->add('head1', 'My Title') # returns REJECT + || die $list->error(); + + Each node contains a 'type' field which contains a simple string + indicating the node type, e.g. 'head1', 'over', etc. The $NODES and + $NAMES package variables (in the base class) reference hash arrays + which map these names to and from package names (e.g. head1 E=E + Pod::POM::Node::Head1). + + print $list->{ type }; # 'over' + + An AUTOLOAD method is provided to access to such internal items for + those who don't like violating an object's encapsulation. + + print $list->type(); + + Nodes also contain a 'content' list, blessed into the + Pod::POM::Node::Content class, which contains the content (child + elements) for the node. The AUTOLOAD method returns this as a list + reference or as a list of items depending on the context in which it + is called. + + my $items = $list->content(); + my @items = $list->content(); + + Each node also contains a content list for each individual child node + type that it may accept. + + my @items = $list->item(); + my @text = $list->text(); + my @vtext = $list->verbatim(); + + The present() method is used to present a node through a particular view. + This simply maps the node type to a method which is then called against the + view object. This is known as 'double dispatch'. + + my $view = 'Pod::POM::View::HTML'; + print $list->present($view); + + The method name is constructed from the node type prefixed by 'view_'. + Thus the following are roughly equivalent. + + $list->present($view); + + $view->view_list($list); + + The benefit of the former over the latter is, of course, that the + caller doesn't need to know or determine the type of the node. The + node itself is in the best position to determine what type it is. + + =head1 AUTHOR + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a general overview and examples of use. + +POD_POM_NODE + +$fatpacked{"Pod/POM/Node/Begin.pm"} = <<'POD_POM_NODE_BEGIN'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Begin + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Begin.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Begin; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR ); + + %ATTRIBS = ( format => undef ); + @ACCEPT = qw( text verbatim code ); + $EXPECT = 'end'; + + 1; + + =head1 NAME + + Pod::POM::Node::Begin - POM '=begin' node class + + =head1 SYNOPSIS + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent '=begin' elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_BEGIN + +$fatpacked{"Pod/POM/Node/Code.pm"} = <<'POD_POM_NODE_CODE'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Code + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Code.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Code; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS $ERROR ); + + %ATTRIBS = ( text => '' ); + + sub present { + my ($self, $view) = @_; + $view ||= $Pod::POM::DEFAULT_VIEW; + return $view->view_code($self->{ text }); + } + + 1; + + =head1 NAME + + Pod::POM::Node::Code - + + =head1 SYNOPSIS + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent code elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_CODE + +$fatpacked{"Pod/POM/Node/Content.pm"} = <<'POD_POM_NODE_CONTENT'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Content + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Content.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Content; + + use strict; + + use Pod::POM::Constants qw( :all ); + use parent qw( Pod::POM::Node ); + + sub new { + my $class = shift; + return bless [ @_ ], $class; + } + + sub present { + my ($self, $view) = @_; + $view ||= $Pod::POM::DEFAULT_VIEW; + return join('', map { ref $_ ? $_->present($view) : $_ } @$self); + } + + + 1; + + + =head1 NAME + + Pod::POM::Node::Content - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_CONTENT + +$fatpacked{"Pod/POM/Node/For.pm"} = <<'POD_POM_NODE_FOR'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Nodes + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: For.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::For; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS $ERROR ); + + %ATTRIBS = ( format => undef, text => '' ); + + sub new { + my $class = shift; + my $pom = shift; + my $text = shift; + return $class->SUPER::new($pom, split(/\s+/, $text, 2)); + } + + 1; + + =head1 NAME + + Pod::POM::Node::For - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent C<=for> elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_FOR + +$fatpacked{"Pod/POM/Node/Head1.pm"} = <<'POD_POM_NODE_HEAD1'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Head1 + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Head1.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Head1; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $ERROR ); + + %ATTRIBS = ( title => undef ); + @ACCEPT = qw( head2 head3 head4 over begin for text verbatim code ); + + sub new { + my ($class, $pom, $title) = @_; + $title = $pom->parse_sequence($title) + || return $class->error($pom->error()) + if length $title; + return $class->SUPER::new($pom, $title); + } + + 1; + + =head1 NAME + + Pod::POM::Node::Head1 - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent C<=head1> elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_HEAD1 + +$fatpacked{"Pod/POM/Node/Head2.pm"} = <<'POD_POM_NODE_HEAD2'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Head2 + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Head2.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Head2; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $ERROR ); + + %ATTRIBS = ( title => undef ); + @ACCEPT = qw( head3 head4 over begin for text verbatim code ); + + sub new { + my ($class, $pom, $title) = @_; + $title = $pom->parse_sequence($title) + || return $class->error($pom->error()) + if length $title; + return $class->SUPER::new($pom, $title); + } + + 1; + + =head1 NAME + + Pod::POM::Node::Head2 - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent C<=head2> elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_HEAD2 + +$fatpacked{"Pod/POM/Node/Head3.pm"} = <<'POD_POM_NODE_HEAD3'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Head3 + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Head3.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Head3; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $ERROR ); + + %ATTRIBS = ( title => undef ); + @ACCEPT = qw( head4 over begin for text verbatim code ); + + sub new { + my ($class, $pom, $title) = @_; + $title = $pom->parse_sequence($title) + || return $class->error($pom->error()) + if length $title; + return $class->SUPER::new($pom, $title); + } + + 1; + + =head1 NAME + + Pod::POM::Node::Head3 - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent C<=head3> elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_HEAD3 + +$fatpacked{"Pod/POM/Node/Head4.pm"} = <<'POD_POM_NODE_HEAD4'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Head4 + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Head4.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Head4; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $ERROR ); + + %ATTRIBS = ( title => undef ); + @ACCEPT = qw( over begin for text verbatim code ); + + sub new { + my ($class, $pom, $title) = @_; + $title = $pom->parse_sequence($title) + || return $class->error($pom->error()) + if length $title; + return $class->SUPER::new($pom, $title); + } + + 1; + + =head1 NAME + + Pod::POM::Node::Head4 - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent C<=head4> elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_HEAD4 + +$fatpacked{"Pod/POM/Node/Item.pm"} = <<'POD_POM_NODE_ITEM'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Nodes + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Item.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Item; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $ERROR ); + + %ATTRIBS = ( title => '*' ); + @ACCEPT = qw( over begin for text verbatim code ); + + sub new { + my ($class, $pom, $title) = @_; + $title = $pom->parse_sequence($title) + || return $class->error($pom->error()) + if length $title; + return $class->SUPER::new($pom, $title); + } + + 1; + + =head1 NAME + + Pod::POM::Node::Item - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent C<=item> elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_ITEM + +$fatpacked{"Pod/POM/Node/Over.pm"} = <<'POD_POM_NODE_OVER'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Over + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Over.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Over; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS @ACCEPT $EXPECT $ERROR ); + + %ATTRIBS = ( indent => 4 ); + @ACCEPT = qw( over item begin for text verbatim code ); + $EXPECT = 'back'; + + sub list_type { + my $self = shift; + my ($first, @rest) = $self->content; + + my $first_type = $first->type; + return; + } + + + 1; + + =head1 NAME + + Pod::POM::Node::Over - POM '=over' node class + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This class implements '=over' Pod nodes. As described by the L man page =over/=back regions are + used for various kinds of list-like structures (including blockquote paragraphs). + + =item 1. + + ordered list + + =item * + + text paragraph + + unordered list + + =item text + + text paragraph + + definition list + + + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_OVER + +$fatpacked{"Pod/POM/Node/Pod.pm"} = <<'POD_POM_NODE_POD'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Pod + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Pod.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Pod; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( @ACCEPT $ERROR ); + + @ACCEPT = qw( head1 head2 head3 head4 over begin for text verbatim code ); + + 1; + + =head1 NAME + + Pod::POM::Node::Pod - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent C<=pod> elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_POD + +$fatpacked{"Pod/POM/Node/Sequence.pm"} = <<'POD_POM_NODE_SEQUENCE'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Sequence + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Sequence.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Sequence; + + use strict; + + use Pod::POM::Constants qw( :all ); + use parent qw( Pod::POM::Node ); + use vars qw( %NAME ); + + %NAME = ( + C => 'code', + B => 'bold', + I => 'italic', + L => 'link', + S => 'space', + F => 'file', + X => 'index', + Z => 'zero', + E => 'entity', + ); + + sub new { + my ($class, $self) = @_; + local $" = '] ['; + return bless \$self, $class; + } + + sub add { + return IGNORE; + } + + sub present { + my ($self, $view) = @_; + my ($cmd, $method, $result); + $view ||= $Pod::POM::DEFAULT_VIEW; + + $self = $$self; + return $self unless ref $self eq 'ARRAY'; + + my $text = join('', + map { ref $_ ? $_->present($view) + : $view->view_seq_text($_) } + @{ $self->[CONTENT] }); + + if ($cmd = $self->[CMD]) { + my $method = $NAME{ $cmd } || $cmd; + $method = "view_seq_$method"; + return $view->$method($text); + } + else { + return $text; + } + } + + 1; + + =head1 NAME + + Pod::POM::Node::Sequence - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent sequence elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_SEQUENCE + +$fatpacked{"Pod/POM/Node/Text.pm"} = <<'POD_POM_NODE_TEXT'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Text + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Text.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Text; + + use strict; + + use Pod::POM::Constants qw( :all ); + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS $ERROR ); + + %ATTRIBS = ( text => '' ); + + sub new { + my $class = shift; + my $pom = shift; + my $text = shift; + $text = $pom->parse_sequence($text) + || return $class->error($pom->error()) + if length $text && ! $pom->{in_begin}; + return $class->SUPER::new($pom, $text); + } + + sub add { + return IGNORE; + } + + sub present { + my ($self, $view) = @_; + my $text = $self->{ text }; + $view ||= $Pod::POM::DEFAULT_VIEW; + + $text = $text->present($view) + if ref $text; + + return $view->view_textblock($text); + } + + 1; + + =head1 NAME + + Pod::POM::Node::Text - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent text elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_TEXT + +$fatpacked{"Pod/POM/Node/Verbatim.pm"} = <<'POD_POM_NODE_VERBATIM'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Node::Verbatim + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # Andrew Ford + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # Copyright (C) 2009 Andrew Ford. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Verbatim.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Node::Verbatim; + + use strict; + + use parent qw( Pod::POM::Node ); + use vars qw( %ATTRIBS $ERROR ); + + %ATTRIBS = ( text => '' ); + + sub present { + my ($self, $view) = @_; + $view ||= $Pod::POM::DEFAULT_VIEW; + return $view->view_verbatim($self->{ text }); + } + + 1; + + =head1 NAME + + Pod::POM::Node::Verbatim - + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a specialization of the node class to represent verbatim elements. + + =head1 AUTHOR + + Andrew Ford Ea.ford@ford-mason.co.ukE + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + Copyright (C) 2009 Andrew Ford. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a discussion of nodes. +POD_POM_NODE_VERBATIM + +$fatpacked{"Pod/POM/Nodes.pm"} = <<'POD_POM_NODES'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Nodes + # + # DESCRIPTION + # Module implementing specific nodes in a Pod::POM, subclassed from + # Pod::POM::Node. + # + # AUTHOR + # Andy Wardley + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Nodes.pm 76 2009-08-20 20:41:33Z ford $ + # + #======================================================================== + + package Pod::POM::Nodes; + + require 5.004; + require Exporter; + + use strict; + + use Pod::POM::Node::Pod; + use Pod::POM::Node::Head1; + use Pod::POM::Node::Head2; + use Pod::POM::Node::Head3; + use Pod::POM::Node::Head4; + use Pod::POM::Node::Over; + use Pod::POM::Node::Item; + use Pod::POM::Node::Begin; + use Pod::POM::Node::For; + use Pod::POM::Node::Verbatim; + use Pod::POM::Node::Code; + use Pod::POM::Node::Text; + use Pod::POM::Node::Sequence; + use Pod::POM::Node::Content; + + + use vars qw( $VERSION $DEBUG $ERROR @EXPORT_OK @EXPORT_FAIL ); + use base qw( Exporter ); + + $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); + $DEBUG = 0 unless defined $DEBUG; + + 1; + + =head1 NAME + + Pod::POM::Nodes - convenience class to load all node classes + + =head1 SYNOPSIS + + use Pod::POM::Nodes; + + =head1 DESCRIPTION + + This module implements a convenience class that simply uses all of the subclasses of Pod::POM::Node. + (It used to include all the individual classes inline, but the node classes have been factored out + into individual modules.) + + =head1 AUTHOR + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =head1 SEE ALSO + + Consult L for a general overview and examples of use. + +POD_POM_NODES + +$fatpacked{"Pod/POM/Test.pm"} = <<'POD_POM_TEST'; + #============================================================= -*-Perl-*- + # + # Pod::POM::Test + # + # DESCRIPTION + # Module implementing some useful subroutines for testing. + # + # AUTHOR + # Andy Wardley + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Test.pm 14 2009-03-13 08:19:40Z ford $ + # + #======================================================================== + + package Pod::POM::Test; + + require 5.004; + + use strict; + use Pod::POM; + use base qw( Exporter ); + use vars qw( $VERSION @EXPORT ); + + $VERSION = sprintf("%d.%02d", q$Revision: 1.1.1.1 $ =~ /(\d+)\.(\d+)/); + @EXPORT = qw( ntests ok match assert ); + + my $ok_count; + + sub ntests { + my $ntests = shift; + $ok_count = 1; + print "1..$ntests\n"; + } + + sub ok { + my ($ok, $msg) = @_; + if ($ok) { + print "ok ", $ok_count++, "\n"; + } + else { + print "FAILED $ok_count: $msg\n" if defined $msg; + print "not ok ", $ok_count++, "\n"; + } + } + + sub assert { + my ($ok, $err) = @_; + return ok(1) if $ok; + + # failed + my ($pkg, $file, $line) = caller(); + $err ||= "assert failed"; + $err .= " at $file line $line\n"; + ok(0); + die $err; + } + + + sub match { + my ($result, $expect) = @_; + + # force stringification of $result to avoid 'no eq method' overload errors + $result = "$result" if ref $result; + + if ($result eq $expect) { + ok(1); + } + else { + print "FAILED $ok_count:\n expect: [$expect]\n result: [$result]\n"; + ok(0); + } + } + + + 1; +POD_POM_TEST + +$fatpacked{"Pod/POM/View.pm"} = <<'POD_POM_VIEW'; + #============================================================= -*-Perl-*- + # + # Pod::POM::View + # + # DESCRIPTION + # Visitor class for creating a view of all or part of a Pod Object + # Model. + # + # AUTHOR + # Andy Wardley + # + # COPYRIGHT + # Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: View.pm 32 2009-03-17 21:08:25Z ford $ + # + #======================================================================== + + package Pod::POM::View; + + require 5.004; + + use strict; + use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $INSTANCE ); + + $VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/); + $DEBUG = 0 unless defined $DEBUG; + + + #------------------------------------------------------------------------ + # new($pom) + #------------------------------------------------------------------------ + + sub new { + my $class = shift; + my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; + bless { %$args }, $class; + } + + + sub print { + my ($self, $item) = @_; + return UNIVERSAL::can($item, 'present') + ? $item->present($self) : $item; + } + + + sub view { + my ($self, $type, $node) = @_; + return $node; + } + + + sub instance { + my $self = shift; + my $class = ref $self || $self; + + no strict 'refs'; + my $instance = \${"$class\::_instance"}; + + defined $$instance + ? $$instance + : ($$instance = $class->new(@_)); + } + + + sub visit { + my ($self, $place) = @_; + $self = $self->instance() unless ref $self; + my $visit = $self->{ VISIT } ||= [ ]; + push(@$visit, $place); + return $place; + } + + + sub leave { + my ($self, $place) = @_; + $self = $self->instance() unless ref $self; + my $visit = $self->{ VISIT }; + return $self->error('empty VISIT stack') unless @$visit; + pop(@$visit); + } + + + sub visiting { + my ($self, $place) = @_; + $self = $self->instance() unless ref $self; + my $visit = $self->{ VISIT }; + return 0 unless $visit && @$visit; + + foreach (reverse @$visit) { + return 1 if $_ eq $place; + } + return 0; + } + + + sub AUTOLOAD { + my $self = shift; + my $name = $AUTOLOAD; + my $item; + + $name =~ s/.*:://; + return if $name eq 'DESTROY'; + + if ($name =~ s/^view_//) { + return $self->view($name, @_); + } + elsif (! ref $self) { + die "can't access $name in $self\n"; + } + else { + die "no such method for $self: $name ($AUTOLOAD)" + unless defined ($item = $self->{ $name }); + + return wantarray ? ( ref $item eq 'ARRAY' ? @$item : $item ) : $item; + } + } + + + 1; + + =head1 NAME + + Pod::POM::View + + =head1 DESCRIPTION + + Visitor class for creating a view of all or part of a Pod Object Model. + + =head1 METHODS + + =over 4 + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =back + + =head1 AUTHOR + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT AND LICENSE + + Copyright (C) 2000, 2001 Andy Wardley. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =cut +POD_POM_VIEW + +$fatpacked{"Pod/POM/View/HTML.pm"} = <<'POD_POM_VIEW_HTML'; + #============================================================= -*-Perl-*- + # + # Pod::POM::View::HTML + # + # DESCRIPTION + # HTML view of a Pod Object Model. + # + # AUTHOR + # Andy Wardley + # + # COPYRIGHT + # Copyright (C) 2000 Andy Wardley. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: HTML.pm 84 2009-08-20 21:07:00Z ford $ + # + #======================================================================== + + package Pod::POM::View::HTML; + + require 5.004; + + use strict; + use Pod::POM::View; + use parent qw( Pod::POM::View ); + use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD ); + use Text::Wrap; + + $VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/); + $DEBUG = 0 unless defined $DEBUG; + my $HTML_PROTECT = 0; + my @OVER; + + sub new { + my $class = shift; + my $self = $class->SUPER::new(@_) + || return; + + # initalise stack for maintaining info for nested lists + $self->{ OVER } = []; + + return $self; + } + + + sub view { + my ($self, $type, $item) = @_; + + if ($type =~ s/^seq_//) { + return $item; + } + elsif (UNIVERSAL::isa($item, 'HASH')) { + if (defined $item->{ content }) { + return $item->{ content }->present($self); + } + elsif (defined $item->{ text }) { + my $text = $item->{ text }; + return ref $text ? $text->present($self) : $text; + } + else { + return ''; + } + } + elsif (! ref $item) { + return $item; + } + else { + return ''; + } + } + + + sub view_pod { + my ($self, $pod) = @_; + return "\n\n" + . $pod->content->present($self) + . "\n\n"; + } + + + sub view_head1 { + my ($self, $head1) = @_; + my $title = $head1->title->present($self); + return "

$title

\n\n" + . $head1->content->present($self); + } + + + sub view_head2 { + my ($self, $head2) = @_; + my $title = $head2->title->present($self); + return "

$title

\n" + . $head2->content->present($self); + } + + + sub view_head3 { + my ($self, $head3) = @_; + my $title = $head3->title->present($self); + return "

$title

\n" + . $head3->content->present($self); + } + + + sub view_head4 { + my ($self, $head4) = @_; + my $title = $head4->title->present($self); + return "

$title

\n" + . $head4->content->present($self); + } + + + sub view_over { + my ($self, $over) = @_; + my ($start, $end, $strip); + my $items = $over->item(); + + if (@$items) { + + my $first_title = $items->[0]->title(); + + if ($first_title =~ /^\s*\*\s*/) { + # '=item *' =>
    + $start = "
      \n"; + $end = "
    \n"; + $strip = qr/^\s*\*\s*/; + } + elsif ($first_title =~ /^\s*\d+\.?\s*/) { + # '=item 1.' or '=item 1 ' =>
      + $start = "
        \n"; + $end = "
      \n"; + $strip = qr/^\s*\d+\.?\s*/; + } + else { + $start = "
        \n"; + $end = "
      \n"; + $strip = ''; + } + + my $overstack = ref $self ? $self->{ OVER } : \@OVER; + push(@$overstack, $strip); + my $content = $over->content->present($self); + pop(@$overstack); + + return $start + . $content + . $end; + } + else { + return "
      \n" + . $over->content->present($self) + . "
      \n"; + } + } + + + sub view_item { + my ($self, $item) = @_; + + my $over = ref $self ? $self->{ OVER } : \@OVER; + my $title = $item->title(); + my $strip = $over->[-1]; + + if (defined $title) { + $title = $title->present($self) if ref $title; + $title =~ s/$strip// if $strip; + if (length $title) { + my $anchor = $title; + $anchor =~ s/^\s*|\s*$//g; # strip leading and closing spaces + $anchor =~ s/\W/_/g; + $title = qq{$title}; + } + } + + return '
    1. ' + . "$title\n" + . $item->content->present($self) + . "
    2. \n"; + } + + + sub view_for { + my ($self, $for) = @_; + return '' unless $for->format() =~ /\bhtml\b/; + return $for->text() + . "\n\n"; + } + + + sub view_begin { + my ($self, $begin) = @_; + return '' unless $begin->format() =~ /\bhtml\b/; + $HTML_PROTECT++; + my $output = $begin->content->present($self); + $HTML_PROTECT--; + return $output; + } + + + sub view_textblock { + my ($self, $text) = @_; + return $HTML_PROTECT ? "$text\n" : "

      $text

      \n"; + } + + + sub view_verbatim { + my ($self, $text) = @_; + for ($text) { + s/&/&/g; + s//>/g; + } + return "
      $text
      \n\n"; + } + + + sub view_seq_bold { + my ($self, $text) = @_; + return "$text"; + } + + + sub view_seq_italic { + my ($self, $text) = @_; + return "$text"; + } + + + sub view_seq_code { + my ($self, $text) = @_; + return "$text"; + } + + sub view_seq_file { + my ($self, $text) = @_; + return "$text"; + } + + sub view_seq_space { + my ($self, $text) = @_; + $text =~ s/\s/ /g; + return $text; + } + + + sub view_seq_entity { + my ($self, $entity) = @_; + return "&$entity;" + } + + + sub view_seq_index { + return ''; + } + + + sub view_seq_link { + my ($self, $link) = @_; + + # view_seq_text has already taken care of L + if ($link =~ /^view_seq_link_transform_path($page); + } + + # append the #section if exists + $url .= "#$section" if defined $url and + defined $section and length $section; + + return make_href($url, $linktext); + } + + + # should be sub-classed if extra transformations are needed + # + # for example a sub-class may search for the given page and return a + # relative path to it. + # + # META: where this functionality should be documented? This module + # doesn't have docs section + # + sub view_seq_link_transform_path { + my($self, $page) = @_; + + # right now the default transform doesn't check whether the link + # is not dead (i.e. whether there is a corresponding file. + # therefore we don't link L<>'s other than L + # subclass to change the default (and of course add validation) + + # this is the minimal transformation that will be required if enabled + # $page = "$page.html"; + # $page =~ s|::|/|g; + #print "page $page\n"; + return undef; + } + + + sub make_href { + my($url, $title) = @_; + + if (!defined $url) { + return defined $title ? "$title" : ''; + } + + $title = $url unless defined $title; + #print "$url, $title\n"; + return qq{$title}; + } + + + + + # this code has been borrowed from Pod::Html + my $urls = '(' . join ('|', + qw{ + http + telnet + mailto + news + gopher + file + wais + ftp + } ) . ')'; + my $ltrs = '\w'; + my $gunk = '/#~:.?+=&%@!\-'; + my $punc = '.:!?\-;'; + my $any = "${ltrs}${gunk}${punc}"; + + sub view_seq_text { + my ($self, $text) = @_; + + unless ($HTML_PROTECT) { + for ($text) { + s/&/&/g; + s//>/g; + } + } + + $text =~ s{ + \b # start at word boundary + ( # begin $1 { + $urls : # need resource and a colon + (?!:) # Ignore File::, among others. + [$any] +? # followed by one or more of any valid + # character, but be conservative and + # take only what you need to.... + ) # end $1 } + (?= # look-ahead non-consumptive assertion + [$punc]* # either 0 or more punctuation followed + (?: # followed + [^$any] # by a non-url char + | # or + $ # end of the string + ) # + | # or else + $ # then end of the string + ) + }{$1}igox; + + return $text; + } + + sub encode { + my($self,$text) = @_; + require Encode; + return Encode::encode("ascii",$text,Encode::FB_XMLCREF()); + } + + 1; + + =head1 NAME + + Pod::POM::View::HTML + + =head1 DESCRIPTION + + HTML view of a Pod Object Model. + + =head1 METHODS + + =over 4 + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + Returns the text of a CE> sequence enclosed in a Cb> element. + + =item C + + Returns the text of a CE> sequence enclosed in a Ci> element. + + =item C + + Returns the text of a CE> sequence enclosed in a Ccode> element. + + =item C + + =item C + + =item C + + Returns an empty string. Index sequences are suppressed in HTML view. + + =item C + + =back + + =head1 AUTHOR + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT AND LICENSE + + Copyright (C) 2000 Andy Wardley. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =cut +POD_POM_VIEW_HTML + +$fatpacked{"Pod/POM/View/Pod.pm"} = <<'POD_POM_VIEW_POD'; + #============================================================= -*-Perl-*- + # + # Pod::POM::View::Pod + # + # DESCRIPTION + # Pod view of a Pod Object Model. + # + # AUTHOR + # Andy Wardley + # + # COPYRIGHT + # Copyright (C) 2000 Andy Wardley. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Pod.pm 77 2009-08-20 20:44:14Z ford $ + # + #======================================================================== + + package Pod::POM::View::Pod; + + require 5.004; + + use strict; + use Pod::POM::Nodes; + use Pod::POM::View; + use parent qw( Pod::POM::View ); + use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $MARKUP ); + + $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); + $DEBUG = 0 unless defined $DEBUG; + + # create reverse lookup table mapping method name to original sequence + $MARKUP = { + map { ( $Pod::POM::Node::Sequence::NAME{ $_ } => $_ ) } + keys %Pod::POM::Node::Sequence::NAME, + }; + + + sub view { + my ($self, $type, $item) = @_; + + # my ($pkg, $file, $line) = caller; + # print STDERR "called view ($type) from $file line $line\n"; + + if ($type =~ s/^seq_//) { + if ($type eq 'text') { + return "$item"; + } + if ($type = $MARKUP->{ $type }) { + if ($item =~ /[<>]/) { + return "$type<< $item >>"; + } + else { + return "$type<$item>"; + } + } + } + elsif (ref $item eq 'HASH') { + if (defined $item->{ content }) { + return $item->{ content }->present($self); + } + elsif (defined $item->{ text }) { + my $text = $item->{ text }; + return ref $text ? $text->present($self) : $text; + } + else { + return ''; + } + } + elsif (! ref $item) { + return $item; + } + else { + return ''; + } + } + + + sub view_pod { + my ($self, $pod) = @_; + # return "=pod\n\n" . $pod->content->present($self) . "=cut\n\n"; + return $pod->content->present($self); + } + + + sub view_head1 { + my ($self, $head1) = @_; + return '=head1 ' + . $head1->title->present($self) + . "\n\n" + . $head1->content->present($self); + } + + + sub view_head2 { + my ($self, $head2) = @_; + return '=head2 ' + . $head2->title->present($self) + . "\n\n" + . $head2->content->present($self); + } + + + sub view_head3 { + my ($self, $head3) = @_; + return '=head3 ' + . $head3->title->present($self) + . "\n\n" + . $head3->content->present($self); + } + + + sub view_head4 { + my ($self, $head4) = @_; + return '=head4 ' + . $head4->title->present($self) + . "\n\n" + . $head4->content->present($self); + } + + + sub view_over { + my ($self, $over) = @_; + return '=over ' + . $over->indent() + . "\n\n" + . $over->content->present($self) + . "=back\n\n"; + } + + + sub view_item { + my ($self, $item) = @_; + + my $title = $item->title(); + $title = $title->present($self) if ref $title; + return "=item $title\n\n" + . $item->content->present($self); + } + + + sub view_for { + my ($self, $for) = @_; + return '=for ' + . $for->format . ' ' + . $for->text() + . "\n\n" + . $for->content->present($self); + } + + + sub view_begin { + my ($self, $begin) = @_; + return '=begin ' + . $begin->format() + . "\n\n" + . $begin->content->present($self) + . "=end " + . $begin->format() + . "\n\n"; + } + + + sub view_textblock { + my ($self, $text) = @_; + return "$text\n\n"; + } + + + sub view_verbatim { + my ($self, $text) = @_; + return "$text\n\n"; + } + + + sub view_meta { + my ($self, $meta) = @_; + return '=meta ' + . $meta->name() + . "\n\n" + . $meta->content->present($self) + . "=end\n\n"; + } + + + 1; + + =head1 NAME + + Pod::POM::View::Pod + + =head1 DESCRIPTION + + Pod view of a Pod Object Model. + + =head1 METHODS + + =over 4 + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =item C + + =back + + =head1 AUTHOR + + Andy Wardley Eabw@kfs.orgE + + =head1 COPYRIGHT AND LICENSE + + Copyright (C) 2000 Andy Wardley. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =cut +POD_POM_VIEW_POD + +$fatpacked{"Pod/POM/View/Restructured.pm"} = <<'POD_POM_VIEW_RESTRUCTURED'; + # Original authors: don + # $Revision: 1595 $ + + # Copyright (c) 2010 Don Owens . All rights reserved. + # + # This is free software; you can redistribute it and/or modify it under + # the Perl Artistic license. You should have received a copy of the + # Artistic license with this distribution, in the file named + # "Artistic". You may also obtain a copy from + # http://regexguy.com/license/Artistic + # + # 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. + + + =pod + + =head1 NAME + + Pod::POM::View::Restructured - View for Pod::POM that outputs reStructuredText + + =head1 SYNOPSIS + + use Pod::POM::View::Restructured; + + my $view = Pod::POM::View::Restructured->new; + my $parser = Pod::POM->new; + my $pom = $parser->parse_file("$top_dir/lib/Pod/POM/View/Restructured.pm"); + my $out = $pom->present($view); + + + =head1 DESCRIPTION + + This module outputs reStructuredText that is expected to be used + with Sphinx. Verbatim sections (indented paragraphs) in the POD + will be output with syntax hilighting for Perl code by default. + See L for how + to change this for a particular block. + + For a list of changes in recent versions, see the documentation + for L. + + This module can be downloaded from L. + + =cut + + use strict; + use warnings; + use Data::Dumper (); + + use Pod::POM; + + package Pod::POM::View::Restructured; + + our $VERSION = '0.02'; # change in POD below! + + use base 'Pod::POM::View::Text'; + + =pod + + =head1 METHODS + + =head2 C + + Constructor. \%params is optional. If present, the following keys are valid: + + =over 4 + + =item C + + See documentation below for C. + + =back + + =cut + + sub new { + my ($class, $params) = @_; + $params = { } unless $params and UNIVERSAL::isa($params, 'HASH'); + + my $self = bless { seen_something => 0, title_set => 0, params => { } }, ref($class) || $class; + + my $callbacks = $params->{callbacks}; + $callbacks = { } unless $callbacks; + $self->{callbacks} = $callbacks; + + return $self; + } + + =pod + + =head2 C + + Converts the POD in C<$source_file> to reStructuredText. If + C<$dest_file> is defined, it writes the output there. If + C<$title> is defined, it is used for the title of the document. + Otherwise, an attempt is made to infer the title from the NAME + section (checks if the body looks like C). + + Returns the output as a string. + + C<$source_file> and C<$dest_file> can be either file names or file + handles. + + =cut + sub convert_file { + my ($self, $source_file, $title, $dest_file, $callbacks) = @_; + + my $cb; + if ($callbacks) { + $cb = { %{ $self->{callbacks} }, %$callbacks }; + } + else { + $cb = $self->{callbacks}; + } + + my $view = Pod::POM::View::Restructured->new({ callbacks => $cb }); + my $parser = Pod::POM->new; + + unless (-r $source_file) { + warn "can't read source file $source_file"; + return undef; + } + + my $pom = $parser->parse_file($source_file); + + $view->{title_set} = 1 if defined($title); + my $out = $pom->present($view); + + if (defined($title)) { + $out = $self->_build_header($title, '#', 1) . "\n" . $out; + } + else { + $title = $view->{title}; + } + + if (defined($dest_file) and $dest_file ne '') { + my $out_fh; + if (UNIVERSAL::isa($dest_file, 'GLOB')) { + $out_fh = $dest_file; + } + else { + unless (open($out_fh, '>', $dest_file)) { + warn "couldn't open output file $dest_file"; + return undef; + } + } + + print $out_fh $out; + close $out_fh; + } + + my $rv = { content => $out, title => $title }; + + return $rv; + } + + =pod + + =head2 C + + Converts the files given in C<$file_spec> to reStructuredText. + If C<$index_file> is provided, it is the path to the index file + to be created (with a table of contents pointing to all of the + files created). If C<$index_title> is provided, it is used as + the section title for the index file. C<$out_dir> is the + directory the generated files will be written to. + + C<$file_spec> is a reference to an array of hashes specifying + attributes for each file to be converted. The valid keys are: + + =over 4 + + =item C + + File to convert. + + =item C + + File to output the reStructuredText. If not provided, a file + name will be generated based on the title. + + =item C + + Section title for the generated reStructuredText. If not + provided, an attempt will be made to infer the title from the + NAME section in the POD, if it exists. As a last resort, a title + will be generated that looks like "section_(\d+)". + + =item C<callbacks> + + A reference to a hash containing names and the corresponding callbacks. + + Currently the only valid callback is C<link>. It is given the + text inside a LE<lt>E<gt> section from the POD, and is expected to return a + tuple C<($url, $label)>. If the value returned for C<$label> is + undefined, the value of C<$url> is used as the label. + + =item C<no_toc> + + Causes the item to not be printed to the index or return in the C<toc> field. + + =back + + This method returns a hash ref with a table of contents (the + C<toc> field) suitable for a reStructuredText table of contents. + + E.g., + + my $conv = Pod::POM::View::Restructured->new; + + my $files = [ + { source_file => "$base_dir/Restructured.pm" }, + { source_file => "$base_dir/DWIW.pm" }, + { source_file => "$base_dir/Wrapper.pm" }, + ]; + + + my $rv = $conv->convert_files($files, "$dest_dir/index.rst", 'My Big Test', $dest_dir); + + + =cut + sub convert_files { + my ($self, $file_spec, $index_file, $index_title, $out_dir) = @_; + + my $index_fh = $self->_get_file_handle($index_file, '>'); + + if ($index_fh and defined($index_title) and $index_title ne '') { + my $header = $self->_build_header($index_title, '#', 1); + # my $line = '#' x length($index_title); + # my $header = $line . "\n" . $index_title . "\n" . $line . "\n\n"; + + print $index_fh $header; + + print $index_fh "\nContents:\n\n"; + print $index_fh ".. toctree::\n"; + print $index_fh " :maxdepth: 1\n\n"; + } + + my $count = 0; + my $toc = ''; + foreach my $spec (@$file_spec) { + $count++; + my $data = $self->convert_file($spec->{source_file}, $spec->{title}, + $spec->{dest_file}, $spec->{callbacks}); + + my $this_title = $data->{title}; + # print STDERR Data::Dumper->Dump([ $this_title ], [ 'this_title' ]) . "\n\n"; + + unless (defined($this_title) and $this_title !~ /\A\s*\Z/) { + $this_title = 'section_' . $count; + } + + my $name = $spec->{dest_file}; + if (defined($name)) { + $name =~ s/\.rst\Z//; + } + else { + ($name = $this_title) =~ s/\W/_/g; + my $dest_file = $out_dir . '/' . $name . '.rst'; + my $out_fh; + + unless (open($out_fh, '>', $dest_file)) { + warn "couldn't open output file $dest_file"; + return undef; + } + + print $out_fh $data->{content}; + close $out_fh; + } + + unless ($spec->{no_toc}) { + $toc .= ' ' . $name . "\n"; + } + + if ($index_fh and not $spec->{no_toc}) { + print $index_fh " " . $name . "\n"; + } + } + + if ($index_fh) { + print $index_fh "\n"; + } + + return { toc => $toc }; + } + + sub _get_file_handle { + my ($self, $file, $mode) = @_; + + return undef unless defined $file; + + if (ref($file) and UNIVERSAL::isa($file, 'GLOB')) { + return $file; + } + + $mode = '<' unless $mode; + + my $fh; + if ($file ne '') { + unless (open($fh, $mode, $file)) { + warn "couldn't open input file $file: $!"; + return undef; + } + } + + return $fh; + } + + sub view_pod { + my ($self, $node) = @_; + + my $content = ".. highlight:: perl\n\n"; + + return $content . $node->content()->present($self); + } + + sub _generic_head { + my ($self, $node, $marker, $do_overline) = @_; + + return scalar($self->_generic_head_multi($node, $marker, $do_overline)); + } + + sub _generic_head_multi { + my ($self, $node, $marker, $do_overline) = @_; + + my $title = $node->title()->present($self); + my $content = $node->content()->present($self); + + $title = ' ' if $title eq ''; + # my $section_line = $marker x length($title); + + my $section = $self->_build_header($title, $marker, $do_overline) . "\n" . $content; + + # my $section = $title . "\n" . $section_line . "\n\n" . $content; + # if ($do_overline) { + # $section = $section_line . "\n" . $section; + # } + + $section .= "\n"; + + return wantarray ? ($section, $content, $title) : $section; + } + + sub _build_header { + my ($self, $text, $marker, $do_overline) = @_; + + my $line = $marker x length($text); + my $header = $text . "\n" . $line . "\n"; + + if ($do_overline) { + $header = $line . "\n" . $header; + } + + return "\n" . $header; + } + + sub _do_indent { + my ($self, $text, $indent_amount, $dbg) = @_; + + my $indent = ' ' x $indent_amount; + + # $indent = "'$dbg" . $indent . "'"; + + my @lines = split /\n/, $text, -1; + foreach my $line (@lines) { + $line = $indent . $line; + } + + return join("\n", @lines); + } + + sub view_head1 { + my ($self, $node) = @_; + + my ($section, $content, $title) = $self->_generic_head_multi($node, '*', 1); + + unless ($self->{seen_something} or $self->{title_set}) { + if ($title eq 'NAME') { + $self->{seen_something} = 1; + + if ($content =~ /\A\s*(\w+(?:::\w+)+)\s+-\s+/s) { + my $mod_name = $1; + $self->{module_name} = $mod_name; + $self->{title} = $mod_name; + $self->{title_set} = 1; + + $section = $self->_build_header($mod_name, '#', 1) . $section; + + # my $line = '#' x length($mod_name); + # $section = $line . "\n" . $mod_name . "\n" . $line . "\n\n" . $section; + } + + return $section; + } + } + + $self->{seen_something} = 1; + return $section; + } + + sub view_head2 { + my ($self, $node) = @_; + + $self->{seen_something} = 1; + return $self->_generic_head($node, '='); + } + + sub view_head3 { + my ($self, $node) = @_; + + $self->{seen_something} = 1; + return $self->_generic_head($node, '-'); + } + + sub view_head4 { + my ($self, $node) = @_; + + $self->{seen_something} = 1; + return $self->_generic_head($node, '^'); + } + + sub view_item { + my ($self, $node) = @_; + + $self->{seen_something} = 1; + + my $title = $node->title()->present($self); + my $content = $node->content()->present($self); + + $title =~ s/\A\s+//; + $title =~ s/\n/ /; + # $content =~ s/\n/\n /g; + # $content = ' ' . $content; + + $self->{view_item_count}++; + $content = $self->_do_indent($content, 1, "[[view_item_$self->{view_item_count}]]"); + + return "\n" . $title . "\n" . $content . "\n\n"; + } + + sub view_over { + my ($self, $node) = @_; + + my $content = $node->content()->present($self); + # my $indent = $node->indent(); + + return "\n" . $content; + } + + sub view_text { + my ($self, $node) = @_; + + my @lines = split /\n/, $node; + foreach my $line (@lines) { + $line =~ s/\A\s+//; + } + + return join("\n", @lines); + } + + sub view_textblock { + my ($self, $text) = @_; + + return "\n" . $text . "\n"; + } + + + sub view_verbatim { + my ($self, $node) = @_; + + # (my $node_part = ' ' . $node) =~ s/\n/\n /g; + my $node_part = $self->_do_indent($node . '', 1, '[[view_verbatim]]'); + + my $block_part = ".. code-block:: perl\n\n"; + if (defined($self->{next_code_block})) { + my $lang = $self->{next_code_block}; + delete $self->{next_code_block}; + + if ($lang eq 'none') { + # FIXME: need to output a preformatted paragraph here, but no highlighting + $block_part = ''; + } + else { + $block_part = ".. code-block:: $lang\n\n"; + } + } + + my $content = $block_part . $node_part; + + return "\n\n" . $content . "\n\n"; + } + + sub view_for { + my ($self, $node) = @_; + + my $fmt = $node->format(); + + # print STDERR "got for: fmt='$fmt', text='" . $node->text() . "'\n"; + + if ($fmt eq 'pod2rst') { + my $text = $node->text(); + if ($text =~ /\A\s*next-code-block\s*:\s*(\S+)/) { + my $lang = $1; + $self->{next_code_block} = $lang; + return ''; + } + + return ''; + } + + return $self->SUPER::view_for($node); + } + + sub view_seq_code { + my ($self, $text) = @_; + + return '\ ``' . $text . '``\ '; + } + + sub view_seq_bold { + my ($self, $text) = @_; + + $text =~ s/\*/\\*/g; + $text =~ s/\`/\\`/g; + + return '\ **' . $text . '**\ '; + } + + sub view_seq_italic { + my ($self, $text) = @_; + + $text =~ s/\*/\\*/g; + $text =~ s/\`/\\`/g; + + return '\ *' . $text . '*\ '; + } + + sub view_seq_file { + my ($self, $text) = @_; + + $text =~ s/\*/\\*/g; + $text =~ s/\`/\\`/g; + + return '\ *' . $text . '*\ '; + } + + sub view_seq_text { + my ($self, $node) = @_; + + my $text = $node . ''; + + $text =~ s/\*/\\*/g; + $text =~ s/\`/\\`/g; + + return $text; + } + + sub view_seq_zero { + return ''; + } + + sub view_seq_link { + my ($self, $text) = @_; + + # FIXME: determine if has label, if manpage, etc., and pass that info along to the callback, + # instead of just the text, e.g., + # $link_cb->($label, $name, $sec, $url); + my $link_cb = $self->{callbacks}{link}; + if ($link_cb) { + my ($url, $label) = $link_cb->($text); + + if (defined($url)) { + if ($url eq '' and defined($label) and $label ne '') { + $text = $label; + } + elsif (defined($label) and $label ne '') { + $text = qq{`$label <$url>`_}; + } + else { + $text = qq{`$url <$url>`_}; + } + + return $text; + } + } + + if ($text =~ m{\A/(.+)}) { + (my $section = $1) =~ s/\A"(.+)"/$1/; + $text = qq{`$section`_}; + } + elsif ($text =~ m{\Ahttps?://}) { + $text = qq{`$text <$text>`_}; + } + elsif ($text =~ /::/) { + my $label = $text; + my $module = $text; + if ($text =~ /\A(.+?)\|(.+::.+)/) { + $label = $1; + $module = $2; + } + + $module = $self->_url_encode($module); + my $url = "http://search.cpan.org/search?query=$module&mode=module"; + $text = qq{`$label <$url>`_}; + } + + return $text; + } + + sub _url_encode { + my ($self, $str) = @_; + + use bytes; + $str =~ s{([^A-Za-z0-9_])}{sprintf("%%%02x", ord($1))}eg; + return $str; + } + + + =pod + + =head1 POD commands specifically for reStructuredText + + The following sequences can be used in POD to request actions specifically for this module. + + =head2 =Z<>for pod2rst next-code-block: I<lang> + + This sets up the next verbatim section, i.e., the next indented + paragraph to be hilighted according to the syntax of the + programming/markup/config language I<lang>. Verbatim sections + are assumed to be Perl code by default. Sphinx uses Pygments to + do syntax hilighting in these sections, so you can use any value + for I<lang> that Pygments supports, e.g., Python, C, C++, + Javascript, SQL, etc. + + =head1 EXAMPLES + + =over 4 + + =item Converting a single file using C<pod2rst> + + =for pod2rst next-code-block: bash + + pod2rst --infile=Restructured.pm --outfile=restructured.rst + + =back + + B<Need to document:> + + =over 4 + + =item B<Document example of setting up sphinx build, generating rst from pod, and building> + + =back + + + =head1 TODO + + =over 4 + + =item code hilighting + + Currently, a verbatim block (indented paragraph) gets output as a + Perl code block by default in reStructuredText. There should be + an option (e.g., in the constructor) to change the language for + hilighting purposes (for all verbatim blocks), or disable syntax + hilighting and just make it a preformatted paragraph. There is a + way to do this in POD (see L</"POD commands specifically for reStructuredText">), + but there should also be an option in the constructor. + + =item improve escaping + + Text blocks are not escaped properly, so it is currently possible + to invoke a command in reStructuredText by accident. + + =back + + =head1 DEPENDENCIES + + Inherits from L<Pod::POM::View::Text> that comes with the Pod::POM distribution. + + =head1 AUTHOR + + Don Owens <don@regexguy.com> + + =head1 LICENSE AND COPYRIGHT + + Copyright (c) 2010 Don Owens <don@regexguy.com>. All rights reserved. + + This is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. See perlartistic. + + 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 SEE ALSO + + L<Pod::POM> + + L<Pod::POM::View::HTML> + + L<pod2rst> (distributed with Pod::POM::View::HTML) + + reStructuredText: L<http://docutils.sourceforge.net/rst.html> + + Sphinx (uses reStructuredText): L<http://sphinx.pocoo.org/> + + Pygments (used by Sphinx for syntax highlighting): L<http://pygments.org/> + + =head1 VERSION + + 0.02 + + =cut + + 1; + + # Local Variables: # + # mode: perl # + # tab-width: 4 # + # indent-tabs-mode: nil # + # cperl-indent-level: 4 # + # perl-indent-level: 4 # + # End: # + # vim:set ai si et sta ts=4 sw=4 sts=4: +POD_POM_VIEW_RESTRUCTURED + +$fatpacked{"Pod/POM/View/Restructured/Changes.pm"} = <<'POD_POM_VIEW_RESTRUCTURED_CHANGES'; + # Original authors: don + # $Revision: $ + + + =pod + + =head1 NAME + + Pod::POM::View::Restructured::Changes - List of major changes in Pod::POM::View::Restructured + + =head1 CHANGES + + =head2 Version 0.02 + + =over 4 + + =item Added documentation for changes. + + =item Added C<callbacks> option. + + =item Added C<no_toc> option. + + =item Fixed bug encountered when no index is being output. + + =item Fixed section links. + + =back + + + =head2 Version 0.01 + + =over 4 + + =item Initial release. + + =back + + + + + =cut + + 1; +POD_POM_VIEW_RESTRUCTURED_CHANGES + +$fatpacked{"Pod/POM/View/Text.pm"} = <<'POD_POM_VIEW_TEXT'; + #============================================================= -*-Perl-*- + # + # Pod::POM::View::Text + # + # DESCRIPTION + # Text view of a Pod Object Model. + # + # AUTHOR + # Andy Wardley <abw@kfs.org> + # + # COPYRIGHT + # Copyright (C) 2000 Andy Wardley. All Rights Reserved. + # + # This module is free software; you can redistribute it and/or + # modify it under the same terms as Perl itself. + # + # REVISION + # $Id: Text.pm 77 2009-08-20 20:44:14Z ford $ + # + #======================================================================== + + package Pod::POM::View::Text; + + require 5.004; + + use strict; + use Pod::POM::View; + use parent qw( Pod::POM::View ); + use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD $INDENT ); + use Text::Wrap; + + $VERSION = sprintf("%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/); + $DEBUG = 0 unless defined $DEBUG; + $INDENT = 0; + + + sub new { + my $class = shift; + my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; + bless { + INDENT => 0, + %$args, + }, $class; + } + + + sub view { + my ($self, $type, $item) = @_; + + if ($type =~ s/^seq_//) { + return $item; + } + elsif (UNIVERSAL::isa($item, 'HASH')) { + if (defined $item->{ content }) { + return $item->{ content }->present($self); + } + elsif (defined $item->{ text }) { + my $text = $item->{ text }; + return ref $text ? $text->present($self) : $text; + } + else { + return ''; + } + } + elsif (! ref $item) { + return $item; + } + else { + return ''; + } + } + + + sub view_head1 { + my ($self, $head1) = @_; + my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; + my $pad = ' ' x $$indent; + local $Text::Wrap::unexpand = 0; + my $title = wrap($pad, $pad, + $head1->title->present($self)); + + $$indent += 4; + my $output = "$title\n" . $head1->content->present($self); + $$indent -= 4; + + return $output; + } + + + sub view_head2 { + my ($self, $head2) = @_; + my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; + my $pad = ' ' x $$indent; + local $Text::Wrap::unexpand = 0; + my $title = wrap($pad, $pad, + $head2->title->present($self)); + + $$indent += 4; + my $output = "$title\n" . $head2->content->present($self); + $$indent -= 4; + + return $output; + } + + + sub view_head3 { + my ($self, $head3) = @_; + my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; + my $pad = ' ' x $$indent; + local $Text::Wrap::unexpand = 0; + my $title = wrap($pad, $pad, + $head3->title->present($self)); + + $$indent += 4; + my $output = "$title\n" . $head3->content->present($self); + $$indent -= 4; + + return $output; + } + + + sub view_head4 { + my ($self, $head4) = @_; + my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; + my $pad = ' ' x $$indent; + local $Text::Wrap::unexpand = 0; + my $title = wrap($pad, $pad, + $head4->title->present($self)); + + $$indent += 4; + my $output = "$title\n" . $head4->content->present($self); + $$indent -= 4; + + return $output; + } + + + #------------------------------------------------------------------------ + # view_over($self, $over) + # + # Present an =over block - this is a blockquote if there are no =items + # within the block. + #------------------------------------------------------------------------ + + sub view_over { + my ($self, $over) = @_; + + if (@{$over->item}) { + return $over->content->present($self); + } + else { + my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; + my $pad = ' ' x $$indent; + $$indent += 4; + my $content = $over->content->present($self); + $$indent -= 4; + + return $content; + } + } + + sub view_item { + my ($self, $item) = @_; + my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; + my $pad = ' ' x $$indent; + local $Text::Wrap::unexpand = 0; + my $title = wrap($pad . '* ', $pad . ' ', + $item->title->present($self)); + + $$indent += 2; + my $content = $item->content->present($self); + $$indent -= 2; + + return "$title\n\n$content"; + } + + + sub view_for { + my ($self, $for) = @_; + return '' unless $for->format() =~ /\btext\b/; + return $for->text() + . "\n\n"; + } + + + sub view_begin { + my ($self, $begin) = @_; + return '' unless $begin->format() =~ /\btext\b/; + return $begin->content->present($self); + } + + + sub view_textblock { + my ($self, $text) = @_; + my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; + $text =~ s/\s+/ /mg; + + $$indent ||= 0; + my $pad = ' ' x $$indent; + local $Text::Wrap::unexpand = 0; + return wrap($pad, $pad, $text) . "\n\n"; + } + + + sub view_verbatim { + my ($self, $text) = @_; + my $indent = ref $self ? \$self->{ INDENT } : \$INDENT; + my $pad = ' ' x $$indent; + $text =~ s/^/$pad/mg; + return "$text\n\n"; + } + + + sub view_seq_bold { + my ($self, $text) = @_; + return "*$text*"; + } + + + sub view_seq_italic { + my ($self, $text) = @_; + return "_${text}_"; + } + + + sub view_seq_code { + my ($self, $text) = @_; + return "'$text'"; + } + + + sub view_seq_file { + my ($self, $text) = @_; + return "_${text}_"; + } + + my $entities = { + gt => '>', + lt => '<', + amp => '&', + quot => '"', + }; + + + sub view_seq_entity { + my ($self, $entity) = @_; + return $entities->{ $entity } || $entity; + } + + sub view_seq_index { + return ''; + } + + sub view_seq_link { + my ($self, $link) = @_; + if ($link =~ s/^.*?\|//) { + return $link; + } + else { + return "the $link manpage"; + } + } + + + + 1; + + =head1 NAME + + Pod::POM::View::Text + + =head1 DESCRIPTION + + Text view of a Pod Object Model. + + =head1 METHODS + + =over 4 + + =item C<view($self, $type, $item)> + + =item C<view_pod($self, $pod)> + + =item C<view_head1($self, $head1)> + + =item C<view_head2($self, $head2)> + + =item C<view_head3($self, $head3)> + + =item C<view_head4($self, $head4)> + + =item C<view_over($self, $over)> + + =item C<view_item($self, $item)> + + =item C<view_for($self, $for)> + + =item C<view_begin($self, $begin)> + + =item C<view_textblock($self, $textblock)> + + =item C<view_verbatim($self, $verbatim)> + + =item C<view_meta($self, $meta)> + + =item C<view_seq_bold($self, $text)> + + Returns the text of a C<BE<lt>E<gt>> sequence in 'bold' (i.e. surrounded by asterisks, like *this*). + + =item C<view_seq_italic($self, $text)> + + Returns the text of a C<IE<lt>E<gt>> sequence in 'italics' (i.e. surrounded by underscores, like _this_). + + =item C<view_seq_code($self, $text)> + + =item C<view_seq_file($self, $text)> + + =item C<view_seq_entity($self, $text)> + + =item C<view_seq_index($self, $text)> + + Returns an empty string. Index sequences are suppressed in text view. + + =item C<view_seq_link($self, $text)> + + =back + + =head1 AUTHOR + + Andy Wardley E<lt>abw@kfs.orgE<gt> + + =head1 COPYRIGHT AND LICENSE + + Copyright (C) 2000 Andy Wardley. All Rights Reserved. + + This module is free software; you can redistribute it and/or + modify it under the same terms as Perl itself. + + =cut +POD_POM_VIEW_TEXT + +s/^ //mg for values %fatpacked; + +unshift @INC, sub { + if (my $fat = $fatpacked{$_[1]}) { + if ($] < 5.008) { + return sub { + return 0 unless length $fat; + $fat =~ s/^([^\n]*\n?)//; + $_ = $1; + return 1; + }; + } + open my $fh, '<', \$fat + or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; + return $fh; + } + return +}; + +} # END OF FATPACK CODE +#!/usr/bin/env perl +use 5.010; # for \K +use strict; +use warnings; +use English qw(-no_match_vars); + +use IO::File; + +use File::Basename qw(basename); +use Pod::POM::View::Restructured; + +my $input_file = shift @ARGV or die "Need an input file"; + +my $tool = basename($input_file); + +open my $in_fh, q{<:encoding(UTF-8)}, $input_file + or die "Cannot open $input_file: $!"; + +open my $out_fh, q{>}, \my $out; + +my $conv = Pod::POM::View::Restructured->new(); +my $output = $conv->convert_file($in_fh, undef, $out_fh, { link => \&format_links }); + +close $in_fh; +close $out_fh; + +if (!defined($output)) { + die "Failed to convert!"; +} + +my $header = + ".. program:: $tool\n\n" . + ('=' x (length($tool) + 11)) . "\n" . + ":program:`$tool`\n" . + ('=' x (length($tool) + 11)) . "\n\n"; + +open my $in, q{<:encoding(UTF-8)}, \$out; + +local $INPUT_RECORD_SEPARATOR = ''; + +my $in_code_block = 0; +my $section = ''; + +my $fixed_output = ''; + +while (my $para = <$in>) { + next if $para =~ m/^\.\. highlight:: perl/; + + $in_code_block = $para =~ m/^\s{2,}/ ? 1 : 0; + + if ($para =~ m/^\*{2,}\n([\w\s,-]+)\n\*{2,}$/m) { + $fixed_output .= "$1\n" . + ('=' x length $1) . + "\n\n"; + $section = $1; + } + elsif ($para =~ m/^Usage: /) { + $para =~ s/^Usage: //; + $fixed_output .= "Usage\n" . + "-----\n\n" . + "::\n\n" . + " $para"; + } + elsif ($para =~ m/^Examples:/) { + $fixed_output .= "Examples\n" . + "--------\n\n"; + } + else { + $para =~ s/\.\. code-block:: perl/.. code-block:: bash/mg; + $para =~ s/`+$tool`+/$tool/g; + $para =~ s/([^\/])$tool/$1:program:`$tool`/g unless $in_code_block; + $para =~ s/^$tool/:program:`$tool`/gm; + $para =~ s/^--(\S+)$/.. option:: --$1/mg; + $para =~ s/"--(\S+)"/:option:`--$1`/g; + $para =~ s/\\\*/*/g; + $para =~ s/\\ //g; + $para =~ s/^[ ]+$//mg; + $para =~ s/^\n\n/\n/mg; + $para =~ s/code-block:: bash(\s+)CREATE/code-block:: sql$1CREATE/sg; + if ( ($section || '') eq 'OUTPUT' ) { + $para =~ s/^([A-Z_]+)\n\n/$1\n/; + } + $fixed_output .= $para; + } +} + +close $in; + +print $header . $fixed_output; + +sub format_links { + if ( my ($label, $url) = split /\|/, $_[0] ) { + return $url, $label; + } + else { + local $conv->{callbacks}{link}; + return $conv->view_seq_link(@_) + } +} \ No newline at end of file