File Coverage

blib/lib/Pod/DocBook.pm

Criterion	Covered	Total	%
statement	326	398	81.9
branch	166	216	76.8
condition	40	66	60.6
subroutine	28	28	100.0
pod	1	8	12.5
total	561	716	78.3

package Pod::DocBook;

use 5.006001;
use strict;
use warnings;

use Digest::MD5 'md5_hex';
use Pod::Parser;
use Pod::ParseLink;
use Text::ParseWords;
use Text::Wrap;

our @ISA     = qw(Pod::Parser);
our $VERSION = '1.2';

#----------------------------------------------------------------------
# overridden Pod::Parser methods
#----------------------------------------------------------------------

sub initialize
{
    $_[0]->errorsub ('error_msg');
    $_[0]->{'Pod::DocBook::errors'} = [];
}

sub begin_pod
{
    my ($parser) = @_;
    my $out_fh = $parser->output_handle ();

    print $out_fh "{doctype} ",
      qq#PUBLIC "-//OASIS//DTD DocBook V4.2//EN">\n# if $parser->{header};

    print $out_fh join ("\n",
			'"), "\n";

    $parser->{indentlevel} = 1;

    if ($parser->{doctype} eq 'refentry') {
	print $out_fh join ('',
			     "\n",
			     $parser->_indent (),
			     "\n",
			     $parser->_current_indent (),
			     "$parser->{title}",
			     "\n",
			     $parser->_outdent (),
			     "\n");
    }

    else {
	print $out_fh "<$parser->{doctype}>$parser->{title}\n";
    }
}

sub end_pod
{
    my ($parser) = @_;
    my $out_fh = $parser->output_handle ();

    $parser->_transition ('THE END');

    # end document
    print $out_fh "{doctype}>\n";
    if (@{$parser->{'Pod::DocBook::errors'}}) {
	print $out_fh "\n\n";
    }
}

sub command {
    my ($parser, $command, $paragraph, $line_num) = @_;
    my $out_fh = $parser->output_handle ();

    return if $command eq 'pod';

    $paragraph =~ s/\s+$//s;
    $paragraph = $parser->interpolate ($paragraph, $line_num);
    $paragraph = _fix_chars ($paragraph);

    if ($command =~ /^head[1-4]/) {
	$parser->_transition ($command);
	$parser->_handle_head ($command, $paragraph, $line_num);
    }

    elsif ($command eq 'begin') {
	$parser->_transition ("begin $paragraph");
	push (@{$parser->{'Pod::DocBook::state'}}, "begin $paragraph");
    }

    elsif ($command eq 'end') {
	$parser->_transition ("end $paragraph");
    }

    elsif ($command eq 'for') {
	$parser->_transition ('for');
	if ($paragraph =~ /^(:\S+|docbook)/) {
	    $paragraph =~ s/$1\s+//;
	    print $out_fh $paragraph, "\n";
	}
    }

    elsif ($command eq 'over') {
	$parser->_transition ('over');
	push @{$parser->{'Pod::DocBook::state'}}, 'over';
    }

    elsif ($command eq 'item') {
	$parser->_transition ('item');
	$parser->_handle_item ($paragraph, $line_num);
    }

    elsif ($command =~ /^back/) {
	$parser->_transition ('back');
    }

    else {
	my $file = $parser->input_file ();
	$parser->error_msg ("unknown command `$command' at",
			    "line $line_num in file $file");
    }
}

sub textblock {
    my ($parser, $paragraph, $line_num) = @_;
    my $out_fh   = $parser->output_handle ();
    my $state    = pop @{$parser->{'Pod::DocBook::state'}};
    my $para_out = '';

    $state = '' unless defined $state;
    $paragraph =~ s/\s+$//s unless $state eq 'begin docbook';

    unless ($state eq 'begin docbook' || $state eq 'begin table') {
	$paragraph = $parser->interpolate ($paragraph, $line_num);
	$paragraph = _fix_chars ($paragraph);
    }

    if ($state eq 'name') {
	my ($name, $purpose) = split (/\s*-\s*/, $paragraph, 2);

	$para_out = join ('',
			  $parser->_indent (),
			  "\n",
			  $parser->_current_indent (),
			  "$name\n",
			  "$purpose\n",
			  $parser->_outdent (),
			  "\n");
    }

    elsif ($state eq 'synopsis+') {
	$para_out = join ('',
			  $parser->_indent (),
			  "\n",
			  "$paragraph\n");

	push @{$parser->{'Pod::DocBook::state'}}, 'synopsis';
    }

    elsif ($state eq 'synopsis') {
	$para_out = "$paragraph\n";
	push @{$parser->{'Pod::DocBook::state'}}, $state;
    }

    elsif ($state eq 'begin docbook') {
	push @{$parser->{'Pod::DocBook::dbpara'}}, $paragraph;
	push @{$parser->{'Pod::DocBook::state'}}, $state;
    }

    elsif ($state eq 'begin table') {
	$parser->_handle_table ($paragraph, $line_num);
	push @{$parser->{'Pod::DocBook::state'}}, $state;
    }

    elsif ($state =~ /^begin [^:]/) {
	push @{$parser->{'Pod::DocBook::state'}}, $state;
    }

    elsif ($state eq 'over') {
	local $Text::Wrap::huge  = 'overflow';   # don't break tags

	$paragraph =~ s/\s*\n\s*/ /g;           # don't just wrap, fill

	$para_out = join ('',
			  $parser->_indent (),
			  "\n",
			  $parser->_indent (),
			  "\n",
			  wrap (' ' x ($parser->{spaces} *
				       $parser->{indentlevel}),
				' ' x ($parser->{spaces} *
				       $parser->{indentlevel}),
				$paragraph),
			  "\n",
			  $parser->_outdent (),
			  "\n");

	push @{$parser->{'Pod::DocBook::state'}}, 'indent';
    }

    else {
	local $Text::Wrap::huge = 'overflow';   # don't break tags

	print $out_fh "]]>\n" if $state eq 'verbatim';

	$paragraph =~ s/\s*\n\s*/ /g;           # don't just wrap, fill

	$para_out = join ('',
			  $parser->_indent (),
			  "\n",
			  wrap (' ' x ($parser->{spaces} *
				       $parser->{indentlevel}),
				' ' x ($parser->{spaces} *
				       $parser->{indentlevel}),
				$paragraph),
			  "\n",
			  $parser->_outdent (),
			  "\n");

	$state =~ s/\+$//;
	push @{$parser->{'Pod::DocBook::state'}}, $state
	  unless ($state eq 'verbatim' || $state eq '');
    }

    # fix double quotes in ordinary paragraphs if asked to
    if ($state !~ /^begin/ &&
	$parser->{fix_double_quotes} && $para_out =~ /"/) {
	my @protected;
	while ($para_out =~ m#(<[^>"]*".+?>)#s) {
	    # don't modify things that look like tags with quotes inside
	    my $protect = $1 || $2;
	    my $replace = quotemeta ($protect);

	    $para_out =~ s/$replace/\376/;
	    push @protected, $protect;
	}

	$para_out =~ s!"(.+?)"!$1!sg;
	foreach my $protect (@protected) {
	    $para_out =~ s/\376/$protect/;
	}
    }

    print $out_fh $para_out;
}

sub verbatim {
    my ($parser, $paragraph, $line_num) = @_;
    my $out_fh = $parser->output_handle ();
    my $state  = pop @{$parser->{'Pod::DocBook::state'}} || '';
    my (@lines, $min_leader);

    $paragraph =~ s/\s+$//s unless $state eq 'begin docbook';

    @lines = split (/\n/, $paragraph);
    foreach my $line (@lines) {
	# expand tabs (see perldoc -q 'expand tabs')
	1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;

	# find the minimum-length whitespace leader for this paragraph
	my ($leader) = $line =~ /^( +)/;
	$leader ||= '';
	$min_leader  = $leader
	  if (!defined $min_leader ||
	      length ($leader) < length ($min_leader));
    }

    $paragraph = join ("\n", @lines);

    # strip the minimum-length whitespace leader from every line
    $min_leader ||= '';
    $paragraph =~ s/^$min_leader//mg;

    if (!defined $state) {
	print $out_fh $parser->_current_indent (),
	  "
	push @{$parser->{'Pod::DocBook::state'}}, 'verbatim';
    }

    elsif ($state eq 'name') {
	my ($name, $purpose) = split (/\s*-\s*/, $paragraph, 2);

	print $out_fh join ('',
			    $parser->_indent (),
			    "refnamediv>\n",
			    $parser->_current_indent (),
			    "$name\n",
			    $parser->_current_indent (),
			    "$purpose\n",
			    $parser->_outdent (),
			    "\n");
    }

    elsif ($state eq 'synopsis+') {
	print $out_fh join ('',
			    $parser->_indent (),
			    "\n",
			    "$paragraph\n");

	push @{$parser->{'Pod::DocBook::state'}}, 'synopsis';
    }

    elsif ($state eq 'synopsis') {
	print $out_fh "$paragraph\n";
	push @{$parser->{'Pod::DocBook::state'}}, $state;
    }

    elsif ($state eq 'begin docbook') {
	push @{$parser->{'Pod::DocBook::dbpara'}}, $paragraph;
	push @{$parser->{'Pod::DocBook::state'}}, $state;
    }

    elsif ($state =~ /^begin [^:]/) {
	push @{$parser->{'Pod::DocBook::state'}}, $state;
    }

    elsif ($state eq 'over') {
	print $out_fh join ('',
			    $parser->_indent (),
			    "\n",
			    $parser->_current_indent (),
			    "

	push @{$parser->{'Pod::DocBook::state'}}, 'indent';
	push @{$parser->{'Pod::DocBook::state'}}, 'verbatim';
    }

    elsif ($state eq 'verbatim') {
	print $out_fh "\n\n$paragraph";
	push @{$parser->{'Pod::DocBook::state'}}, $state;
    }

    else {
	print $out_fh $parser->_current_indent (),
	  "
	$state =~ s/\+$//;
	push @{$parser->{'Pod::DocBook::state'}}, $state;
	push @{$parser->{'Pod::DocBook::state'}}, 'verbatim';
    }
}

sub interior_sequence {
    my ($parser, $command, $argument, $seq) = @_;
    my $out_fh = $parser->output_handle ();
    my ($string, @parents);

    # nothing is ever allowed to be nested inside of E<>, or Z<>
    if (my $parent = $seq->nested ()) {
	if ($parent->cmd_name () eq 'E' || $parent->cmd_name () eq 'Z') {
	    my ($file, $line) = $seq->file_line ();
	    $parser->error_msg ("formatting code `$command' nested within",
				"`" . $parent->cmd_name () . "'",
				"at line $line in file $file");
	    return $seq->raw_text ();
	}
    }

    $argument = '' unless defined $argument;

    # the substring "\37632\377" is a space character protected
    # against translation in S<>; other characters are protected at
    # the end of this function, and all protected characters are
    # de-protected in _fix_chars ()

    if ($command eq 'I') {
	$string = qq!$argument!;
    }

    elsif ($command eq 'B') {
	$string = qq!$argument!;
    }

    elsif ($command eq 'C') {
	$string = qq!! .
	  "";
    }

    elsif ($command eq 'L') {
	$string = $parser->_handle_L ($argument, $seq);
    }

    elsif ($command eq 'E') {
	$string = $parser->_handle_E ($argument, $seq);
    }

    elsif ($command eq 'F') {
	$string = "$argument";
    }

    elsif ($command eq 'S') {
	$argument =~ s/\s(?![^<]*>)/ /g;
	$string = $argument;
    }

    elsif ($command eq 'X') {
	$string = "$argument";
    }

    elsif ($command eq 'Z') {
	$string = '';
    }

    else {
	my ($file, $line) = $seq->file_line ();
	$parser->error_msg ("unknown formatting code `$command' at line",
			    "in file $file");
	$string = $seq->raw_text ();
    }

    # protect &, <, and > characters from later processing
    # I got this from the first edition Camel Book
    unless ($seq->nested ()) {
	# just do this once, at the top of a subtree so we can
	# report more meaningful errors along the way
	foreach my $char ('&', '<', '>') {
	    $string =~ s/$char/"\376" . ord ($char) . "\377"/eg;
	}
    }

    return $string;
}

#----------------------------------------------------------------------
# other public methods
#----------------------------------------------------------------------

sub error_msg
{
    my $parser = shift;

    push (@{$parser->{'Pod::DocBook::errors'}}, join (' ', @_));
}

#----------------------------------------------------------------------
# private methods and helper functions
#----------------------------------------------------------------------

sub _indent
{
    my ($parser) = @_;
    return (' ' x ($parser->{spaces} * $parser->{indentlevel}++));
}

sub _outdent
{
    my ($parser) = @_;
    return (' ' x (--$parser->{indentlevel} * $parser->{spaces}));
}

sub _current_indent
{
    my $parser = shift;

    return ' ' x ($parser->{spaces} * $parser->{indentlevel});
}

sub _make_id
{
    my $parser = shift;
    my $string = join ('-', $parser->{doctype}, $parser->{title}, $_[0]);

    $string =~ s//$1/g;
    $string =~ s/<.+?>//g;

    return 'ID-' . md5_hex ($string);
}

sub _handle_L
{
    my ($parser, $argument, $seq) = @_;
    my $node = $seq;

    # look all the way up the subtree to see if any ancestor is an 'L'
    while ($node = $node->nested ()) {
	if ($node->cmd_name () eq 'L') {
	    my ($file, $line) = $seq->file_line ();
	    $parser->error_msg ("formatting code `L' nested within `L' at",
				"line $line in file $file");
	    return $seq->raw_text ();
	}
    }

    # the substring "\37632\377" is a space character protected
    # against translation in S<>; other characters are protected at
    # the end of interior_sequence (), and all protected characters
    # are de-protected in _fix_chars ()

    my ($text, $inferred, $name, $section, $type) = parselink ($argument);

    if ($type eq 'url') {
	return qq!$inferred!;
    }

    else {
	# types 'man' and 'pod' are handled the same way
	if (defined $section && ! defined $name) {
	    my $id = $parser->_make_id ($section);

	    $section = $text if defined $text;
	    return (qq!$section! .
		    "");
	}

	elsif (defined $text) {
	    return $text;
	}

	elsif (defined $name) {
	    my $string;
	    if ($name =~ /(.+?)\((.+)\)/) {
		$string = $parser->_manpage ($1, $2);
	    }

	    else {
		$string = $parser->_manpage ($name);
	    }

	    if (defined $section) {
		return "$section in $string";
	    }

	    else {
		return $string;
	    }
	}

	else {
	    my ($file, $line) = $seq->file_line ();
	    $parser->error_msg ("empty L<> at line",
				"$line in file $file\n");
	    return $seq->raw_text ();
	}
    }
}

sub _handle_E
{
    my ($parser, $argument, $seq) = @_;

    if ($argument !~ /\A\w+\z/) {
	my ($file, $line) = $seq->file_line ();
	$parser->error_msg ("invalid escape `$argument'",
			    "at line $line in file $file\n");
	return $seq->raw_text ();
    }

    elsif ($argument eq 'verbar') {
	return '|';
    }

    elsif ($argument eq 'sol') {
	return '/';
    }

    elsif ($argument eq 'lchevron' || $argument eq 'laquo') {
	return '«';
    }

    elsif ($argument eq 'rchevron' || $argument eq 'raquo') {
	return '»';
    }

    elsif ($argument =~ /^0x/) {
	return ('&#' . hex ($argument) . ';');
    }

    elsif ($argument =~ /^0/) {
	return ('&#' . oct ($argument) . ';');
    }

    elsif ($argument =~ /^\d+$/) {
	return "&#$argument;";
    }

    else {
	return "&$argument;";
    }
}

sub _handle_head
{
    my ($parser, $command, $paragraph, $line_num) = @_;
    my $out_fh        = $parser->output_handle ();

    if ($parser->{doctype} eq 'refentry' &&
	$command eq 'head1' && $paragraph eq 'NAME') {
	push @{$parser->{'Pod::DocBook::state'}}, 'name';
    }

    elsif ($parser->{doctype} eq 'refentry' &&
	   $command eq 'head1' && $paragraph eq 'SYNOPSIS') {
	push @{$parser->{'Pod::DocBook::state'}}, 'synopsis+';
    }

    else {
	push @{$parser->{'Pod::DocBook::state'}}, "$command+";
	my $id = $parser->_make_id ($paragraph);

	if ($parser->{doctype} eq 'refentry') {
	    print $out_fh $parser->_indent (),
	      qq!$paragraph\n!;
	}

	else {
	    print $out_fh $parser->_indent (),
	      qq!$paragraph\n!;
	}
    }
}

sub _handle_item
{
    my ($parser, $paragraph, $line_num) = @_;
    my $out_fh = $parser->output_handle ();
    my $state  = pop @{$parser->{'Pod::DocBook::state'}};

    $state = '' unless defined $state;

    if ($state eq 'verbatim') {
	print $out_fh "]]>\n";
	$state = pop @{$parser->{'Pod::DocBook::state'}};
	$state = '' unless defined $state;
    }

    if ($state =~ /list\+$/) {
	print $out_fh $parser->_current_indent (), "\n";
    }

    if ($state eq 'over') {
	# first item
	if (!defined ($paragraph) ||
	    $paragraph =~ /^\s*$/  ||
	    $paragraph eq '*') {
	    print $out_fh join ('',
				$parser->_indent (),
				"\n",
				$parser->_indent (),
				"\n",
				$parser->_indent (),
				"\n");
	    $state = 'list+';
	}

	elsif ($paragraph =~ /^([1aAiI])\.?$/) {
	    my $numeration = { 1 => 'arabic',
			       a => 'loweralpha',
			       A => 'upperalpha',
			       i => 'lowerroman',
			       I => 'upperroman' }->{$1};

	    print $out_fh join ('',
				$parser->_indent (),
				"\n",
				$parser->_indent (),
				qq!\n!,
				$parser->_indent (),
				"\n");
	    $state = 'olist+';
	}

	else {
	    my $id = $parser->_make_id ($paragraph);
	    print $out_fh join ('',
				$parser->_indent (),
				"\n",
				$parser->_indent (),
				"\n",
				$parser->_indent (),
				"\n",
				$parser->_current_indent (),
				qq!$paragraph\n!,
				$parser->_indent (),
				qq!\n!);
	    $state = 'vlist+';
	}
    }

    elsif ($state =~ /^o?list/) {
	print $out_fh join ('',
			    $parser->_outdent (),
			    "\n",
			    $parser->_indent (),
			    "\n");
	$state = "$state+" unless $state =~ /\+$/;
    }

    elsif ($state =~ /^vlist/) {
	my $id = $parser->_make_id ($paragraph);
	print $out_fh join ('',
			    $parser->_outdent (),
			    "\n",
			    $parser->_outdent (),
			    "\n",
			    $parser->_indent (),
			    "\n",
			    $parser->_current_indent (),
			    qq!$paragraph\n!,
			    $parser->_indent (),
			    "\n");
	$state = 'vlist+';
    }

    else {
	$parser->error_msg ('=item must be inside an',
			    '=over ... =back region',
			    "at line $line_num in file",
			    $parser->input_file ());
    }

    push @{$parser->{'Pod::DocBook::state'}}, $state;
}

sub _transition
{
    my ($parser, $what) = @_;
    my $out_fh = $parser->output_handle ();
    my ($level);

    # $level helps us determine what to do when we see =head
    # 1-4 are the valid numbers after '=head', so 0 and 5
    # are safe to use to mark out-of-bounds on either side
    if ($what eq 'THE END') {
	$level = 0;
    }

    elsif ($what =~ /^head(\d)/) {
	$level = $1;
    }

    else {
	$level = 5;
    }

    while (my $state = pop @{$parser->{'Pod::DocBook::state'}}) {
	if (($what eq 'item' || $what eq 'over') &&
	    ($state eq 'over' || $state =~ /^(o|v)?list/)) {
	    # these are treated specially in _handle_item ()
	    push @{$parser->{'Pod::DocBook::state'}}, $state;
	    last;
	}

	if ($state =~ /list\+$/) {
	    print $out_fh $parser->_current_indent (), "\n";
	    $state =~ s/\+$//;
	}

	if ($state =~ /^head(\d)/) {
	    my $prev_level = $1;

	    if ($level > $prev_level) {
		# embed in a previously opened section (i.e. restore
		# state and continue processing the document)

		# the enclosing section is no longer empty
		$state =~ s/\+$//;
		push @{$parser->{'Pod::DocBook::state'}}, $state;
		last;
	    }

	    else {
		if ($state =~ /\+$/) {
		    # prevent empty sections
		    print $out_fh $parser->_current_indent (),
		      "\n";
		}

		# close the previous section and continue with the stack
		if ($parser->{doctype} eq 'refentry') {
		    print $out_fh $parser->_outdent (), "\n";
		}

		else {
		    print $out_fh $parser->_outdent (), "\n";
		}
	    }
	}

	elsif ($state eq 'indent') {
	    print $out_fh $parser->_outdent (), "\n";

	    push @{$parser->{'Pod::DocBook::state'}}, 'over'
	      if ($what eq 'item');

	    last if $what eq 'back';
	}

	elsif ($state eq 'list') {
	    print $out_fh join ('',
				$parser->_outdent (),
				"\n",
				$parser->_outdent (),
				"\n",
				$parser->_outdent (),
				"\n");

	    last if $what eq 'back';
	}

	elsif ($state eq 'olist') {
	    print $out_fh join ('',
				$parser->_outdent (),
				"\n",
				$parser->_outdent (),
				"\n",
				$parser->_outdent (),
				"\n");

	    last if $what eq 'back';
	}

	elsif ($state eq 'vlist') {
	    print $out_fh join ('',
				$parser->_outdent (),
				"\n",
				$parser->_outdent (),
				"\n",
				$parser->_outdent (),
				"\n",
				$parser->_outdent (),
				"\n");

	    last if $what eq 'back';
	}

	elsif ($state =~ /^synopsis/) {
	    print $out_fh join ('',
				$parser->_indent (),
				"\n",
				$parser->_current_indent (),
				"\n")
	      if $state eq 'synopsis+';

	    print $out_fh $parser->_outdent (), "\n";
	}

	elsif ($state eq 'name') {
	    print $out_fh join ('',
				$parser->_indent (),
				"\n",
				$parser->_indent (),
				"\n",
				$parser->_current_indent (),
				"\n",
				$parser->_outdent (),
				"\n");
	}

	elsif ($state eq 'verbatim') {
	    print $out_fh "]]>\n";
	}

	elsif ($state =~ /^begin (.+)/) {
	    my $begin_format = $1;
	    if ($what =~ /^end (.+)/) {
		my $end_format = $1;

		if ($end_format eq $begin_format) {
		    if ($end_format eq 'docbook') {
			my $paragraph =
			  join ('',
				@{$parser->{'Pod::DocBook::dbpara'}});
			$paragraph =~ s/\s+$//;
			print $out_fh $paragraph, "\n";
			$parser->{'Pod::DocBook::dbpara'} = [];
		    }

		    last;
		}

		else {
		    # this is bad POD, but we do what we can
		    # (maybe we'll find the begin we're looking for
		    #  deeper in the stack)
		    $parser->error_msg ("`=end $end_format' found",
					'but current region opened with',
					"`=begin $begin_format'");
		}
	    }

	    elsif ($what eq 'THE END') {
		# this is bad POD, but we do what we can
		$parser->error_msg ("no matching `=end' for",
				    "`=begin $begin_format'");

		# we've got the data stored; might as well use it
		if ($begin_format eq 'docbook') {
		    my $paragraph =
		      join ('',
			    @{$parser->{'Pod::DocBook::dbpara'}});
		    $paragraph =~ s/\s+$//;
		    print $out_fh $paragraph, "\n";
		    $parser->{'Pod::DocBook::dbpara'} = [];
		}
	    }

	    else {
		push @{$parser->{'Pod::DocBook::state'}}, $state;
		last;
	    }
	}

	elsif ($state eq 'over') {
	    next;
	}

	else {
	    $parser->error_msg ("encountered unknown state `$state'",
				'(this should never happen)');
	}

    }
}

sub _handle_table
{
    my ($parser, $paragraph, $line_num) = @_;
    my $out_fh = $parser->output_handle ();
    my (@rows, $columns, $title);

    foreach my $row (split (/\n/, $paragraph)) {
	my @fields = quotewords (',', 0, $row);

	$columns = @fields
	  if (!defined $columns || @fields > $columns);
	push @rows, [@fields];
    }

    # the first row specifies the title
    $title = $rows[0]->[0];

    print $out_fh join ('',
			$parser->_indent (),
			"\n", \n", \n"); \n"; \n", 




947




 





 





 





 





 





 



 			$parser->_current_indent (), 




948




 





 





 





 





 





 



 			"$title\n", 




949




 





 





 





 





 





 



 			$parser->_indent (), 




950




 





 





 





 





 





 



 			qq!\n!); 




951




 





 





 





 





 





 



   




952




 





 





 





 





 





 



     # the second row specifies column alignments 




953




2





 





 





 





 





6



     foreach my $spec (@{$rows[1]}) { 




 




2





 





 





 





 





5



   




954




6





 





 





 





 





11



 	print $out_fh $parser->_current_indent (), '




955




 





 





 





 





 





 



   




956




6




  
100
  




 





 





 





10



 	if (grep { $_ eq $spec } qw(left right center justify)) { 




 




24





 





 





 





 





47



   




957




5





 





 





 





 





13



 	    print $out_fh qq!align="$spec">\n!; 




958




 





 





 





 





 





 



 	} 




959




 





 





 





 





 





 



   




960




 





 





 





 





 





 



 	else { 




961




1





 





 





 





 





2



 	    print $out_fh qq!align="left">\n!; 




962




1





 





 





 





 





12



 	    $parser->error_msg ("unknown colspec `$spec' in table", 




963




 





 





 





 





 





 



 				$title, "at line $line_num in file", 




964




 





 





 





 





 





 



 				$parser->input_file ()); 




965




 





 





 





 





 





 



 	} 




966




 





 





 





 





 





 



     } 




967




 





 





 





 





 





 



   




968




 





 





 





 





 





 



     # the third row (first row of data) is the table header 




969




2





 





 





 





 





7



     print $out_fh join ('', 




970




 





 





 





 





 





 



 			$parser->_indent (), 




971




 





 





 





 





 





 



 			"




972




 





 





 





 





 





 



 			$parser->_indent (), 




973




 





 





 





 





 





 



 			"\n"); 




974




 





 





 





 





 





 



   




975




2





 





 





 





 





5



     foreach my $field (@{$rows[2]}) { 




 




2





 





 





 





 





5



   




976




6





 





 





 





 





10



 	print $out_fh $parser->_current_indent (), 




977




 





 





 





 





 





 



 	  "$field\n"; 




978




 





 





 





 





 





 



     } 




979




 





 





 





 





 





 



   




980




2





 





 





 





 





7



     print $out_fh join ('', 




981




 





 





 





 





 





 



 			$parser->_outdent (), 




982




 





 





 





 





 





 



 			"\n", 




983




 





 





 





 





 





 



 			$parser->_outdent (), 




984




 





 





 





 





 





 



 			"




985




 





 





 





 





 





 



   




986




 





 





 





 





 





 



     # the remaining rows are the table body 




987




2





 





 





 





 





6



     print $out_fh $parser->_indent (), "




988




 





 





 





 





 





 



   




989




2





 





 





 





 





8



     foreach my $row (@rows[3..$#rows]) { 




990




10





 





 





 





 





19



 	print $out_fh $parser->_indent (), "\n"; 




991




 





 





 





 





 





 



   




992




10





 





 





 





 





18



 	foreach my $field (@$row) { 




993




30





 





 





 





 





52



 	    print $out_fh $parser->_current_indent (), 




994




 





 





 





 





 





 



 	      "$field\n"; 




995




 





 





 





 





 





 



 	} 




996




 





 





 





 





 





 



   




997




10





 





 





 





 





21



 	print $out_fh $parser->_outdent (), "\n"; 




998




 





 





 





 





 





 



     } 




999




 





 





 





 





 





 



   




1000




2





 





 





 





 





7



     print $out_fh join ('', 




1001




 





 





 





 





 





 



 			$parser->_outdent (), 




1002




 





 





 





 





 





 



 			"




1003




 





 





 





 





 





 



 			$parser->_outdent (), 




1004




 





 





 





 





 





 



 			"\n", 




1005




 





 





 





 





 





 



 			$parser->_outdent (), 




1006




 





 





 





 





 





 



 			"\n");
			$parser->_current_indent (),
			"$title\n",
			$parser->_indent (),
			qq!\n!);

    # the second row specifies column alignments
    foreach my $spec (@{$rows[1]}) {
	print $out_fh $parser->_current_indent (), '

	if (grep { $_ eq $spec } qw(left right center justify)) {
	    print $out_fh qq!align="$spec">\n!;
	}

	else {
	    print $out_fh qq!align="left">\n!;
	    $parser->error_msg ("unknown colspec `$spec' in table",
				$title, "at line $line_num in file",
				$parser->input_file ());
	}
    }

    # the third row (first row of data) is the table header
    print $out_fh join ('',
			$parser->_indent (),
			"
			$parser->_indent (),
			"\n");

    foreach my $field (@{$rows[2]}) {
	print $out_fh $parser->_current_indent (),
	  "$field\n";
    }

    print $out_fh join ('',
			$parser->_outdent (),
			"\n",
			$parser->_outdent (),
			"

    # the remaining rows are the table body
    print $out_fh $parser->_indent (), "

    foreach my $row (@rows[3..$#rows]) {
	print $out_fh $parser->_indent (), "\n";

	foreach my $field (@$row) {
	    print $out_fh $parser->_current_indent (),
	      "$field\n";
	}

	print $out_fh $parser->_outdent (), "\n";
    }

    print $out_fh join ('',
			$parser->_outdent (),
			"
			$parser->_outdent (),
			"\n",
			$parser->_outdent (),
			"
}

sub _manpage
{
    my ($parser, $title, $volnum) = @_;

    # the substring "\37632\377" is a space character protected
    # against translation in S<>; other characters are protected at
    # the end of interior_sequence (), and all protected characters
    # are de-protected in _fix_chars ()

    if (defined $volnum) {
	return join ("\n",
		     '',
		     "\37632\377" x $parser->{spaces} .
		     "$title",
		     "\37632\377" x $parser->{spaces} .
		     "$volnum",
		     '');
    }

    else {
	return join ("\n",
		     '',
		     "\37632\377" x $parser->{spaces} .
		     "$title",
		     '');
    }
}

#----------------------------------------------------------------------
# helper functions
#----------------------------------------------------------------------

sub _fix_chars
{
    my ($paragraph) = @_;

    # fix characters that might annoy an SGML parser
    $paragraph =~ s/&/&/g;
    $paragraph =~ s/
    $paragraph =~ s/>/>/g;

    # finally, de-protect any characters that were protected
    # from the previous step
    $paragraph =~ s!\376(\d+)\377!pack ('C', $1)!eg;

    return $paragraph;
}

1;

__END__