Pod::Tree::Pod - Convert a Pod::Tree back to a POD


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

Index


Code Index:

NAME

Top

Pod::Tree::Pod - Convert a Pod::Tree back to a POD

SYNOPSIS

Top

  use Pod::Tree::Pod;

  $tree =  new Pod::Tree;

  $dest =  new IO::File;
  $dest = "file.pod";

  $pod  =  new Pod::Tree::Pod $tree, $dest;

  $pod->translate;

DESCRIPTION

Top

Pod::Tree::Pod converts a Pod::Tree back to a POD. The destination is fixed when the object is created. The translate method does the actual translation.

For convenience, Pod::Tree::Pod can write the POD to a variety of destinations. The new method resolves the $dest argument.

Destination resolution

Pod::Tree::Pod can write HTML to either of 2 destinations. new resolves $dest by checking these things, in order:

1

If $dest is a reference, then it is taken to be an IO::File object that is already open on the file where the POD will be written.

2

If $dest is not a reference, then it is taken to be the name of the file where the POD will be written.

METHODS

Top

$pod = new Pod::Tree::Pod $tree, $dest

Creates a new Pod::Tree::Pod object.

$tree is a Pod::Tree object that represents a POD. $pod writes the POD to $dest. See Destination resolution for details.

$pod->translate

Writes the text of the POD. This method should only be called once.

DIAGNOSTICS

Top

Pod::Tree::Pod::new: not enough arguments

(F) new called with fewer than 2 arguments.

Pod::Tree::HTML::new: Can't open $dest: $!

(F) The destination file couldn't be opened.

NOTES

Top

SEE ALSO

Top

perl(1), Pod::Tree, Pod::Tree::Node

AUTHOR

Top

Steven McDougall, swmcd@world.std.com

COPYRIGHT

Top


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

# Copyright (c) 2000-2003 by Steven McDougall.  This module is free
# software; you can redistribute it and/or modify it under the same
# terms as Perl itself.

package Pod::Tree::Pod;

use strict;
use IO::File;
use Pod::Tree;


sub new
{
    my($class, $tree, $dest) = @_;
    defined $dest or die "Pod::Tree::Pod::new: not enough arguments\n";

    my $file = _resolve_dest($dest); 

    my $pod  = { tree     => $tree,
		 root     => $tree->get_root,
		 file     => $file,
		 interior => 0,
		 link     => 0  };
    
    bless $pod, $class
}


sub _resolve_dest
{
    my $dest = shift;

    ref $dest and return $dest;

    my $fh = new IO::File;
    $fh->open(">$dest") or die "Pod::Tree::Pod::new: Can't open $dest: $!\n";
    $fh
}


sub translate
{
    my $pod  = shift;
    my $root = $pod->{root};
    $pod->_emit_children($root);
}


sub _emit_children
{
    my($pod, $node) = @_;

    my $children = $node->get_children;

    for my $child (@$children)
    {
	$pod->_emit_node($child);
    }
}


sub _emit_siblings
{
    my($pod, $node) = @_;

    my $siblings = $node->get_siblings;

    for my $sibling (@$siblings)
    {
	$pod->_emit_node($sibling);
    }
}


sub _emit_node
{
    my($pod, $node) = @_;
    my $type = $node->{type};

    for ($type)
    {
	/code/     and $pod->_emit_code    ($node);
	/command/  and $pod->_emit_command ($node);
	/for/      and $pod->_emit_for     ($node);
	/item/     and $pod->_emit_item    ($node);
	/list/     and $pod->_emit_list    ($node);
	/ordinary/ and $pod->_emit_ordinary($node);
	/sequence/ and $pod->_emit_sequence($node);
	/text/     and $pod->_emit_text    ($node);
	/verbatim/ and $pod->_emit_verbatim($node);
    }
}


sub _emit_code
{
    my($pod, $node) = @_;
    my $file = $pod->{file};
    my $text = $node->get_text;

    $file->print($text);
}


sub _emit_command
{
    my($pod, $node) = @_;
    my $file = $pod->{file};
    my $raw  = $node->get_raw;

    $file->print($raw);
}


sub _emit_for
{
    my($pod, $node) = @_;
    my $file        = $pod->{file};
    my $brackets    = $node->get_brackets;

    $file->print($brackets->[0]);
    $file->print($node->get_text);
    $file->print($brackets->[1]) if $brackets->[1];
}


sub _emit_item
{
    my($pod, $node) = @_;
    my $file      = $pod->{file};

    $file->print("=item ");
    $pod->_emit_children($node);

    $pod->_emit_siblings($node);
}


sub _emit_list
{
    my($pod, $node) = @_;
    my $file = $pod->{file};

    my $over = $node->get_raw;
    $file->print($over);

    $pod->_emit_children($node);

    my $back = $node->get_back;
    $back and 
	$file->print($back->get_raw);
}


sub _emit_ordinary
{
    my($pod, $node) = @_;

    $pod->_emit_children($node);
}


sub _emit_sequence
{
    my($pod, $node) = @_;

    $pod->{interior}++;

    for ($node->get_letter)
    {
	/I|B|C|E|F|S|X/ and $pod->_emit_element($node), last;
	/L/             and $pod->_emit_link   ($node), last;
    }

    $pod->{interior}--;
}


sub _emit_element
{
    my($pod, $node) = @_;

    my $letter = $node->get_letter;
    my $file   = $pod->{file};

    $file->print("$letter<");
    $pod->_emit_children($node);
    $file->print(">");
}


sub _emit_link
{
    my($pod, $node) = @_;

    my $file = $pod->{file};

    $file->print("L<");

    my $children = $node->get_raw_kids;
    for my $child (@$children)
    {
	$pod->_emit_node($child);
    }

    $file->print(">");
}


sub _emit_link_hide
{
    my($pod, $node) = @_;

    my $file     = $pod->{file};
    my $target   = $node->get_target;
    my $page     = $target->get_page;
    my $section  = $target->get_section;
    my $slash    = $section ? '/' : '';
    my $link     = "$page$slash$section";

    if ($link eq $node->get_deep_text)
    {
	$file->print("L<");
	$pod->_emit_children($node);
	$file->print(">");
    }
    else
    {
	$pod->{link}++;

	$file->print("L<");
	$pod->_emit_children($node);

	$page    = $pod->_escape($page   );
	$section = $pod->_escape($section);
	$file->print("|$page$slash$section>");

	$pod->{link}--;
    }
}


sub _emit_text
{
    my($pod, $node) = @_;
    my $file = $pod->{file};
    my $text = $node->get_text;

    $text = $pod->_escape($text);
    $file->print($text);
}


sub _escape
{
    my($pod, $text) = @_;

    $text =~ s/^=(\w)/=Z<>$1/;

    if ($pod->{interior})
    {
	$text =~ s/([A-Z])</$1E<lt>/g;
	$text =~ s/>/E<gt>/g;
    }

    if ($pod->{link})
    {
	$text =~ s(\|)(E<verbar>)g;
	$text =~ s(/)(E<sol>)g;
    }

    $text =~ s/([\x80-\xff])/sprintf("E<%d>", ord($1))/eg;

    $text
}


sub _emit_verbatim
{
    my($pod, $node) = @_;
    my $file = $pod->{file};
    my $text = $node->get_text;

    $file->print($text);
}

1

__END__