Pod-Abstract-0.26/0000755000175000017500000000000015104342270012344 5ustar benlbenlPod-Abstract-0.26/bin/0000755000175000017500000000000015104342270013114 5ustar benlbenlPod-Abstract-0.26/bin/paf0000644000175000017500000001514615102047605013616 0ustar benlbenl#!/usr/bin/perl package paf; use strict; use warnings; use Pod::Abstract; use Pod::Abstract::Filter; use File::Temp qw(tempfile tempdir); =head1 NAME paf - Pod Abstract Filter. Transform Pod documents from the command line. =head1 SYNOPSIS sh$> paf summary /usr/bin/paf paf add_podcmds SomeModule.pm paf sort -heading=METHODS Pod/Abstract/Node.pm # METHODS is default paf sort summary Pod/Abstract/Node.pm # See Pod::Abstract::Filter::overlay paf overlay sort cut clear_podcmds SomeClass.pm # -p will emit pod source, instead of spawning perldoc. paf -p sort Pod::Abstract::Node paf -p find hoist Pod::Abstract::Node =head1 DESCRIPTION Paf is a small but powerful, modular Pod filter and transformation tool. It allows full round-trip transformation of Pod documents using the Pod::Abstract library, with multiple filter chains without having to serialise/re-parse the document at each step. Paf comes with a small set of useful filters, but can be extended by simply writing new classes in the C namespace. =head1 FILTERS =head2 add_podcmds Add explicit =pod commands at the end of each cut section, so that all pod sections are started with an =pod command. =head2 clear_podcmds Remove all =pod commands that are not ending cut blocks. This will clean up documents that have been reduced using the C filter too. =head2 cut Remove all cut nodes, so that only the pod remains. =head2 overlay paf overlay Source.pm For overlay to work, there must be a C section in the Source file, with C<=overlay SECTION Module> definitions inside. The net effect is that any missing subheadings in SECTION are added from the same section in the specified Modules. Note that this will overlay the whole subheading, INCLUDING CUT NODES, so it can add code to the source document. Use C if you don't want this. Each overlaid section will include a C<=for overlay from> marker, so that it can be replaced by a subsequent overlay from the same file/module. These sections will be replaced in-place, so ordering of sections once first overlaid will be preserved. =head2 unoverlay paf unoverlay Source.pm Strips B sections marked as overlaid and matching the overlay spec from the source. =head2 sort paf sort [-heading=METHODS] Source.pm Sort all of the subheadings in the named heading (METHODS if not provided). This will move cut nodes around with their headings, so your code will mutate. Use C if you only want pod in the output. Alternatively, you can also cause sorting of headings to occur by including C<=for sorting> at the start of your section (before the first subheading). =head2 summary Provide an abbreviated summary of the document. If there is a verbatim node in the body of a heading containing the heading name, it will be considered an example and expanded as part of the summary. =head2 find paf find [-f=]name Source.pm Find specific sub-sections or list items mentioning name. Used to restrict a larger document down to a smaller set that you're interested in. If no -f is specified, then the word following find will be the search term. =head2 uncut paf uncut Source.pm Convert cut nodes in the source into verbatim text. Not the inverse of cut! =head2 number_sections paf number_sections Source.pm Applies simple multipart (3.1.2) section numbering to head1 through head4 headings. Note that number_sections will currently stuff up some of the cleverness in things like summary, as the section names won't match function names any more. =cut sub main { my $filter = undef; my %filter_flags = ( ); my %flags = ( ); my @filters = ( ); my @require_params = ( ); my $plugins = Pod::Abstract::Filter->plugins_info; for( my $i = 0; $i < $#ARGV; $i ++ ) { # leave the last argument my $arg = $ARGV[$i]; if($arg =~ m/^-([^=]+)(=(.*))?$/) { if($filter) { if(defined $3) { $filter_flags{$1} = $3; } else { $filter_flags{$1} = 1; } @require_params = grep { $_ ne $1 } @require_params; } else { if(defined $3) { $flags{$1} = $3; } else { $flags{$1} = 1; } } } elsif( @require_params ) { # Allow positional params if they're asked for. my $p_name = shift @require_params; $filter_flags{$p_name} = $arg; } elsif( my $plugin = $plugins->{$arg}) { my $full_class = "Pod::Abstract::Filter::$arg"; eval "use $full_class;"; die "$arg: $@" if $@; if($filter) { push @filters, $filter->new(%filter_flags); %filter_flags = ( ); } $filter = $full_class; @require_params = $filter->require_params; } else { die "Unknown command '$arg' - run 'paf' with no arguments for list\n" } } # Push on the last filter if($filter) { push @filters, $filter->new(%filter_flags); %filter_flags = ( ); } my $filename = $ARGV[$#ARGV]; if ( !$filename ) { my $filters_info = join( "\n\n", map { my $n = $_->{summary}[0]; my $info = $_->{summary}[1]; "$n\n$info"; } grep { @{$_->{summary}} } values %$plugins ); die "No filename or filters provided\nTry 'perldoc paf'\n\nAvailable Filters:\n$filters_info\n"; } my $next = undef; if($filename eq '--') { $next = Pod::Abstract->load_filehandle(\*STDIN); } else { unless(-r $filename) { # Maybe a module name? $filename =~ s/::/\//g; $filename .= '.pm' unless $filename =~ m/.pm$/; foreach my $path (@INC) { if(-r "$path/$filename") { $filename = "$path/$filename"; last; } } } $next = Pod::Abstract->load_file($filename); } foreach my $filter (@filters) { $next = $filter->filter($next); } my $out = \*STDOUT; my $tmpfilename = undef; if(!($flags{p} || $flags{d})) { ($out, $tmpfilename) = tempfile; } if(eval { $next->isa( 'Pod::Abstract::Node' ) }) { if($flags{d}) { print $out $next->ptree; } else { print $out $next->pod; } } else { print $out $next; } if(!($flags{p} || $flags{d})) { system('perldoc', $tmpfilename); unlink $tmpfilename; } } main(); 1; Pod-Abstract-0.26/META.json0000664000175000017500000000217615104342270013775 0ustar benlbenl{ "abstract" : "Abstract document tree for Perl POD documents", "author" : [ "Ben Lilburne " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Pod-Abstract", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "File::Temp" : "0", "IO::String" : "0", "Module::Pluggable" : "0", "Pod::Parser" : "0", "Scalar::Util" : "0", "Task::Weaken" : "0", "Test::More" : "0" } } }, "release_status" : "stable", "version" : "0.26", "x_serialization_backend" : "JSON::PP version 4.16" } Pod-Abstract-0.26/lib/0000755000175000017500000000000015104342270013112 5ustar benlbenlPod-Abstract-0.26/lib/Pod/0000755000175000017500000000000015104342270013634 5ustar benlbenlPod-Abstract-0.26/lib/Pod/Abstract.pm0000644000175000017500000001676415104342175015757 0ustar benlbenlpackage Pod::Abstract; use strict; use warnings; use Pod::Abstract::Node; use Pod::Abstract::Path; use Pod::Abstract::Parser; use IO::String; our $VERSION = '0.26'; =head1 NAME Pod::Abstract - Abstract document tree for Perl POD documents =head1 SYNOPSIS use Pod::Abstract; use Pod::Abstract::BuildNode qw(node); # Get all the first level headings, and put them in a verbatim block # at the start of the document my $pa = Pod::Abstract->load_filehandle(\*STDIN); my @headings = $pa->select('/head1@heading'); my @headings_text = map { $_->pod } @headings; my $headings_node = node->verbatim(join "\n",@headings_text); $pa->unshift( node->cut ); $pa->unshift( $headings_node ); $pa->unshift( node->pod ); print $pa->pod; =head1 DESCRIPTION C provides a means to load a POD document without direct reference to it's syntax, and perform manipulations on the abstract syntax tree. This can be used to support additional features for POD, to format output, to compile into alternative formats, etc. POD documents are not a natural tree, but do have a logical nesting structure. C makes this explicit - C<=head*> commands create nested sections, =over and =back create nested lists, etc. The "paf summary" command provides easy visualisation of the created tree. =head2 USAGE C allows easy manupulation and traversal of POD or Perl files containing POD, without having to manually do any string manipulation. It allows you to easily write formatters, filters, test scripts, etc for POD. C is based on the standard L module. =head2 PROCESSING MODEL C allows documents to be loaded, decorated, and manupulated in multiple steps. It can also make generating a POD formatter very simple. You can easily add features to an existing POD formatter, since any POD abstract object can be written out as a POD document. Rather than write or fork a whole translator, a single inline "decorator" can be added. The C utility provides a good starting point, which also allows you to hook in to an existing filter/transform library. Add a C class to the namespace and it should start working as a C command. =head2 EXAMPLE Suppose you are frustrated by the verbose list syntax used by regular POD. You might reasonably want to define a simplified list format for your own use, except POD formatters won't support it. With Pod::Abstract you can write an inline filter to convert: * item 1 * item 2 * item 3 into: =over =item * item 1 =item * item 2 =item * item 3 =back This transformation can be performed on the document tree. If your formatter does not use Pod::Abstract, you can pipe out POD and use a regular formatter. If your formatter supports Pod::Abstract, you can feed in the syntax tree without having to re-serialise and parse the document. The source document is still valid Pod, you aren't breaking compatibility with regular perldoc just by making Pod::Abstract transformations. =head2 POD SUPPORT C supports all POD rules defined in perlpodspec. =head1 COMPONENTS Pod::Abstract is comprised of: =over =item * The parser, which loads a document tree. e.g: my $pa = Pod::Abstract->load_filehandle(\*STDIN); =item * The document tree, returned from the parser. The root node (C<$pa> above) represents the whole document. Calling B<< ->pod >> on the root node will give you back your original document. Note the document includes C<#cut> nodes, which are generally the Perl code - the parts that aren't POD. These will be included in the output of B<< ->pod >> unless you remove them, so you can modify a Perl module as a POD document in POD abstract, and it will work the same afterwards. e.g my $pod_text = $pa->pod; # $pod_text is reserialized from the tree. See L =item * L, a node selection language. Called via C<< $node->select(PATH_EXP) >>. Pod paths are a powerful feature allowing declarative traversal of a document. For example - "Find all head2s under METHODS" /head1[@heading=~{^METHODS$}]/head2 "Find all bold text anywhere" //B =item * The node builder, L. This exports methods to allow adding content to POD documents. You can also combine documents - use Pod::Abstract::BuildNode qw(node nodes); # ... my @nodes = nodes->from_pod($pod); Where C<$pod> is a text with POD formatting. =back =head2 Using paths The easiest way to traverse a C<$pa> tree is to use the C will accept and expression and return an array of L. These nodes also support the select method - for example: my @headings = $pa->select('/head1'); # Get all heading 1 my @X = $headings[0]->select('//:X'); # Get all X (index) sequences inside that heading my @indices = map { $_->text } @X; # Map out the contents of those as plain text. You can combine path expressions with other methods, for example - C will give all the child nodes of a POD node, C, C, C and C allow traversal from a given node. From any node you can then call C, @attr, .index if(not defined $next) { return { 'action' => 'end_select', }; } elsif(grep { $tok == $_ } (MATCHES, R_SELECT, S_CMP, N_CMP, UNION, INTERSECT)) { unshift @$l, $next; return { 'action' => 'end_select', }; } elsif($tok == CHILDREN) { return { 'action' => 'select_children', 'next' => $self->parse_l_path($l), }; } elsif($tok == ALL) { return { 'action' => 'select_all', 'next' => $self->parse_l_path($l), }; } elsif($tok == NEXT) { return { 'action' => 'select_next', 'next' => $self->parse_l_path($l), }; } elsif($tok == PREV) { return { 'action' => 'select_prev', 'next' => $self->parse_l_path($l), }; } elsif($tok == PARENT) { return { 'action' => 'select_parents', 'next' => $self->parse_l_path($l), }; } elsif($tok == ROOT) { return { 'action' => 'select_root', 'next' => $self->parse_l_path($l), }; } elsif($tok == NOP) { return { 'action' => 'select_current', 'next' => $self->parse_l_path($l), }; } elsif($tok == NAME) { $self->check_name($val); # Dies on fail. my @extra_names = $self->parse_names($l); return { 'action' => 'select_name', 'arguments' => [ $val, @extra_names ], 'next' => $self->parse_l_path($l), }; } elsif($tok == ATTR) { return { 'action' => 'select_attr', 'arguments' => [ $val ], 'next' => $self->parse_l_path($l), }; } elsif($tok == INDEX) { return { 'action' => 'select_index', 'arguments' => [ $val ], 'next' => $self->parse_l_path($l), }; } elsif($tok == L_SELECT) { unshift @$l, $next; my $exp = $self->parse_expression($l); $exp->{'next'} = $self->parse_l_path($l); return $exp; } else { die "Unexpected token, ", Dumper([$next]); } } sub parse_names { my $self = shift; my $l = shift; my @r = ( ); # Collect a list of names until there are no more. while(@$l && $l->[0][0] == NAME) { my $next = shift @$l; my $val = $next->[1]; return unless $self->check_name($val); # This is going to produce a die, unless told not to. push @r, $val; } return @r; } my %allow = ( head1 => 1, head2 => 1, head3 => 1, head4 => 1, head5 => 1, head6 => 1, pod => 1, over => 1, item => 1, back => 1, begin => 1, for => 1, end => 1, '#cut' => 1, ':verbatim' => 1, ':text' => 1, ':paragraph' => 1, # Formatting commands ':L' => 1, # Link ':X' => 1, # Index ':B' => 1, # Bold ':C' => 1, # Code ':E' => 1, # Escape ':I' => 1, # Italic ':F' => 1, # Filename ':Z' => 1, # Zero ':S' => 1, # Non-breaking spaces ); sub check_name { my $self = shift; my $val = shift; if( $allow{$val} ) { return 1; } if( $val =~ m/^[A-Z]$/ ) { die "Expression name $val looks like a formatting code, did you mean :$val?\n"; } if( $allow{":$val"} ) { die "Expression $val invalid, did you mean :$val?\n"; } die "Invalid node expression $val\n"; } sub parse_expression { my $self = shift; my $class = ref $self; my $l = shift; my $l_select = shift @$l; die "Expected L_SELECT, got ", Dumper([$l_select]) unless $l_select->[0] == L_SELECT; # See if we lead with a NOT if($l->[0][0] == NOT) { shift @$l; unshift @$l, $l_select; my $exp = $self->parse_expression($l); $exp->{arguments}[1] = !$exp->{arguments}[1]; return $exp; } my $l_exp = $self->parse_path($l); $l_exp = $class->new("select expression",$l_exp); my $op = shift @$l; my $op_tok = $op->[0]; my $op_val = $op->[1]; my $exp = undef; if($op_tok == MATCHES) { my $re = shift @$l; my $re_tok = $re->[0]; my $re_str = $re->[1]; my $case_sensitive = $re->[2]; if($re_tok == REGEXP) { $exp = { 'action' => 'match_expression', 'arguments' => [ 'test_regexp', 0, $l_exp, [ $re_str, $case_sensitive ] ], } } else { die "Expected REGEXP, got ", Dumper([$re_tok]); } } elsif($op_tok == S_CMP || $op_tok == N_CMP) { my $rh = shift @$l; my $rh_tok = $rh->[0]; my $r_exp = undef; if($rh_tok == STRING) { # simple string equality $r_exp = $rh; } else { unshift @$l, $rh; $r_exp = $self->parse_path($l); $r_exp = $class->new("select expression",$r_exp); } $exp = { action => 'match_expression', arguments => [ 'test_cmp_op', 0, $l_exp, $r_exp, $op_val ], }; } elsif($op_tok == R_SELECT) { # simple expression unshift @$l, $op; $exp = { 'action' => 'match_expression', 'arguments' => [ 'test_simple', 0, $l_exp ], } } else { die "Expected MATCHES, got ", Dumper([$op_tok]); } # Must match close of select; my $r_select = shift @$l; die "Expected R_SELECT, got, ", Dumper([$r_select]) unless $r_select->[0] == R_SELECT; die "Failed to generate expression" unless $exp; # All OK! return $exp; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Tree.pm0000644000175000017500000001220015102041166016625 0ustar benlbenlpackage Pod::Abstract::Tree; use strict; our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Tree - Manage a level of Pod document tree Nodes. =head1 DESCRIPTION Pod::Abstract::Tree keeps track of a set of Pod::Abstract::Node elements, and allows manipulation of that list of elements. Elements are stored in an ordered set - a single node can appear once only in a single document tree, so inserting a node at a point will also remove it from it's previous location. This is an internal class to Pod::Abstract::Node, and should not generally be used externally. =head1 METHODS =cut sub new { my $class = shift; return bless { id_map => { }, nodes => [ ], }, $class; } =head2 detach $tree->detach($node); Unparent the C<$node> from C<$tree>. All other elements will be shifted to fill the empty spot. =cut sub detach { my $self = shift; my $node = shift; my $id_map = $self->{id_map}; my $serial = $node->serial; my $idx = $id_map->{$node->serial}; return 0 unless defined $idx; die "Wrong node ($idx/$serial)! Got: ", $self->{nodes}[$idx]->serial unless $self->{nodes}[$idx]->serial == $serial; # Node is defined, remove it: splice @{$self->{nodes}},$idx,1; delete $id_map->{$serial}; # Move all following nodes back by 1 my $length = scalar @{$self->{nodes}}; for(my $i = $idx; $i < $length; $i ++) { my $s = $self->{nodes}[$i]->serial; $id_map->{$s} --; } # Node now has no parent. $node->parent(undef); return $node; } =head2 push Add an element to the end of the node list. =cut sub push { my $self = shift; my $node = shift; if($node->attached) { $node->detach; warn "Implicit detach of node on push"; } my $s = $node->serial; push @{$self->{nodes}}, $node; $self->{id_map}{$s} = $#{$self->{nodes}}; return 1; } =head2 pop Remove an element from the end of the node list. =cut sub pop { my $self = shift; my $node = pop @{$self->{nodes}}; my $s = $node->serial; delete $self->{id_map}{$s}; $node->parent(undef); return $node; } =head2 insert_before $tree->insert_before($target,$node); Insert C<$node> before C<$target>. Both must be children of C<$tree> =cut sub insert_before { my $self = shift; my $target = shift; my $node = shift; my $idx = $self->{id_map}{$target->serial}; return 0 unless defined $idx; splice(@{$self->{nodes}}, $idx, 0, $node); $self->{id_map}{$node->serial} = $idx; # Push all following nodes forwards by 1. my $length = scalar @{$self->{nodes}}; for( my $i = $idx + 1; $i < $length; $i ++) { my $s = $self->{nodes}[$i]->serial; $self->{id_map}{$s} ++; } return 1; } =head2 insert_after $tree->insert_after($target,$node); Insert C<$node> after C<$target>. Both must be children of C<$tree> =cut sub insert_after { my $self = shift; my $target = shift; my $node = shift; my $idx = $self->{id_map}{$target->serial}; die $target->serial, " not in index ", join(", ", keys %{$self->{id_map}}) unless defined $idx; my $last_idx = $#{$self->{nodes}}; if($idx == $last_idx) { return $self->push($node); } else { my $before_target = $self->{nodes}[$idx + 1]; return $self->insert_before($before_target, $node); } } =head2 unshift Remove the first node from the node list and return it. Unshift takes linear time - it has to relocate every other element in id_map so that they stay in line. =cut sub unshift { my $self = shift; my $node = shift; if($node->attached) { $node->detach; warn "Implicit detach of node on unshift"; } my $s = $node->serial; foreach my $k (keys %{$self->{id_map}}) { $self->{id_map}{$k} ++; } unshift @{$self->{nodes}}, $node; $self->{id_map}{$s} = 0; return 1; } =head2 children Returns the in-order node list. =cut sub children { my $self = shift; return @{$self->{nodes}}; } =head2 index_relative my $node = $tree->index_relative($target, $offset); This method will return a node at an offset of $offset (which may be negative) from this tree structure. If there is no such node, undef will be returned. For example, an offset of 1 will give the following element of $node. =cut sub index_relative { my $self = shift; my $node = shift; my $index = shift; my $serial = $node->serial; die "index_relative called with unattached node" unless $node->attached; my $node_idx = $self->{id_map}{$serial}; die "index_relative called with node not present in tree" unless defined $node_idx; my $real_index = $node_idx + $index; my $n_nodes = scalar @{$self->{nodes}}; if($real_index >= 0 && $real_index < $n_nodes) { return $self->{nodes}[$real_index]; } else { return undef; } } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Serial.pm0000644000175000017500000000154615102041166017160 0ustar benlbenlpackage Pod::Abstract::Serial; use strict; our $VERSION = '0.26'; my $serial_number = 0; =head1 NAME Pod::Abstract::Serial - generate a global sequence of serial numbers. =head1 DESCRIPTION Used to number Pod::Abstract::Node elements for identification. =head1 BUGS This will cause problems with Pod::Abstract documents frozen to disk using Data::Dumper etc, unless C is used to bump the number above the highest number read. Or just serialise your document with C<< $node->pod >> instead! =cut sub next { return ++$serial_number; } sub last { return $serial_number; } sub set { $serial_number = shift; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/0000755000175000017500000000000015104342270016624 5ustar benlbenlPod-Abstract-0.26/lib/Pod/Abstract/Filter/add_podcmds.pm0000644000175000017500000000241515102045065021425 0ustar benlbenlpackage Pod::Abstract::Filter::add_podcmds; use strict; use base qw(Pod::Abstract::Filter); use Pod::Abstract::BuildNode qw(node); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::add_podcmds - Insert explict =pod commands before each Pod block in a document. =head1 METHODS =head2 filter Add a =pod command after each block of cut nodes. This will cause explicit pod declarations wherever they are currently implicit. =cut sub filter { my $self = shift; my $pa = shift; my @cut_finals = $pa->select( "//#cut[!>>#cut][!>>pod]" ); # If the document ends with a cut, we don't want a new Pod section # - but if it ends with a pod, we do. my $last_cut = pop @cut_finals; my $ignore_last = 1; my $p = $last_cut; $ignore_last = 0 if $p->next; while($p && ($p = $p->parent) && $ignore_last) { $ignore_last = 0 if $p->next; } push @cut_finals, $last_cut unless $ignore_last; foreach my $n (@cut_finals) { node->pod->insert_after($n); } return $pa; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/summary.pm0000644000175000017500000000410015102045126020650 0ustar benlbenlpackage Pod::Abstract::Filter::summary; use strict; use base qw(Pod::Abstract::Filter); use Pod::Abstract::BuildNode qw(node); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::summary - Show document outline, with short examples. =cut sub filter { my $self = shift; my $pa = shift; my $summary = node->root; my $summ_block = node->head1('Summary'); $summary->nest($summ_block); $self->summarise_headings($pa,$summ_block); $summ_block->nest(node->text("\n")); $summ_block->coalesce_body(':text'); return $summary; } sub summarise_headings { my $self = shift; my $pa = shift; my $summ_block = shift; my $depth = shift; $depth = 1 unless defined $depth; my @headings = $pa->select('/[@heading]'); my @items = $pa->select('/over/item[@label =~ {[a-zA-Z]+}]'); # Labels that have strings unshift @headings, @items; foreach my $head (@headings) { my ($hdg) = $head->select('@heading'); if($head->type eq 'item') { ($hdg) = $head->select('@label'); } my $hdg_text = $hdg->text; $summ_block->push( node->text((" " x $depth) . $hdg_text . "\n") ); if($hdg_text =~ m/^[0-9a-zA-Z_ ]+$/) { my ($synopsis) = $head->select("//:verbatim[. =~ {$hdg_text}](0)"); if($synopsis) { my $synop_body = $synopsis->body; $synop_body =~ s/[\r\n]//sg; $synop_body =~ s/[\t ]+/ /g; $synop_body =~ s/^ //g; $summ_block->push( node->text( (" " x $depth) . " \\ " . $synop_body . "\n" ) ); } } $self->summarise_headings($head, $summ_block, $depth + 1); } } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/sort.pm0000644000175000017500000000321415102044243020146 0ustar benlbenlpackage Pod::Abstract::Filter::sort; use strict; use warnings; use Data::Dumper; use base qw(Pod::Abstract::Filter); =head1 NAME Pod::Abstract::Filter::sort - alphabetically sort sub-sections within a POD section. =head1 USAGE =over =item * Sort the METHODS section in the target document: paf sort -heading=METHODS Your::Module::Name =item * Sort as specified, where your document has: =head1 METHODS =for sorting {etc} In this case the "=for sorting" label will cause all subheadings to be sorted alphabetically, you don't need to specify a section. paf sort Your::Module::Name =cut our $VERSION = '0.26'; sub filter { my $self = shift; my $pa = shift; my $heading = $self->param('heading'); $heading = 'METHODS' unless defined $heading; my @targets = $pa->select("//[\@heading =~ {$heading}]"); my @spec_targets = $pa->select("//[/for =~ {^sorting}]"); if($self->param('heading')) { push @targets, @spec_targets; } else { @targets = @spec_targets if @spec_targets; } foreach my $t (@targets) { my @ignore = $t->select("/[!\@heading]"); my @to_sort = $t->select("/[\@heading]"); $t->clear; $t->nest(@ignore); $t->nest( sort { $a->param('heading')->pod cmp $b->param('heading')->pod } @to_sort ); } return $pa; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/number_sections.pm0000755000175000017500000000272415102041166022367 0ustar benlbenlpackage Pod::Abstract::Filter::number_sections; use strict; use warnings; use base qw( Pod::Abstract::Filter ); use Pod::Abstract::BuildNode qw(node); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::number_sections - paf command for basic multipart section numbering. =cut sub filter { my $self = shift; my $pa = shift; my $h1 = 0; my @h1 = $pa->select('/head1'); foreach my $hn1 (@h1) { $h1 ++; $hn1->param('heading')->unshift(node->text("$h1. ")); my @h2 = $hn1->select('/head2'); my $h2 = 0; foreach my $hn2 (@h2) { $h2 ++; $hn2->param('heading')->unshift(node->text("$h1.$h2 ")); my @h3 = $hn2->select('/head3'); my $h3 = 0; foreach my $hn3 (@h3) { $h3 ++; $hn3->param('heading')->unshift(node->text("$h1.$h2.$h3 ")); my @h4 = $hn3->select('/head4'); my $h4 = 0; foreach my $hn4 (@h4) { $h4 ++; $hn4->param('heading')-> unshift(node->text("$h1.$h2.$h3.$h4 ")); } } } } return $pa; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/ptree.pm0000644000175000017500000000257015102043556020310 0ustar benlbenlpackage Pod::Abstract::Filter::ptree; use strict; use warnings; use base qw(Pod::Abstract::Filter); use Pod::Abstract::BuildNode qw(node); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::ptree - convert the incoming document to a summarised parse tree, and dump that into a verbatim block. =head1 DESCRIPTION This can be very useful to understand the generated structure of a POD file when you are building your own filters or code based on L. =head1 USAGE $ paf ptree bin/paf ... Parse Tree 1 [[ROOT]] 2 [#cut] #!/usr/bin/perl 3 [#cut] package paf;use strict;use warnings; 4 [#cut] use Pod::Abstract;use Pod::Abstract::Filter; 5 [#cut] use File::Temp qw(tempfile tempdir); 8 [head1] NAME 9 [:paragraph] 10 [:text] paf - Pod Abstract Filter. Transform Pod documents from t <... etc> =head1 METHODS =head2 filter This is the only method for the module, and it just makes use of the L method to generate a visual parse tree, and nests that into a heading generated by L. =cut sub filter { my $self = shift; my $pa = shift; my $ptree = node->verbatim( $pa->ptree ); my $pt_block = node->head1('Parse Tree'); $pt_block->nest($ptree); $pt_block->coalesce_body(':text'); return $pt_block; } 1;Pod-Abstract-0.26/lib/Pod/Abstract/Filter/find.pm0000644000175000017500000000517315102045111020100 0ustar benlbenlpackage Pod::Abstract::Filter::find; use strict; use warnings; use base qw(Pod::Abstract::Filter); use Pod::Abstract::BuildNode qw(node); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::find - Find specific nodes that contain a string. =head1 DESCRIPTION The intention of this filter is to allow a reduction of large Pod documents to find a specific function or method. You call C, and you get a small subset of nodes matching "function". For this to work, there has to be some assumptions about Pod structure. I am presuming that find is not useful if it returns anything higher than a head2, so as long as your module wraps function doco in a head2, head3, head4 or list item, we're fine. If you use head1 then it won't be useful. In order to be useful as an end user tool, head1 nodes (...) are added between the found nodes. This stops perldoc from dying with no documentation. These can be easily stripped using: C<< $pa->select('/head1') >>, then hoist and detach, or reparent to other Node types. A good example of this working as intended is: paf find select Pod::Abstract::Node =cut sub require_params { return ( 'f' ); } sub filter { my $self = shift; my $pa = shift; my $find_string = $self->param('f'); unless($find_string && $find_string =~ m/^[a-zA-Z0-9_]+$/) { die "find: string must be specified with -f=str.\nMust be a simple string.\n"; } my $out_doc = node->root; $out_doc->nest(node->pod); # Don't select parent nodes, leaf nodes only my @targets = $pa->select("//[. =~ {$find_string}][!/]"); # Don't accept anything less specific than a head2 my @dest_ok = qw(head2 head3 head4 item); my %finals = ( ); foreach my $t (@targets) { while($t->parent && !( grep { $t->type eq $_ } @dest_ok )) { $t = $t->parent; } if(grep { $t->type eq $_ } @dest_ok) { unless($finals{$t->serial}) { my $head = node->head1('...'); if($t->type eq 'item') { my $over = node->over; $over->nest($t->duplicate); $head->nest($over); } else { $head->nest($t->duplicate); } $out_doc->push($head); $finals{$t->serial} = 1; } } } return $out_doc; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/overlay.pm0000644000175000017500000001106115102045121020633 0ustar benlbenlpackage Pod::Abstract::Filter::overlay; use strict; use warnings; use base qw(Pod::Abstract::Filter); use Pod::Abstract; use Pod::Abstract::BuildNode qw(node); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::overlay - Perform a method documentation overlay on a Pod document. =head1 USAGE Use the C command to run this filter inline - for example: $ paf -p overlay sort summary Pod::Abstract::Filter::overlay Produces NAME METHODS \ =begin :overlay =overlay METHODS Some::Class::Or::File =end :overlay filter new param require_params run AUTHOR COPYRIGHT AND LICENSE =begin :overlay =overlay METHODS Pod::Abstract::Filter =end :overlay =head1 METHODS =head2 filter Inspects the source document for a begin/end block named ":overlay". The overlay block will be inspected for "=overlay" commands, which should be structured like: =begin :overlay =overlay METHODS Some::Class::Or::File =end :overlay Each overlay is processed in order. It will add any headings for the matched sections in the current document from the named source, for any heading that is not already present in the given section. The main utility of this is to specify a superclass, so that all the methods that are not documented in your subclass become documented by the overlay. The C filter makes a good follow up. The start of overlaid sections will include: =for overlay from You can use these markers to set sections to be replaced by some other document, or to repeat an overlay on an already processed Pod file. Changes to existing marked sections are made in-place without changing document order. =cut sub filter { my $self = shift; my $pa = shift; my ($overlay_list) = $pa->select("//begin[. =~ {^:overlay}](0)"); unless($overlay_list) { die "No overlay defined in document\n"; } my @overlays = $overlay_list->select("/overlay"); foreach my $overlay (@overlays) { my $o_def = $overlay->body; my ($section, $module) = split " ", $o_def; # This should be factored into a method. my $ovr_module = $module; # Keep original value unless(-r $module) { # Maybe a module name? $module =~ s/::/\//g; $module .= '.pm' unless $module =~ m/.pm$/; foreach my $path (@INC) { if(-r "$path/$module") { $module = "$path/$module"; last; } } } my $ovr_doc = Pod::Abstract->load_file($module); my ($t) = $pa->select("//[\@heading =~ {$section}](0)"); my ($o) = $ovr_doc->select("//[\@heading =~ {$section}](0)"); my @t_headings = $t->select("/[\@heading]"); my @o_headings = $o->select("/[\@heading]"); my %t_heading = map { $_->param('heading')->pod => $_ } @t_headings; foreach my $hdg (@o_headings) { my $hdg_text = $hdg->param('heading')->pod; if($t_heading{$hdg_text}) { my @overlay_from = $t_heading{$hdg_text}->select( "/for[. =~ {^overlay from }]"); my @from_current = grep { substr($_->body, -(length $ovr_module)) eq $ovr_module } @overlay_from; if(@from_current) { my $dup = $hdg->duplicate; my @overlay_from = $hdg->select("/for[. =~ {^overlay from }]"); $_->detach foreach @overlay_from; $dup->unshift(node->for("overlay from $ovr_module")); $dup->insert_after($t_heading{$hdg_text}); $t_heading{$hdg_text}->detach; $t_heading{$hdg_text} = $dup; } } else { my $dup = $hdg->duplicate; # Remove existing overlay markers; my @overlay_from = $hdg->select("/for[. =~ {^overlay from }]"); $_->detach foreach @overlay_from; $dup->unshift(node->for("overlay from $ovr_module")); $t->push($dup); $t_heading{$hdg_text} = $dup; } } } return $pa; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/unoverlay.pm0000755000175000017500000000340515102045150021206 0ustar benlbenlpackage Pod::Abstract::Filter::unoverlay; use strict; use warnings; use base qw(Pod::Abstract::Filter); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::unoverlay - Remove "overlay" blocks from a Pod document, as created by the paf overlay command. =begin :overlay =overlay METHODS Pod::Abstract::Filter =end :overlay =head1 METHODS =head2 new =for overlay from Pod::Abstract::Filter =head2 filter Strips any sections marked C<=for overlay> from the listed overlay specification from the target document. This will expunge everything that has been previously overlaid or marked for overlay from the specified documents. =cut sub filter { my $self = shift; my $pa = shift; my ($overlay_list) = $pa->select("//begin[. =~ {^:overlay}](0)"); unless($overlay_list) { die "No overlay defined in document\n"; } my @overlays = $overlay_list->select("/overlay"); foreach my $overlay (@overlays) { my $o_def = $overlay->body; my ($section, $module) = split " ", $o_def; my ($t) = $pa->select("//[\@heading =~ {$section}](0)"); my @t_headings = $t->select("/[\@heading]"); foreach my $hdg (@t_headings) { my @overlay_from = $hdg->select( "/for[. =~ {^overlay from }]"); my @from_current = grep { substr($_->body, -(length $module)) eq $module } @overlay_from; if(@from_current) { $hdg->detach; } } } return $pa; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/cut.pm0000644000175000017500000000120115102045103017740 0ustar benlbenlpackage Pod::Abstract::Filter::cut; use strict; use warnings; use base qw(Pod::Abstract::Filter); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::cut - Remove non-processed (cut) portions of a Pod document. =cut sub filter { my $self = shift; my $pa = shift; my @cut = $pa->select("//#cut"); foreach my $cut (@cut) { $cut->detach; } return $pa; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/clear_podcmds.pm0000644000175000017500000000166115102045151021761 0ustar benlbenlpackage Pod::Abstract::Filter::clear_podcmds; use strict; use base qw(Pod::Abstract::Filter); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::clear_podcmds - Remove =pod commands from the begining of Pod blocks. =cut sub filter { my $self = shift; my $pa = shift; my ($first_node) = $pa->select("/(0)"); my @pod_cmds = $pa->select( "//pod[!<<#cut]" ); foreach my $pod_cmd (@pod_cmds) { # The start of the document is in cut mode, even if there is # no text there, so if the lead node is an =pod node don't # strip it. $pod_cmd->detach unless $pod_cmd->serial == $first_node->serial; } return $pa; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/Filter/uncut.pm0000644000175000017500000000300415102045134020312 0ustar benlbenlpackage Pod::Abstract::Filter::uncut; use strict; use warnings; use base qw(Pod::Abstract::Filter); use Pod::Abstract::BuildNode qw(node); our $VERSION = '0.26'; =head1 NAME Pod::Abstract::Filter::uncut - Turn source code into verbatim nodes. =head1 DESCRIPTION Takes all cut blocks from the source document, after the first Pod block starts, and converts them into inline verbatim Pod blocks. The effect of this is to allow viewing of source code inline with the formatted Pod documentation describing it. =cut sub filter { my $self = shift; my $pa = shift; my @cuts = $pa->select('//#cut[! << #cut]'); # First cut in each run foreach my $cut (@cuts) { next unless $cut->body =~ m/^=cut/; my $n = $cut->next; while( $n && $n->type eq '#cut' ) { my $body = $n->body; $body =~ s/\n\s*$//m; $cut->push(node->verbatim($body)); $n->detach; $n = $cut->next; } $cut->hoist; $cut->detach; } $pa->coalesce_body(":verbatim"); $pa->coalesce_body(":text"); # Detach/remove any blank verbatim nodes, so we don't have extra # empty verbatim blocks to deal with. $_->detach foreach $pa->select('//:verbatim[ . =~ {^[\s]*$}]'); return $pa; } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/lib/Pod/Abstract/BuildNode.pm0000644000175000017500000002017215102041166017602 0ustar benlbenlpackage Pod::Abstract::BuildNode; use strict; use Exporter; use Pod::Abstract; use Pod::Abstract::Parser; use Pod::Abstract::Node; use base qw(Exporter); our $VERSION = '0.26'; our @EXPORT_OK = qw(node nodes); sub node { 'Pod::Abstract::BuildNode' }; sub nodes { 'Pod::Abstract::BuildNode' }; =head1 NAME Pod::Abstract::BuildNode - Build new nodes for use in Pod::Abstract. =head1 SYNOPSIS use Pod::Abstract::BuildNode qw(node nodes); # shorthand my $root_doc = node->root; for(my $i = 1; $i < 10; $i ++) { $root_doc->push(node->head1("Heading number $i")); } print $root_doc->pod; =head1 DESCRIPTION For building a new Pod::Abstract document, or adding nodes to an existing one. This provides easy methods to generate correctly set nodes for most common Pod::Abstract elements. =head1 NOTES Pod::Abstract::BuildNode can export two functions, C and C. These are constant functions to provide a shorthand so instead of writing: use Pod::Abstract::BuildNode; # ... my @nodes = Pod::Abstract::BuildNode->from_pod( $pod ); You can instead write: use Pod::Abstract::BuildNode qw(node nodes); # ... my @nodes = nodes->from_pod($pod); Which is more readable, and less typing. C and C are both synonyms of C. This shorthand form is shown in all the method examples below. All methods operate on the class. =head1 METHODS =cut =head2 from_pod my @nodes = nodes->from_pod($pod_text); Given some literal Pod text, generate a full subtree of nodes. The returned array is all of the top level nodes. The full document tree will be populated under the returned nodes. =cut sub from_pod { my $class = shift; my $str = shift; my $root = Pod::Abstract->load_string($str); return undef unless $root; my @r = map { $_->detach; $_ } $root->children; return @r; } =head2 root my $root = node->root; Generate a root node. A root node generates no output, and is used to hold a document tree. Use this to make a new document. =cut sub root { my $class = shift; my $para = Pod::Abstract::Node->new( type => '[ROOT]', ); } =head2 begin my $begin_block = node->begin($command); Generates a begin/end block. Nodes nested inside the begin node will appear between the begin/end. Note that there is no corresponding C method - the end command belongs to it's corresponding begin. =cut sub begin { my $class = shift; my $cmd = shift; my $begin = Pod::Abstract::Node->new( type => 'begin', body => $cmd, close_element => Pod::Abstract::Node->new( type => 'end', body => $cmd, ), ); return $begin; } =head2 for my $for = node->for('overlay from '); Create a =for node. The argument is the literal body of the for node, no parsing will be performed. =cut sub for { my $class = shift; my $str = shift; return Pod::Abstract::Node->new( type => 'for', body => $str, ); } =head2 paragraph my $para = node->paragraph('Pod text'); Generates a Pod paragraph, possibly containing interior sequences. The argument will be parsed as Pod, and will generate text and sequence nodes inside the paragraph. =cut sub paragraph { my $class = shift; my $str = shift; my $para = Pod::Abstract::Node->new( type => ':paragraph', ); my $parser = Pod::Abstract::Parser->new; my $pt = $parser->parse_text($str); if($pt) { $parser->load_pt($para,$pt); } else { return undef; } } =head2 verbatim my $v = node->verbatim($text); Add the given text as a verbatim node to the document. All lines in the fiven C<$text> will be indented by one space to ensure they are treated as verbatim. =cut sub verbatim { my $class = shift; my $str = shift; my @strs = split "\n",$str; for(my $i = 0; $i < @strs; $i ++) { my $str_line = $strs[$i]; $strs[$i] = ' '.$str_line; } my $verbatim = Pod::Abstract::Node->new( type => ':verbatim', body => (join("\n", @strs) . "\n\n"), ); return $verbatim; } =head2 heading my $head2 = node->heading(2, $heading); Generate a heading node at the given level. Nodes that "belong" in the heading's section should be nested in the heading node. The C<$heading> text will be parsed for interior sequences. =cut sub heading { my $class = shift; my $level = shift; my $heading = shift; my $attr_node = Pod::Abstract::Node->new( type => '@attribute', ); my $parser = Pod::Abstract::Parser->new; my $pt = $parser->parse_text($heading); $parser->load_pt($attr_node, $pt); my $element_node = Pod::Abstract::Node->new( type => "head$level", heading => $attr_node, body_attr => 'heading', ); return $element_node; } =head2 head1 node->head1($heading); =cut sub head1 { my $class = shift; my $heading = shift; return $class->heading(1,$heading); } =head2 head2 node->head2($heading); =cut sub head2 { my $class = shift; my $heading = shift; return $class->heading(2,$heading); } =head2 head3 node->head3($heading); =cut sub head3 { my $class = shift; my $heading = shift; return $class->heading(3,$heading); } =head2 head4 node->head4($heading); =cut sub head4 { my $class = shift; my $heading = shift; return $class->heading(4,$heading); } =head2 over my $list = node->over([$num]); Generates an over/back block, to contain list items. The optional parameter C<$num> specifies the number of spaces to indent by. Note that the back node is part of the over, there is no separate back method. =cut sub over { my $class = shift; my $number = shift; $number = '' unless defined $number; return Pod::Abstract::Node->new( type => 'over', body => ($number ? $number : undef), close_element => Pod::Abstract::Node->new( type => 'back', ), ); } =head2 link my $link = node->link('Pod::Abstract'); Generates an inline link. This will nest the passed link text only. There's special inline parsing for Perl POD links, which is not handled by this method. =cut sub link { my $class = shift; my $link = shift; my $l = Pod::Abstract::Node->new( type => ':L', body => undef, ); my $body = $class->text($link); $l->nest($body); return $l; } =head2 item my $item = node->item('*'); Generates an item with the specified label. To fill in the text of the item, nest paragraphs into the item. Items should be contained in over nodes. =cut sub item { my $class = shift; my $label = shift; my $attr_node = Pod::Abstract::Node->new( type => '@attribute', ); my $parser = Pod::Abstract::Parser->new; my $pt = $parser->parse_text($label); $parser->load_pt($attr_node, $pt); my $element_node = Pod::Abstract::Node->new( type => "item", label => $attr_node, body_attr => 'label', ); return $element_node; } =head2 text my $text = node->text('Literal text'); Generates a literal text node. You generally B want this, you probably want a paragraph. Use this if you want to, for example, append a word at the end of a paragraph. =cut sub text { my $class = shift; my $text = shift; my $attr_node = Pod::Abstract::Node->new( type => ':text', body => $text, ); return $attr_node; } =head2 pod my $n = node->pod; Generates an "=pod" command. Can be useful to force pod mode at the end of cut nodes. Do not confuse with L! =cut sub pod { my $class = shift; return Pod::Abstract::Node->new( type => 'pod', body => '', ); } =head2 cut my $cut = node->cut; Generates an explicit "=cut" command. =cut sub cut { my $class = shift; return Pod::Abstract::Node->new( type => '#cut', body => "=cut\n\n", ); } =head1 AUTHOR Ben Lilburne =head1 COPYRIGHT AND LICENSE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Pod-Abstract-0.26/README0000644000175000017500000000210415101621616013222 0ustar benlbenlPod-Abstract Pod::Abstract provides an abstract, tree-based interface to perl POD documents. This allows straightforward, round-trip capable manipulation of POD documents, hence allowing features to be added to POD to support your programming activities without having to write a whole POD processor. This also allows an easy tree-based mechanism to write a Pod:: type filter. The package includes a simple, and extensible, command line utility called "paf" (Pod::Abstract Filter). This program can chain together Pod Abstract filtering operations, allowing manipulation & extraction of POD documents from the command line. INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Pod::Abstract perldoc /usr/bin/paf COPYRIGHT AND LICENCE Copyright (C) 2009-2025 Ben Lilburne This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Pod-Abstract-0.26/META.yml0000664000175000017500000000126415104342270013622 0ustar benlbenl--- abstract: 'Abstract document tree for Perl POD documents' author: - 'Ben Lilburne ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Pod-Abstract no_index: directory: - t - inc requires: File::Temp: '0' IO::String: '0' Module::Pluggable: '0' Pod::Parser: '0' Scalar::Util: '0' Task::Weaken: '0' Test::More: '0' version: '0.26' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Pod-Abstract-0.26/t/0000755000175000017500000000000015104342270012607 5ustar benlbenlPod-Abstract-0.26/t/06_pa_example.t0000644000175000017500000000155315104337223015422 0ustar benlbenl #!/usr/bin/perl use strict; use warnings; use Test::More tests => 1; use Pod::Abstract; use Pod::Abstract::BuildNode qw(node); # This test is just to validate that the example provided at the start of the # Pod::Abstract documentation actually works! # Get all the first level headings, and put them in a verbatim block # at the start of the document my $pa = Pod::Abstract->load_file('lib/Pod/Abstract.pm'); my @headings = $pa->select('/head1@heading'); my @headings_text = map { $_->pod } @headings; my $headings_node = node->verbatim(join "\n",@headings_text); $pa->unshift( node->cut ); $pa->unshift( $headings_node ); $pa->unshift( node->pod ); my $expect = q{=pod NAME SYNOPSIS DESCRIPTION COMPONENTS METHODS AUTHOR COPYRIGHT AND LICENSE =cut}; my $pod = $pa->pod; ok(index($pod, $expect) >= 0, "Found expected heading summary in generated POD"); 1;Pod-Abstract-0.26/t/05_pod_detailed.t0000644000175000017500000001076515104334607015733 0ustar benlbenl#!/usr/bin/perl use strict; use warnings; use Test::More tests => 5; use Pod::Abstract; my $pod = q~ =head1 NAME Example - Example POD document. =head1 DESCRIPTION This is an I for testing purposes. We are going to parse and traverse it. =head1 FUNCTIONS =head2 example_method my $v = sample_call($x); # Gives a result This would be typical for a perl module. =over =item * This would be a bulleted list =item * Explaining what to do =over =item 1 This one would be a nested numbered list =item 2 This would also =back =item * Back in the bullets =back =cut sub sample_call { # Do some code. This is a "cut" node. } =head2 begin/end =begin markdown * I wouldn't expect this to be parsed internally by Pod::Abstract. * This would instead be a single text node - POD sequences like C are just normal text. =end =begin :special These I be parsed. It's a special trait of POD that : at the begining of a POD block is meant to have its internals parsed as POD. =end =for example this would not be parsed. =for :example but B would. =head1 SEE ALSO L is a link to a function inside a standard document. L is a link to a module. L is a link to a section in a module. L is a quoted section name. L has link text. L =cut ~; my $pa = Pod::Abstract->load_string($pod); ok($pa, "Sample POD parsed"); subtest 'Document Links' => sub { my @links = $pa->select('//:L'); ok(@links == 6, "Found 5 links in the document"); my $li = $links[0]->link_info; is( $li->{text}, 'perlfunc', 'Perlfunc link had expected text' ); is( $li->{section}, 'wantarray', 'And linked to "wantarray"' ); $li = $links[1]->link_info; is( $li->{text}, 'Pod::Abstract', 'Module link is Pod::Abstract' ); is( $li->{document}, 'Pod::Abstract', 'Document is same'); ok( !$li->{section}, 'Section is not defined'); $li = $links[2]->link_info; is( $li->{text}, 'Pod::Abstract', 'Module link is Pod::Abstract' ); is( $li->{document}, 'Pod::Abstract', 'Document is same'); is( $li->{section}, 'load_string', 'Section is load_string'); $li = $links[3]->link_info; is( $li->{text}, 'perlsyn', 'Link text is perlsyn'); is( $li->{section}, '"For Loops"', 'Section is "For Loops"'); $li = $links[4]->link_info; is( $li->{text}, "Pod Abstract is Great", 'Link text is "Pod Abstract is Great"'); is( $li->{document}, "Pod::Abstract", 'Document is Pod::Abstract'); $li = $links[5]->link_info; is( $li->{text}, 'Test Hyperlink', 'Link text is "Test Hyperlink"' ); is( $li->{url}, 'https://metacpan.org/', 'Link to metacpan' ); }; subtest 'begin/end and custom nodes' => sub { # =begin/=end my ($hdg) = $pa->select(q{/head1[@heading eq 'FUNCTIONS']/head2[@heading eq 'begin/end']}); my @special = $hdg->select(qq{/begin[. eq ':special']}); ok( @special == 1, "Found 1 ':special'"); # : means the inner parts should be parsed - there should be 7 # nodes in there if we flatten them out my @s_inner = $special[0]->select('//'); # All nodes. ok( @s_inner == 7, "7 inner nodes in the :special node"); ok( (grep { $_->type eq ':I' } @s_inner), "Found the italic node"); my @markdown = $hdg->select(qq{/begin[. eq 'markdown']}); ok( @markdown == 1, "Found 1 'markdown'"); # This shouldn't be parsed, it should be only one text node. my @m_inner = $markdown[0]->select('//'); ok( @m_inner == 1, "Only one inner node"); is( $m_inner[0]->type, ':text', "Inner node is a text node" ); # =for my @for = $hdg->select(q{/for}); ok( @for == 2, "Two :fors"); my @for_ex = $hdg->select(q{/for[. eq 'example']}); ok( @for_ex == 1, "One =for example" ); my @fenodes = $for_ex[0]->select("//"); ok( @fenodes == 1 && $fenodes[0]->type eq ':text', "And it's just one text node - not parsed"); my @for_ex2 = $hdg->select(q{/for[. eq ':example']}); ok( @for_ex2 == 1, "One =for :example" ); my @fenodes2 = $for_ex2[0]->select("//"); ok( @fenodes2 == 4, "Four nodes, looks parsed" ); ok( (grep {$_->type eq ':B'} @fenodes2), "Found the bold text" ); }; subtest 'List Items' => sub { my @list_numbered = $pa->select("//head2/over//over/item"); ok(@list_numbered == 2, "Found 2 nested list items"); }; subtest 'Round Trip' => sub { is($pod, $pa->pod, "Document round-trip with no changes"); }; 1;Pod-Abstract-0.26/t/02_roundtrip.t0000644000175000017500000000106215102053030015311 0ustar benlbenl#!/usr/bin/perl use strict; use warnings; use Test::More tests => 16; use Pod::Abstract; my @try_files = qw( lib/Pod/Abstract.pm lib/Pod/Abstract/Node.pm lib/Pod/Abstract/Tree.pm lib/Pod/Abstract/BuildNode.pm lib/Pod/Abstract/Path.pm lib/Pod/Abstract/Parser.pm lib/Pod/Abstract/Filter.pm bin/paf ); local $/ = undef; foreach my $file (@try_files) { open IN, "<", $file; my $pa_text = ; my $pa = Pod::Abstract->load_string($pa_text); ok($pa, "$file parsed OK"); ok($pa_text eq $pa->pod, "Document round-trip with no changes"); } 1; Pod-Abstract-0.26/t/03_buildnode.t0000644000175000017500000000161111317775143015255 0ustar benlbenl#!/usr/bin/perl use strict; use warnings; use Test::More tests => 11; use Pod::Abstract; use Pod::Abstract::BuildNode qw(node nodes); ok( my $root = node->root, "Root node" ); ok( my $heading = node->head1('Test', "Heading 1" )); ok( $root->nest($heading), "Nested heading" ); ok( $heading->push( node->paragraph("Test B")), "Added para", ); ok( my $list = node->over, "Over" ); ok( my $item = node->item('*') ); ok( $item->nest( node->paragraph("Test Item")), "Added item" ); ok( $list->nest($item), "Nested item" ); ok( $heading->push($list), "Added list" ); my $pod = q|=head1 Test Test B =over =item * Test Item =back |; is( $root->pod, $pod, "Generated correct Pod" ); my @nodes = nodes->from_pod($pod); my $root_2 = node->root; $root_2->nest(@nodes); my $pod_2 = $root_2->pod; is( $pod_2, $pod, "Round tripped same Pod with ->from_pod" ); 1; Pod-Abstract-0.26/t/01_compile.t0000644000175000017500000000125215102052513014720 0ustar benlbenl#!/usr/bin/perl use strict; use warnings; use Test::More tests => 18; my @modules = qw( Pod::Abstract Pod::Abstract::Node Pod::Abstract::Tree Pod::Abstract::BuildNode Pod::Abstract::Path Pod::Abstract::Parser Pod::Abstract::Filter Pod::Abstract::Filter::cut Pod::Abstract::Filter::uncut Pod::Abstract::Filter::sort Pod::Abstract::Filter::overlay Pod::Abstract::Filter::unoverlay Pod::Abstract::Filter::add_podcmds Pod::Abstract::Filter::clear_podcmds Pod::Abstract::Filter::summary Pod::Abstract::Filter::find Pod::Abstract::Filter::number_sections Pod::Abstract::Filter::ptree ); foreach my $module (@modules) { eval " use $module "; ok(!$@, "$module compiles"); } 1; Pod-Abstract-0.26/t/04_matchnodes.t0000644000175000017500000000631615101632210015423 0ustar benlbenl#!/usr/bin/perl use strict; use warnings; use Test::More tests => 19; use Pod::Abstract; use Pod::Abstract::BuildNode qw(node nodes); my @h = ( ); my @h2 = ( ); my $count_1 = 1; foreach my $t (qw(test TEST foo foo Test)) { my $h1 = node->head1($t); push @h, $h1; $h1->push(node->paragraph("test")); foreach my $t (qw(TEST biscuit test cheese)) { if( $t eq 'cheese' ) { $h1->push(node->head2("$t-$count_1")); } else { $h1->push(node->head2($t)); } } $count_1 ++; } my $root = node->root; $root->nest(@h); my @ci = # case insensitive $root->select('/head1[@heading =~ {test}i]'); my @cs = # case sensitive $root->select('/head1[@heading =~ {TEST}]'); my @eq = # equality - simple $root->select('/head1[@heading eq \'Test\']'); my @ec = # equality - complex $root->select('/head1[@heading eq /head2@heading]'); my @ec_s = # equality - complex - successor $root->select('/head1[>>@heading eq @heading]'); my @root = # Only one root node for all: $root->select('//^'); # Horribly ineffient NOP. This catches the # filter_unique behaviour. my @union = $root->select('/head1(0) | /head1(1) | /head1(2) | /head1(0)'); my @intersect = # Union/Intersect evaluate right to left $root->select( '//[@heading =~ {test}i] & //head2(0) | //head1(4) | head1(3)' ); # Really serious now: head2s or paragraphs of the first head1 but only # those head2s having heading matching 'test', but case insensitive. my @union_select = $root->select( '/head1(0)/head2 :paragraph[ :paragraph | head2[@heading =~ {^test$}i]]' ); # head2s of the first head1 matching "test" (insensitive), but only # those that also have a preceding paragraph. my @intersect_select = $root->select( '/head1(0)/head2[ head2[<<:paragraph] & head2[@heading =~ {^test$}i]]' ); # Match head2 nodes which match top level head1 nodes - # expands/restricts a lot of nodes. my @tt = $root->select('//head2[@heading eq ^/head1@heading]'); my @h2_para = $root->select('/head1(0)/:paragraph head2'); # Negative index into headings my @neg_hdg = $root->select('/head1(-1)'); ok(@cs == 1, "Case sensitive match 1"); ok(@ci == 3, "Case insensitive match 3"); ok(@eq == 1, "Exact match 1"); ok(@ec == 2, "Complex match 2"); ok(@ec_s == 1, "Complex Successor match 1"); ok($_->detach, "Detach matched node") foreach @ec_s; my @ec_p = # equality - complex - preceding $root->select('/head1[<<@heading eq @heading]'); ok(@ec_p == 0, "Complex Preceding match 0"); ok(@root == 1, "One root node only"); ok(@tt == 10, "Match 10 head2 nodes"); ok(@h2_para == 5, "Match 5 head2 or para under first head1"); ok(@union == 3, "Union match three nodes"); for ( my $i = 1; $i < 4; $i++ ) { my $n = $union[$i - 1]; # Out by one. ok( $n->pod =~ m/cheese-$i/, "Matched the expected node =head2 cheese-$i in the unioned head1 sections" ); } ok(@intersect == 2, "Intersect match two nodes"); ok(@union_select == 3, "Union in select match three nodes"); ok(@intersect_select == 1, "Intersect in select matches one node only"); ok(@neg_hdg == 1, "Negative index matched one node"); ok($neg_hdg[0]->param('heading')->pod eq 'Test', "Last head1 is 'Test'"); 1; Pod-Abstract-0.26/Changes0000644000175000017500000000365011317775144013657 0ustar benlbenlRevision history for Pod-Abstract 0.20 03/01/2010 Removed usage of UNIVERSAL isa and can as functions, will correct a deprecation warning with Perl 5.11. Fixed a bug with nodes->from_pod which did not work as documented. Corrected some minor errors with documentation formatting. Added test coverage for from_pod. 0.19 21/06/2009 Added =head1 NAME blocks to those modules missing them. Added some additional Pod. Added "Task::Weaken" dependancy to ensure that the target platform has a working "weaken" in their Scalar::Util 0.18 08/06/2009 Replaced "=" operator with "eq", added the full set of Perl compatible binary comparison operators (eq and friends, == and friends). This will break your code if you used the "=" operator in 0.17, you will need to change it to "eq". 0.17 26/05/2009 Added Union and Intersection operators to paths (conjunction of multiple simple paths). Support for multi-name selectors in paths. Fix for memory leak. Testing of pPath expressions. Added "=" operator with support for combinational matching (any node on left expression = any node on right expression) 0.16 11/05/2009 Changed constant declarations to allow older Perl 5.6 constants. Removed body components from heading and label attributes in BuildNode, which would cause ->select to behave incorrectly on newly added nodes. 0.15 12/03/2009 Improved documentation. Added some real documentation for Pod::Abstract::Path. Had an attempt at fixing the compile issues for Perl 5.6. No significant changes in function. 0.14 03/03/2009 Improved paf filter suite. Bug fixes. paf defaults to "load as perldoc". Allow mandatory positional arguments for filters. 0.10 28/02/2009 Package build with functional library and "paf" utility. Pod-Abstract-0.26/Makefile.PL0000644000175000017500000000143115102047723014320 0ustar benlbenluse strict; use warnings; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'Pod::Abstract', AUTHOR => 'Ben Lilburne ', VERSION_FROM => 'lib/Pod/Abstract.pm', ABSTRACT_FROM => 'lib/Pod/Abstract.pm', EXE_FILES => [ 'bin/paf' ], ($ExtUtils::MakeMaker::VERSION >= 6.3002 ? ('LICENSE'=> 'perl') : ()), PL_FILES => {}, PREREQ_PM => { 'Test::More' => 0, 'Pod::Parser' => 0, 'IO::String' => 0, 'File::Temp' => 0, 'Scalar::Util' => 0, 'Task::Weaken' => 0, 'Module::Pluggable' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Pod-Abstract-*' }, ); Pod-Abstract-0.26/MANIFEST0000644000175000017500000000162215104342271013477 0ustar benlbenlbin/paf Changes lib/Pod/Abstract.pm lib/Pod/Abstract/BuildNode.pm lib/Pod/Abstract/Filter.pm lib/Pod/Abstract/Filter/add_podcmds.pm lib/Pod/Abstract/Filter/clear_podcmds.pm lib/Pod/Abstract/Filter/cut.pm lib/Pod/Abstract/Filter/uncut.pm lib/Pod/Abstract/Filter/overlay.pm lib/Pod/Abstract/Filter/unoverlay.pm lib/Pod/Abstract/Filter/sort.pm lib/Pod/Abstract/Filter/summary.pm lib/Pod/Abstract/Filter/find.pm lib/Pod/Abstract/Filter/number_sections.pm lib/Pod/Abstract/Filter/ptree.pm lib/Pod/Abstract/Node.pm lib/Pod/Abstract/Parser.pm lib/Pod/Abstract/Path.pm lib/Pod/Abstract/Serial.pm lib/Pod/Abstract/Tree.pm Makefile.PL MANIFEST README t/01_compile.t t/02_roundtrip.t t/03_buildnode.t t/04_matchnodes.t t/05_pod_detailed.t t/06_pa_example.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker)