text.pm

Astercon2 开源软交换 2.2.0

    while (defined $parent) {
        return $seq->raw_text if ($parent->cmd_name eq 'L');
        $parent = $parent->nested;
    }

    # Index entries are ignored in plain text.
    return '' if ($command eq 'X' || $command eq 'Z');

    # Expand escapes into the actual character now, warning if invalid.
    if ($command eq 'E') {
        if (/^\d+$/) {
            return chr;
        } else {
            return $ESCAPES{$_} if defined $ESCAPES{$_};
            my ($file, $line) = $seq->file_line;
            warn "$file:$line: Unknown escape: E<$_>\n";
            return "E<$_>";
        }
    }

    # For all the other formatting codes, empty content produces no output.
    return if $_ eq '';

    # For S<>, compress all internal whitespace and then map spaces to \01.
    # When we output the text, we'll map this back.
    if ($command eq 'S') {
        s/\s+/ /g;
        tr/ /\01/;
        return $_;
    }

    # Anything else needs to get dispatched to another method.
    if    ($command eq 'B') { return $self->seq_b ($_) }
    elsif ($command eq 'C') { return $self->seq_c ($_) }
    elsif ($command eq 'F') { return $self->seq_f ($_) }
    elsif ($command eq 'I') { return $self->seq_i ($_) }
    elsif ($command eq 'L') { return $self->seq_l ($_, $seq) }
    else {
        my ($file, $line) = $seq->file_line;
        warn "$file:$line: Unknown formatting code: $command<$_>\n";
    }
}

# Called for each paragraph that's actually part of the POD.  We take
# advantage of this opportunity to untabify the input.  Also, if given the
# code option, we may see paragraphs that aren't part of the POD and need to
# output them directly.
sub preprocess_paragraph {
    my $self = shift;
    local $_ = shift;
    1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me;
    $self->output_code ($_) if $self->cutting;
    $_;
}


##############################################################################
# Command paragraphs
##############################################################################

# All command paragraphs take the paragraph and the line number.

# First level heading.
sub cmd_head1 {
    my ($self, $text, $line) = @_;
    $self->heading ($text, $line, 0, '====');
}

# Second level heading.
sub cmd_head2 {
    my ($self, $text, $line) = @_;
    $self->heading ($text, $line, $$self{indent} / 2, '==  ');
}

# Third level heading.
sub cmd_head3 {
    my ($self, $text, $line) = @_;
    $self->heading ($text, $line, $$self{indent} * 2 / 3 + 0.5, '=   ');
}

# Third level heading.
sub cmd_head4 {
    my ($self, $text, $line) = @_;
    $self->heading ($text, $line, $$self{indent} * 3 / 4 + 0.5, '-   ');
}

# Start a list.
sub cmd_over {
    my $self = shift;
    local $_ = shift;
    $self->item ("\n\n") if defined $$self{ITEM};
    unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} }
    push (@{ $$self{INDENTS} }, $$self{MARGIN});
    $$self{MARGIN} += ($_ + 0);
}

# End a list.
sub cmd_back {
    my ($self, $text, $line, $paragraph) = @_;
    $self->item ("\n\n") if defined $$self{ITEM};
    $$self{MARGIN} = pop @{ $$self{INDENTS} };
    unless (defined $$self{MARGIN}) {
        my $file;
        ($file, $line) = $paragraph->file_line;
        warn "$file:$line: Unmatched =back\n";
        $$self{MARGIN} = $$self{indent};
    }
}

# An individual list item.
sub cmd_item {
    my $self = shift;
    if (defined $$self{ITEM}) { $self->item }
    local $_ = shift;
    s/\s+$//;
    $$self{ITEM} = $_ ? $self->interpolate ($_) : '*';
}

# Begin a block for a particular translator.  Setting VERBATIM triggers
# special handling in textblock().
sub cmd_begin {
    my $self = shift;
    local $_ = shift;
    my ($kind) = /^(\S+)/ or return;
    if ($kind eq 'text') {
        $$self{VERBATIM} = 1;
    } else {
        $$self{EXCLUDE} = 1;
    }
}

# End a block for a particular translator.  We assume that all =begin/=end
# pairs are properly closed.
sub cmd_end {
    my $self = shift;
    $$self{EXCLUDE} = 0;
    $$self{VERBATIM} = 0;
}

# One paragraph for a particular translator.  Ignore it unless it's intended
# for text, in which case we treat it as a verbatim text block.
sub cmd_for {
    my $self = shift;
    local $_ = shift;
    my $line = shift;
    return unless s/^text\b[ \t]*\n?//;
    $self->verbatim ($_, $line);
}


##############################################################################
# Formatting codes
##############################################################################

