Pod::ParseUtils - helpers for POD parsing and conversion

Pod-Parser documentation Contained in the Pod-Parser distribution.

Index

Code Index:

NAME

Top

Pod::ParseUtils - helpers for POD parsing and conversion

SYNOPSIS

Top

  use Pod::ParseUtils;

  my $list = new Pod::List;
  my $link = Pod::Hyperlink->new('Pod::Parser');

DESCRIPTION

Top

Pod::ParseUtils contains a few object-oriented helper packages for POD parsing and processing (i.e. in POD formatters and translators).

Pod::List

Pod::List can be used to hold information about POD lists (written as =over ... =item ... =back) for further processing. The following methods are available:

Pod::List->new()

Create a new list object. Properties may be specified through a hash reference like this:

  my $list = Pod::List->new({ -start => $., -indent => 4 });

See the individual methods/properties for details.

$list->file()

Without argument, retrieves the file name the list is in. This must have been set before by either specifying -file in the new() method or by calling the file() method with a scalar argument.

$list->start()

Without argument, retrieves the line number where the list started. This must have been set before by either specifying -start in the new() method or by calling the start() method with a scalar argument.

$list->indent()

Without argument, retrieves the indent level of the list as specified in =over n. This must have been set before by either specifying -indent in the new() method or by calling the indent() method with a scalar argument.

$list->type()

Without argument, retrieves the list type, which can be an arbitrary value, e.g. OL, UL, ... when thinking the HTML way. This must have been set before by either specifying -type in the new() method or by calling the type() method with a scalar argument.

$list->rx()

Without argument, retrieves a regular expression for simplifying the individual item strings once the list type has been determined. Usage: E.g. when converting to HTML, one might strip the leading number in an ordered list as <OL> already prints numbers itself. This must have been set before by either specifying -rx in the new() method or by calling the rx() method with a scalar argument.

$list->item()

Without argument, retrieves the array of the items in this list. The items may be represented by any scalar. If an argument has been given, it is pushed on the list of items.

$list->parent()

Without argument, retrieves information about the parent holding this list, which is represented as an arbitrary scalar. This must have been set before by either specifying -parent in the new() method or by calling the parent() method with a scalar argument.

$list->tag()

Without argument, retrieves information about the list tag, which can be any scalar. This must have been set before by either specifying -tag in the new() method or by calling the tag() method with a scalar argument.

Pod::Hyperlink is a class for manipulation of POD hyperlinks. Usage:

  my $link = Pod::Hyperlink->new('alternative text|page/"section in page"');

The Pod::Hyperlink class is mainly designed to parse the contents of the L<...> sequence, providing a simple interface for accessing the different parts of a POD hyperlink for further processing. It can also be used to construct hyperlinks.

The new() method can either be passed a set of key/value pairs or a single scalar value, namely the contents of a L<...> sequence. An object of the class Pod::Hyperlink is returned. The value undef indicates a failure, the error message is stored in $@.

This method can be used to (re)parse a (new) hyperlink, i.e. the contents of a L<...> sequence. The result is stored in the current object. Warnings are stored in the warnings property. E.g. sections like L<open(2)> are deprecated, as they do not point to Perl documents. L<DBI::foo(3p)> is wrong as well, the manpage section can simply be dropped.

Set/retrieve the textual value of the link. This string contains special markers P<> and Q<> that should be expanded by the translator's interior sequence expansion engine to the formatter-specific code to highlight/activate the hyperlink. The details have to be implemented in the translator.

$link->text()

This method returns the textual representation of the hyperlink as above, but without markers (read only). Depending on the link type this is one of the following alternatives (the + and * denote the portions of the text that are marked up):

  +perl+                    L<perl>
  *$|* in +perlvar+         L<perlvar/$|>
  *OPTIONS* in +perldoc+    L<perldoc/"OPTIONS">
  *DESCRIPTION*             L<"DESCRIPTION">

After parsing, this method returns any warnings encountered during the parsing process.

Just simple slots for storing information about the line and the file the link was encountered in. Has to be filled in manually.

$link->page()

This method sets or returns the POD page this link points to.

As above, but the destination node text of the link.

Sets or returns an alternative text specified in the link.

The node type, either section or item. As an unofficial type, there is also hyperlink, derived from e.g. L<http://perl.com>

Returns the link as contents of L<>. Reciprocal to parse().

Pod::Cache

Pod::Cache holds information about a set of POD documents, especially the nodes for hyperlinks. The following methods are available:

Pod::Cache->new()

Create a new cache object. This object can hold an arbitrary number of POD documents of class Pod::Cache::Item.

$cache->item()

Add a new item to the cache. Without arguments, this method returns a list of all cache elements.

$cache->find_page($name)

Look for a POD document named $name in the cache. Returns the reference to the corresponding Pod::Cache::Item object or undef if not found.

