| Pod-Tree documentation | Contained in the Pod-Tree distribution. |
Pod::Tree::Pod - Convert a Pod::Tree back to a POD
use Pod::Tree::Pod; $tree = new Pod::Tree; $dest = new IO::File; $dest = "file.pod"; $pod = new Pod::Tree::Pod $tree, $dest; $pod->translate;
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.
Pod::Tree::Pod can write HTML to either of 2 destinations.
new resolves $dest by checking these things,
in order:
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.
If $dest is not a reference, then it is taken to be the name of the file where the POD will be written.
new Pod::Tree::Pod $tree, $destCreates 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.
translateWrites the text of the POD. This method should only be called once.
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.
IO::File object.
It may be any object that has a print method.perl(1), Pod::Tree, Pod::Tree::Node
Steven McDougall, swmcd@world.std.com
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.
| 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__