# The simple ones.  These are here mostly so that subclasses can override them
# and do more complicated things.
sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] }
sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] }
sub seq_i { return '*' . $_[1] . '*' }

# Apply a whole bunch of messy heuristics to not quote things that don't
# benefit from being quoted.  These originally come from Barrie Slaymaker and
# largely duplicate code in Pod::Man.
sub seq_c {
    my $self = shift;
    local $_ = shift;

    # A regex that matches the portion of a variable reference that's the
    # array or hash index, separated out just because we want to use it in
    # several places in the following regex.
    my $index = '(?: \[.*\] | \{.*\} )?';

    # Check for things that we don't want to quote, and if we find any of
    # them, return the string with just a font change and no quoting.
    m{
      ^\s*
      (?:
         ( [\'\`\"] ) .* \1                             # already quoted
       | \` .* \'                                       # `quoted'
       | \$+ [\#^]? \S $index                           # special ($^Foo, $")
       | [\$\@%&*]+ \#? [:\'\w]+ $index                 # plain var or func
       | [\$\@%&*]* [:\'\w]+ (?: -> )? \(\s*[^\s,]\s*\) # 0/1-arg func call
       | [+-]? ( \d[\d.]* | \.\d+ ) (?: [eE][+-]?\d+ )? # a number
       | 0x [a-fA-F\d]+                                 # a hex constant
      )
      \s*\z
     }xo && return $_;

    # If we didn't return, go ahead and quote the text.
    return $$self{alt} ? "``$_''" : "$$self{LQUOTE}$_$$self{RQUOTE}";
}

# Handle links.  Since this is plain text, we can't actually make any real
# links, so this is all to figure out what text we print out.  Most of the
# work is done by Pod::ParseLink.
sub seq_l {
    my ($self, $link, $seq) = @_;
    my ($text, $type) = (parselink ($link))[1,4];
    my ($file, $line) = $seq->file_line;
    $text = $self->interpolate ($text, $line);
    $text = '<' . $text . '>' if $type eq 'url';
    return $text || '';
}


##############################################################################
# Header handling
##############################################################################

# The common code for handling all headers.  Takes the interpolated header
# text, the line number, the indentation, and the surrounding marker for the
# alt formatting method.
sub heading {
    my ($self, $text, $line, $indent, $marker) = @_;
    $self->item ("\n\n") if defined $$self{ITEM};
    $text =~ s/\s+$//;
    $text = $self->interpolate ($text, $line);
    if ($$self{alt}) {
        my $closemark = reverse (split (//, $marker));
        my $margin = ' ' x $$self{margin};
        $self->output ("\n" . "$margin$marker $text $closemark" . "\n\n");
    } else {
        $text .= "\n" if $$self{loose};
        my $margin = ' ' x ($$self{margin} + $indent);
        $self->output ($margin . $text . "\n");
    }
}


##############################################################################
# List handling
##############################################################################

# This method is called whenever an =item command is complete (in other words,
# we've seen its associated paragraph or know for certain that it doesn't have
# one).  It gets the paragraph associated with the item as an argument.  If
# that argument is empty, just output the item tag; if it contains a newline,
# output the item tag followed by the newline.  Otherwise, see if there's
# enough room for us to output the item tag in the margin of the text or if we
# have to put it on a separate line.
sub item {
    my $self = shift;
    local $_ = shift;
    my $tag = $$self{ITEM};
    unless (defined $tag) {
        carp "Item called without tag";
        return;
    }
    undef $$self{ITEM};
    my $indent = $$self{INDENTS}[-1];
    unless (defined $indent) { $indent = $$self{indent} }
    my $margin = ' ' x $$self{margin};
    if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) {
        my $realindent = $$self{MARGIN};
        $$self{MARGIN} = $indent;
        my $output = $self->reformat ($tag);
        $output =~ s/^$margin /$margin:/ if ($$self{alt} && $indent > 0);
        $output =~ s/\n*$/\n/;

        # If the text is just whitespace, we have an empty item paragraph;
        # this can result from =over/=item/=back without any intermixed
        # paragraphs.  Insert some whitespace to keep the =item from merging
        # into the next paragraph.
        $output .= "\n" if $_ && $_ =~ /^\s*$/;

        $self->output ($output);
        $$self{MARGIN} = $realindent;
        $self->output ($self->reformat ($_)) if $_ && /\S/;
    } else {
        my $space = ' ' x $indent;
        $space =~ s/^$margin /$margin:/ if $$self{alt};
        $_ = $self->reformat ($_);
        s/^$margin /$margin:/ if ($$self{alt} && $indent > 0);
        my $tagspace = ' ' x length $tag;
        s/^($space)$tagspace/$1$tag/ or warn "Bizarre space in item";
        $self->output ($_);
    }
}


##############################################################################
# Output formatting
##############################################################################