Pod::Cache::Item

Pod::Cache::Item holds information about individual POD documents, that can be grouped in a Pod::Cache object. It is intended to hold information about the hyperlink nodes of POD documents. The following methods are available:

Pod::Cache::Item->new()

Create a new object.

$cacheitem->page()

Set/retrieve the POD document name (e.g. "Pod::Parser").

$cacheitem->description()

Set/retrieve the POD short description as found in the =head1 NAME section.

$cacheitem->path()

Set/retrieve the POD file storage path.

$cacheitem->file()

Set/retrieve the POD file name.

$cacheitem->nodes()

Add a node (or a list of nodes) to the document's node list. Note that the order is kept, i.e. start with the first node and end with the last. If no argument is given, the current list of nodes is returned in the same order the nodes have been added. A node can be any scalar, but usually is a pair of node string and unique id for the find_node method to work correctly.

$cacheitem->find_node($name)

Look for a node or index entry named $name in the object. Returns the unique id of the node (i.e. the second element of the array stored in the node array) or undef if not found.

$cacheitem->idx()

Add an index entry (or a list of them) to the document's index list. Note that the order is kept, i.e. start with the first node and end with the last. If no argument is given, the current list of index entries is returned in the same order the entries have been added. An index entry can be any scalar, but usually is a pair of string and unique id.

AUTHOR

Top

Please report bugs using http://rt.cpan.org.

Marek Rouchal <marekr@cpan.org>, borrowing a lot of things from pod2man and pod2roff as well as other POD processing tools by Tom Christiansen, Brad Appleton and Russ Allbery.

SEE ALSO

Top

pod2man, pod2roff, Pod::Parser, Pod::Checker, pod2html

Pod-Parser documentation Contained in the Pod-Parser distribution. 
#############################################################################
# Pod/ParseUtils.pm -- helpers for POD parsing and conversion
#
# Copyright (C) 1999-2000 by Marek Rouchal. All rights reserved.
# This file is part of "PodParser". PodParser is free software;
# you can redistribute it and/or modify it under the same terms
# as Perl itself.
#############################################################################

package Pod::ParseUtils;
use strict;

use vars qw($VERSION);
$VERSION = '1.36'; ## Current version of this package
require  5.005;    ## requires this Perl version or later


#-----------------------------------------------------------------------------
# Pod::List
#
# class to hold POD list info (=over, =item, =back)
#-----------------------------------------------------------------------------

package Pod::List;

use Carp;


sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my %params = @_;
    my $self = {%params};
    bless $self, $class;
    $self->initialize();
    return $self;
}

sub initialize {
    my $self = shift;
    $self->{-file} ||= 'unknown';
    $self->{-start} ||= 'unknown';
    $self->{-indent} ||= 4; # perlpod: "should be the default"
    $self->{_items} = [];
    $self->{-type} ||= '';
}


# The POD file name the list appears in
sub file {
   return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}


# The line in the file the node appears
sub start {
   return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start};
}


# indent level
sub indent {
   return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent};
}


# The type of the list (UL, OL, ...)
sub type {
   return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
}


# The regular expression to simplify the items
sub rx {
   return (@_ > 1) ? ($_[0]->{-rx} = $_[1]) : $_[0]->{-rx};
}


# The individual =items of this list
sub item {
    my ($self,$item) = @_;
    if(defined $item) {
        push(@{$self->{_items}}, $item);
        return $item;
    }
    else {
        return @{$self->{_items}};
    }
}


# possibility for parsers/translators to store information about the
# lists's parent object
sub parent {
   return (@_ > 1) ? ($_[0]->{-parent} = $_[1]) : $_[0]->{-parent};
}


# possibility for parsers/translators to store information about the
# list's object
sub tag {
   return (@_ > 1) ? ($_[0]->{-tag} = $_[1]) : $_[0]->{-tag};
}

#-----------------------------------------------------------------------------
# Pod::Hyperlink
#
# class to manipulate POD hyperlinks (L<>)
#-----------------------------------------------------------------------------

package Pod::Hyperlink;


use Carp;

sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = +{};
    bless $self, $class;
    $self->initialize();
    if(defined $_[0]) {
        if(ref($_[0])) {
            # called with a list of parameters
            %$self = %{$_[0]};
            $self->_construct_text();
        }
        else {
            # called with L<> contents
            return unless($self->parse($_[0]));
        }
    }
    return $self;
}

sub initialize {
    my $self = shift;
    $self->{-line} ||= 'undef';
    $self->{-file} ||= 'undef';
    $self->{-page} ||= '';
    $self->{-node} ||= '';
    $self->{-alttext} ||= '';
    $self->{-type} ||= 'undef';
    $self->{_warnings} = [];
}


