view release on metacpan or  search on metacpan

lib/Text/Restructured/DOM.pm  view on Meta::CPAN

# Returns: None
sub substitute : method {
    my($dom, @new_doms) = @_;

    my $parent = $dom->parent;
    return unless $parent;
    my $index = $parent->index($dom);
    return if $index < 0;
    splice @{$parent->{content}}, $index, 1, @new_doms;
    delete $PARENT{$dom};
    @PARENT{@new_doms} = ($parent) x @new_doms;
}

# INSTANCE METHOD.
# Returns the tag of a DOM object
# Arguments: Optional new tag value
# Returns: Tag
sub tag : method {
    my($dom, $new_tag) = @_;

    $dom->{tag} = $new_tag if defined $new_tag;
    return $dom->{tag};
}

# Parses text that is in DOM (pseudo-XML) format.
# Arguments: Text, reference to hash of command-line options
# Returns: DOM object
# Uses globals: None
sub Parse {
    my ($text, $opt) = @_;
    my $last_indent = -1;
    my @stack;
    my @indents;
    my $tos;	# top of stack
    my $main;
    my @text = split /\n/, $text;
    foreach (@text) {
	my ($spaces) = /^(\s*)/;
	my $indent = length($spaces);
	if (@stack > 0) {
	    my $i;
	    for ($i=0; $i < @indents; $i++) {
		last if $indent <= $indents[$i]+1;
	    }
	    splice(@stack, $i);
	    splice(@indents, $i);
	    $tos = $stack[-1];
	}

	if (/^(\s*)<(\w+)\s*([^>]*)>\s*$/) {
	    my ($spaces, $tag, $attrlist) = ($1, $2, $3);
	    my $dom = new Text::Restructured::DOM($tag);
	    while ($attrlist ne '') {
		if ($attrlist =~ s/^([\w:]+)=([\"\'])([^\"]*)\2\s*//) {
		    $dom->{attr}{$1} = $3;
		}
		elsif ($attrlist =~ s/^(\w+)\s*//) {
		    $dom->{attr}{$1} = undef;
		}
		else {
		    goto pcdata;
		}
	    }
	    $tos->append($dom) if $tos;
	    if (@stack > 0) {
		$tos = $dom;
	    }
	    else {
		$main = $dom;
	    }
	    push (@stack, $dom);
	    push (@indents, $indent);
	    $tos = $dom;
	}
	else {
	  pcdata:
	    substr($_,0,$indents[-1]+4) = "";
	    chomp;
	    my $text = $_;
	    my $ncontent = @{$tos->{content}};
	    if ($ncontent > 0 &&
		$tos->{content}[$ncontent-1]{tag} eq '#PCDATA') {
		$tos->{content}[$ncontent-1]{text} .= "$text\n";
	    }
	    else {
		my $dom = newPCDATA Text::Restructured::DOM("$text\n");
		$tos->append($dom);
	    }
	}
    };

    $main->{attr}{source} = $opt->{D}{source} || $ARGV;
    return $main;
}

# Methods relating to the DTD

BEGIN {
# These are computed from the docutils.dtd using XML::Smart::DTD
my @takes_body_elts =
    qw(admonition attention block_quote caution citation compound
       container danger definition description document error
       field_body footer footnote header hint important legend
       list_item note section sidebar system_message tip topic
       warning);
my @takes_inline_elts =
    qw(abbreviation acronym address attribution author caption
       classifier contact copyright date doctest_block emphasis
       field_name generated inline line literal_block organization
       paragraph problematic raw reference revision rubric status
       strong subscript substitution_definition substitution_reference
       subtitle superscript target term title title_reference
       version);
my @is_body_elt =
    qw(admonition attention block_quote bullet_list caution citation
       comment compound container danger definition_list doctest_block
       enumerated_list error field_list figure footnote hint image
       important line_block literal_block note option_list paragraph
       pending raw reference rubric substitution_definition
       system_message table target tip warning);
my @is_inline_elt =
    qw(emphasis strong literal reference footnote_reference
       citation_reference substitution_reference title_reference
       abbreviation acronym subscript superscript inline problematic
       generated target image raw);
my (%takes_body_elts, %takes_inline_elts, %is_body_elt, %is_inline_elt);
@takes_body_elts{@takes_body_elts}     = (1) x @takes_body_elts;
@takes_inline_elts{@takes_inline_elts} = (1) x @takes_inline_elts;
@is_body_elt{@is_body_elt}             = (1) x @is_body_elt;
@is_inline_elt{@is_inline_elt}         = (1) x @is_inline_elt;

# INSTANCE METHOD.
# Arguments: None
# Returns: True if the DOM object can take body elements in its contents
sub takes_body_elts : method {
    my ($dom) = @_;