sub parse {
    my $self = shift;
    local($_) = $_[0];
    # syntax check the link and extract destination
    my ($alttext,$page,$node,$type,$quoted) = (undef,'','','',0);

    $self->{_warnings} = [];

    # collapse newlines with whitespace
    s/\s*\n+\s*/ /g;

    # strip leading/trailing whitespace
    if(s/^[\s\n]+//) {
        $self->warning('ignoring leading whitespace in link');
    }
    if(s/[\s\n]+$//) {
        $self->warning('ignoring trailing whitespace in link');
    }
    unless(length($_)) {
        _invalid_link('empty link');
        return;
    }

    ## Check for different possibilities. This is tedious and error-prone
    # we match all possibilities (alttext, page, section/item)
    #warn "DEBUG: link=$_\n";

    # only page
    # problem: a lot of people use (), or (1) or the like to indicate
    # man page sections. But this collides with L<func()> that is supposed
    # to point to an internal funtion...
    my $page_rx = '[\w.-]+(?:::[\w.-]+)*(?:[(](?:\d\w*|)[)]|)';
    # page name only
    if(/^($page_rx)$/o) {
        $page = $1;
        $type = 'page';
    }
    # alttext, page and "section"
    elsif(m{^(.*?)\s*[|]\s*($page_rx)\s*/\s*"(.+)"$}o) {
        ($alttext, $page, $node) = ($1, $2, $3);
        $type = 'section';
        $quoted = 1; #... therefore | and / are allowed
    }
    # alttext and page
    elsif(/^(.*?)\s*[|]\s*($page_rx)$/o) {
        ($alttext, $page) = ($1, $2);
        $type = 'page';
    }
    # alttext and "section"
    elsif(m{^(.*?)\s*[|]\s*(?:/\s*|)"(.+)"$}) {
        ($alttext, $node) = ($1,$2);
        $type = 'section';
        $quoted = 1;
    }
    # page and "section"
    elsif(m{^($page_rx)\s*/\s*"(.+)"$}o) {
        ($page, $node) = ($1, $2);
        $type = 'section';
        $quoted = 1;
    }
    # page and item
    elsif(m{^($page_rx)\s*/\s*(.+)$}o) {
        ($page, $node) = ($1, $2);
        $type = 'item';
    }
    # only "section"
    elsif(m{^/?"(.+)"$}) {
        $node = $1;
        $type = 'section';
        $quoted = 1;
    }
    # only item
    elsif(m{^\s*/(.+)$}) {
        $node = $1;
        $type = 'item';
    }

    # non-standard: Hyperlink with alt-text - doesn't remove protocol prefix, maybe it should?
    elsif(/^ \s* (.*?) \s* [|] \s* (\w+:[^:\s] [^\s|]*?) \s* $/ix) {
      ($alttext,$node) = ($1,$2);
      $type = 'hyperlink';
    }

    # non-standard: Hyperlink
    elsif(/^(\w+:[^:\s]\S*)$/i) {
        $node = $1;
        $type = 'hyperlink';
    }
    # alttext, page and item
    elsif(m{^(.*?)\s*[|]\s*($page_rx)\s*/\s*(.+)$}o) {
        ($alttext, $page, $node) = ($1, $2, $3);
        $type = 'item';
    }
    # alttext and item
    elsif(m{^(.*?)\s*[|]\s*/(.+)$}) {
        ($alttext, $node) = ($1,$2);
    }
    # must be an item or a "malformed" section (without "")
    else {
        $node = $_;
        $type = 'item';
    }
    # collapse whitespace in nodes
    $node =~ s/\s+/ /gs;

    # empty alternative text expands to node name
    if(defined $alttext) {
        if(!length($alttext)) {
          $alttext = $node || $page;
        }
    }
    else {
        $alttext = '';
    }

    if($page =~ /[(]\w*[)]$/) {
        $self->warning("(section) in '$page' deprecated");
    }
    if(!$quoted && $node =~ m{[|/]} && $type ne 'hyperlink') {
        $self->warning("node '$node' contains non-escaped | or /");
    }
    if($alttext =~ m{[|/]}) {
        $self->warning("alternative text '$node' contains non-escaped | or /");
    }
    $self->{-page} = $page;
    $self->{-node} = $node;
    $self->{-alttext} = $alttext;
    #warn "DEBUG: page=$page section=$section item=$item alttext=$alttext\n";
    $self->{-type} = $type;
    $self->_construct_text();
    1;
}

sub _construct_text {
    my $self = shift;
    my $alttext = $self->alttext();
    my $type = $self->type();
    my $section = $self->node();
    my $page = $self->page();
    my $page_ext = '';
    $page =~ s/([(]\w*[)])$// && ($page_ext = $1);
    if($alttext) {
        $self->{_text} = $alttext;
    }
    elsif($type eq 'hyperlink') {
        $self->{_text} = $section;
    }
    else {
        $self->{_text} = ($section || '') .
            (($page && $section) ? ' in ' : '') .
            "$page$page_ext";
    }
    # for being marked up later
    # use the non-standard markers P<> and Q<>, so that the resulting
    # text can be parsed by the translators. It's their job to put
    # the correct hypertext around the linktext
    if($alttext) {
        $self->{_markup} = "Q<$alttext>";
    }
    elsif($type eq 'hyperlink') {
        $self->{_markup} = "Q<$section>";
    }
    else {
        $self->{_markup} = (!$section ? '' : "Q<$section>") .
            ($page ? ($section ? ' in ':'') . "P<$page>$page_ext" : '');
    }
}


#' retrieve/set markuped text
sub markup {
    return (@_ > 1) ? ($_[0]->{_markup} = $_[1]) : $_[0]->{_markup};
}


# The complete link's text
sub text {
    return $_[0]->{_text};
}


# Set/retrieve warnings
sub warning {
    my $self = shift;
    if(@_) {
        push(@{$self->{_warnings}}, @_);
        return @_;
    }
    return @{$self->{_warnings}};
}


# The line in the file the link appears
sub line {
    return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line};
}

# The POD file name the link appears in
sub file {
    return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}


# The POD page the link appears on
sub page {
    if (@_ > 1) {
        $_[0]->{-page} = $_[1];
        $_[0]->_construct_text();
    }
    return $_[0]->{-page};
}


# The link destination
sub node {
    if (@_ > 1) {
        $_[0]->{-node} = $_[1];
        $_[0]->_construct_text();
    }
    return $_[0]->{-node};
}


# Potential alternative text
sub alttext {
    if (@_ > 1) {
        $_[0]->{-alttext} = $_[1];
        $_[0]->_construct_text();
    }
    return $_[0]->{-alttext};
}


# The type: item or headn
sub type {
    return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type};
}


# The link itself
sub link {
    my $self = shift;
    my $link = $self->page() || '';
    if($self->node()) {
        my $node = $self->node();
        $node =~ s/\|/E<verbar>/g;
        $node =~ s{/}{E<sol>}g;
        if($self->type() eq 'section') {
            $link .= ($link ? '/' : '') . '"' . $node . '"';
        }
        elsif($self->type() eq 'hyperlink') {
            $link = $self->node();
        }
        else { # item
            $link .= '/' . $node;
        }
    }
    if($self->alttext()) {
        my $text = $self->alttext();
        $text =~ s/\|/E<verbar>/g;
        $text =~ s{/}{E<sol>}g;
        $link = "$text|$link";
    }
    return $link;
}

sub _invalid_link {
    my ($msg) = @_;
    # this sets @_
    #eval { die "$msg\n" };
    #chomp $@;
    $@ = $msg; # this seems to work, too!
    return;
}

#-----------------------------------------------------------------------------
# Pod::Cache
#
# class to hold POD page details
#-----------------------------------------------------------------------------

package Pod::Cache;


sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = [];
    bless $self, $class;
    return $self;
}


sub item {
    my ($self,%param) = @_;
    if(%param) {
        my $item = Pod::Cache::Item->new(%param);
        push(@$self, $item);
        return $item;
    }
    else {
        return @{$self};
    }
}


sub find_page {
    my ($self,$page) = @_;
    foreach(@$self) {
        if($_->page() eq $page) {
            return $_;
        }
    }
    return;
}

package Pod::Cache::Item;


sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my %params = @_;
    my $self = {%params};
    bless $self, $class;
    $self->initialize();
    return $self;
}

sub initialize {
    my $self = shift;
    $self->{-nodes} = [] unless(defined $self->{-nodes});
}


# The POD page
sub page {
   return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page};
}


# The POD description, taken out of NAME if present
sub description {
   return (@_ > 1) ? ($_[0]->{-description} = $_[1]) : $_[0]->{-description};
}


# The file path
sub path {
   return (@_ > 1) ? ($_[0]->{-path} = $_[1]) : $_[0]->{-path};
}


# The POD file name
sub file {
   return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file};
}


# The POD nodes
sub nodes {
    my ($self,@nodes) = @_;
    if(@nodes) {
        push(@{$self->{-nodes}}, @nodes);
        return @nodes;
    }
    else {
        return @{$self->{-nodes}};
    }
}


sub find_node {
    my ($self,$node) = @_;
    my @search;
    push(@search, @{$self->{-nodes}}) if($self->{-nodes});
    push(@search, @{$self->{-idx}}) if($self->{-idx});
    foreach(@search) {
        if($_->[0] eq $node) {
            return $_->[1]; # id
        }
    }
    return;
}


# The POD index entries
sub idx {
    my ($self,@idx) = @_;
    if(@idx) {
        push(@{$self->{-idx}}, @idx);
        return @idx;
    }
    else {
        return @{$self->{-idx}};
    }
}


1;