cdata results from the CPAN

cdata

XML-STX

view release on metacpan or search on metacpan

    $el->{ID} = $self->{nodeID}++;

    $self->_current_node([STXE_START_ELEMENT, $el]);
}

sub end_element {
    my $self = shift;
    my $el = shift;
    #print "STX: end_element: $el->{Name}\n";

    $self->_current_node([STXE_END_ELEMENT]);
}

sub characters {
    my $self = shift;
    my $char = shift;
    #print "STX: characters: $char->{Data}\n";

    if ($self->{lookahead}->[0] == STXE_CHARACTERS) {
	$self->{lookahead}->[1]->{Data} .= $char->{Data};
	
    } else {
	$char->{Type} = $self->{CDATA} ? STX_CDATA_NODE : STX_TEXT_NODE;
	$char->{ID} = $self->{nodeID}++;

	$self->_current_node([STXE_CHARACTERS, $char]);
    }
}

sub processing_instruction {
    my $self = shift;
    my $pi = shift;
    #print "STX: pi: $pi->{Target}\n";

    $pi->{Type} = STX_PI_NODE;
    $pi->{ID} = $self->{nodeID}++;

    $self->_current_node([STXE_PI, $pi]);
}

sub ignorable_whitespace {
}

sub start_prefix_mapping {
    my ($self, $map) = @_;

    $self->_current_node([STXE_START_PREF, $map]);
}

sub end_prefix_mapping {
    my ($self, $map) = @_;

    $self->_current_node([STXE_END_PREF, $map]);
}

sub skipped_entity {
}

# lexical ----------------------------------------

sub start_cdata {
    my $self = shift;
    #print "STX: start_cdata\n";

    if ($self->_get_base_group()->{Options}->{'recognize-cdata'}) {
	$self->_current_node([STXE_START_CDATA]);
	$self->{CDATA} = 1; 
    }
}

sub end_cdata {
    my $self = shift;
    #print "STX: end_cdata\n";

    if ($self->_get_base_group()->{Options}->{'recognize-cdata'}) {
 	$self->_current_node([STXE_END_CDATA]);
  	$self->{CDATA} = 0;
    }
}

sub comment {
    my $self = shift;
    my $comment = shift;
    #print "STX: comment: $comment->{Data}\n";

    $comment->{Type} =  STX_COMMENT_NODE;
    $comment->{ID} = $self->{nodeID}++;

    $self->_current_node([STXE_COMMENT, $comment]);
}

sub start_dtd {
}

sub end_dtd {
}

sub start_entity {
}

sub end_entity {
}

# error ----------------------------------------

sub warning {
}

sub error {
}

sub fatal_error {
}

# SAX1 ----------------------------------------

sub xml_decl {
}

# internal ----------------------------------------

sub change_stream {
    my ($self, $event) = @_;
    #print "STX: change_stream: $event\n";

    $self->_current_node([$event]);
}

# --------------------------------------------------

sub _current_node {
    my ($self, $next) = @_;

    my $current;

STX/Runtime.pm view on Meta::CPAN

	    #shift @{$self->{exG}->{$index + 1}};
	    
	    pop @{$self->{_params}};
	}
    }

    push @{$self->{LookUp}}, 0;
    $self->_process;
}

sub _end_element {
    my $self = shift;

    my $node = $self->{Stack}->[-1];
    #print "STX: > _end_element $node->{Name} ($node->{Index})\n";

    # process-siblings stuff ------------------------------ zzz
    #print "-e->$node->{Name}:$node->{Index}\n";
    if (defined $self->{byEndSib}->{$node->{Index} + 1}->[-1]) {
	#print "STX: end of siblings: running the 2nd part\n";
	$self->_run_template(4, undef, $node->{Index} + 1, $node);
	#shift @{$self->{exG}->{$node->{Index} + 1}};
	shift @{$self->{byEndSib}->{$node->{Index} + 1}};
	pop @{$self->{_params}};
    }

    # process-children stuff ------------------------------
    if (defined $self->{byEnd}->{$node->{Index}}) {

	while ($#{$self->{byEnd}->{$node->{Index}}} > -1) {
	    $self->_run_template(0, undef, $node->{Index}, $node);
	    #shift @{$self->{exG}->{$node->{Index} + 1}};

	    pop @{$self->{_params}};
	}
    }
    $self->{exG}->{$node->{Index} + 1} = undef;
    $self->{byEnd}->{$node->{Index}} = undef;

    # cleaning counters ------------------------------
    my $index = scalar @{$self->{Stack}};
    $self->{Counter}->[$index] = {};

    pop @{$self->{LookUp}};
    pop @{$self->{Stack}};
    $self->{ns}->popContext;
}

sub _characters {
    my $self = shift;
    my $char = shift;
    #print "STX: > _characters: $char->{Data}\n";

    return if $self->_get_base_group()->{Options}->{'strip-space'}
      and $char->{Data} =~ /^\s*$/;

    my $index = scalar @{$self->{Stack}};
    #$self->{Counter}->[$index] or $self->{Counter}->[$index] = {};

    $self->_counter($index, '/node', '/text');
    $self->_counter($index, '/cdata') if $self->{CDATA};

    $char->{Index} = $index;
    $char->{Counter} = $self->{Counter}->[$index];

    push @{$self->{Stack}}, $char;
    push @{$self->{LookUp}}, 0;

    $self->_process;

    pop @{$self->{LookUp}};
    pop @{$self->{Stack}};
}

sub _processing_instruction {
    my $self = shift;
    my $pi = shift;
    #print "STX: > _pi: $pi->{Target}\n";

    my $index = scalar @{$self->{Stack}};
    $self->{Counter}->[$index] or $self->{Counter}->[$index] = {};

    $self->_counter($index, '/node', '/pi', "/pi:$pi->{Target}");

    $pi->{Index} = $index;
    $pi->{Counter} = $self->{Counter}->[$index];

    push @{$self->{Stack}}, $pi;
    push @{$self->{LookUp}}, 0;

    $self->_process;

    pop @{$self->{LookUp}};
    pop @{$self->{Stack}};
}

sub _comment {
    my $self = shift;
    my $comment = shift;
    #print "STX: > _comment: $comment->{Data}\n";

    my $index = scalar @{$self->{Stack}};
    #$self->{Counter}->[$index] or $self->{Counter}->[$index] = {};

    $self->_counter($index, '/node', '/comment');

    $comment->{Index} = $index;
    $comment->{Counter} = $self->{Counter}->[$index];

    push @{$self->{Stack}}, $comment;
    push @{$self->{LookUp}}, 0;

    $self->_process;

    pop @{$self->{LookUp}};
    pop @{$self->{Stack}};
}

sub _start_prefix_mapping {
    my ($self, $map) = @_;

STX/Runtime.pm view on Meta::CPAN

 		$children = 1;
 		last;
 	    }

	    pop @{$self->{exG}->{$c_node->{Index}}};
	    pop @{$self->{_params}};

	# I_CHARACTERS ----------------------------------------
	} elsif ($i->[0] == I_CHARACTERS) {
	    $out = $self->_send_element_start($out) 
	      if (exists $out->{Name} and not($self->{_TTO}));

	    # stx:value-of
	    if (defined $i->[2]) {
		$self->_send_text(
			  $self->{SP}->F_string_join(
				     $self->_eval($i->[1],$ns),
				     [[$self->_expand($i->[2],$ns), STX_STRING]]
						    )->[0]->[0]
				 );
	    # stx:text
	    } else {
		$self->_send_text($self->_expand($i->[1], $ns));
	    }

	# I_COPY_START ----------------------------------------
	} elsif ($i->[0] == I_COPY_START) {

	    my $type = $c_node->{Type};

	    if ($type == STX_ELEMENT_NODE) {
		$out = $self->_send_element_start($out) if exists $out->{Name};

  		$out->{Name} = $c_node->{Name};
  		$out->{LocalName} = $c_node->{LocalName};
  		$out->{Prefix} = $c_node->{Prefix} 
  		  if exists $c_node->{Prefix};
  		$out->{NamespaceURI} = $c_node->{NamespaceURI}
  		  if exists $c_node->{NamespaceURI};

		$out->{Attributes} = {};
		my @att = split(' ', $i->[1]);

		foreach my $a (keys %{$c_node->{Attributes}}) {

		    if ($i->[1] eq '#all' 
			or grep($_ eq $c_node->{Attributes}->{$a}->{Name}, @att)) {

			$out->{Attributes}->{$a} = $c_node->{Attributes}->{$a};
		    }
		}

	    } elsif ($type == STX_TEXT_NODE) {
		$out = $self->_send_element_start($out) if exists $out->{Name};

		$self->_send_text($c_node->{Data});

	    } elsif ($type == STX_CDATA_NODE) {
		$out = $self->_send_element_start($out) if exists $out->{Name};

		$self->SUPER::start_cdata() unless $self->{_TTO};
		$self->_send_text($c_node->{Data});
		$self->SUPER::end_cdata() unless $self->{_TTO};

	    } elsif ($type == STX_PI_NODE) {
		$out = $self->_send_element_start($out) if exists $out->{Name};

		$self->SUPER::processing_instruction(
				{Target => $c_node->{Target}, 
				 Data => $c_node->{Data}});

	    } elsif ($type == STX_COMMENT_NODE) {
		$out = $self->_send_element_start($out) if exists $out->{Name};

		$self->SUPER::comment({Data => $c_node->{Data}});

	    } elsif ($type == STX_ATTRIBUTE_NODE) {
		#tbd !!!

	    }

	# I_COPY_END ----------------------------------------
	} elsif ($i->[0] == I_COPY_END) {

	    my $type = $c_node->{Type};
	    if ($type == STX_ELEMENT_NODE) {
		$out = $self->_send_element_start($out) if exists $out->{Name};

		$out = $self->_send_element_end($c_node);
	    }
	    # else: ignore </copy> for other types of nodes

	# I_CDATA_START ----------------------------------------
	} elsif ($i->[0] == I_CDATA_START) {
	    $out = $self->_send_element_start($out) if exists $out->{Name};

	    $self->SUPER::start_cdata();

	# I_CDATA_END ----------------------------------------
	} elsif ($i->[0] == I_CDATA_END) {

	    $self->SUPER::end_cdata();

	# I_COMMENT_START ----------------------------------------
	} elsif ($i->[0] == I_COMMENT_START) {
	    $out = $self->_send_element_start($out) if exists $out->{Name};

	    $self->{_TTO} = 'COM'; # comment
	    $self->{_text_cache} = '';

	# I_COMMENT_END ----------------------------------------
	} elsif ($i->[0] == I_COMMENT_END) {

	    $self->SUPER::comment({ Data => $self->{_text_cache} });

	    $self->{_TTO} = undef;
	    $self->{_text_cache} = undef;

	# I_PI_START ----------------------------------------
	} elsif ($i->[0] == I_PI_START) {
	    $out = $self->_send_element_start($out) if exists $out->{Name};

	    my $target = $self->_expand($i->[1], $ns);
	    $self->doError(502, 3, 'name', 
			   '<stx:processing-instruction>', 
			   'non-qualified name', $target)
	      unless $target =~ /^$NCName$/o;

	    $self->{_TTO} = $target; # PI target
	    $self->{_text_cache} = '';

	# I_PI_END ----------------------------------------
	} elsif ($i->[0] == I_PI_END) {

	    $self->SUPER::processing_instruction({
					Data => $self->{_text_cache},
					Target => $self->{_TTO},
					});

	    $self->{_TTO} = undef;
	    $self->{_text_cache} = undef;

	# I_VARIABLE_START ----------------------------------------
	} elsif ($i->[0] == I_VARIABLE_START) {

	    if ($i->[2] and $i->[3] == 0) {
		$t->{vars}->[-1]->{$i->[1]} = [$self->_eval($i->[2], $ns)];

	    } else {
		$self->{_TTO} = $i->[1]; # text template object
		$self->{_text_cache} = '';
	    }

	# I_VARIABLE_END ----------------------------------------
	} elsif ($i->[0] == I_VARIABLE_END) {

	    if ($self->{_TTO}) {

		$t->{vars}->[-1]->{$self->{_TTO}} 
		  = [$self->{SP}->F_normalize_space([[$self->{_text_cache},
						      STX_STRING]])];
		$self->{_TTO} = undef;

STX/Runtime.pm view on Meta::CPAN

	    $t->{instructions} = $ii_e;
	    #print "STX: default rule: E\n";
	}
    }
    return $t;
}

# dynamic retrieval of either variable or buffer sss
sub _get_objects {
    my ($self, $name, $type) = @_;

    my $tp = $type ? 'bufs' : 'vars';
    my $ct = $self->{_c_template}->[-1];

    # local object
    return $ct->{$tp}->[-1] if $ct->{$tp}->[-1]->{$name};

    # current group
    my $g = $self->{c_group};
    return $g->{$tp}->[-1] if $g->{$tp}->[-1]->{$name};

    # descendant groups
    while ($g->{group}) {
	$g = $g->{group};
	return $g->{$tp}->[-1] if $g->{$tp}->[-1]->{$name};
    }
    return undef;
}

sub _child_nodes {
    my $self = shift;

    return 1 
      if $self->{Stack}->[-1]->{Type} == STX_ELEMENT_NODE 
      and $self->{lookahead}->[0] != STXE_END_ELEMENT;

    return 1 
      if $self->{Stack}->[-1]->{Type} == STX_ROOT_NODE 
      and $self->{lookahead}->[0] != STXE_END_DOCUMENT;

    return 0;
}

# debug ----------------------------------------

sub _frameDBG {
    my $self = shift;

    my $index = scalar @{$self->{Stack}} - 1;
    print "===[$self->{Source}->[-1]->{SystemId}]STACK:$index ";
    foreach (@{$self->{Stack}}) {
	if ($_->{Type} == STX_ELEMENT_NODE) {
	    print "/", $_->{Name};	    
	} elsif ($_->{Type} == STX_TEXT_NODE) {
	    my $norm = $_->{Data};
	    $norm =~ s/\s+/ /g;
	    print "/[text]$norm";	    
	} elsif ($_->{Type} == STX_CDATA_NODE) {
	    my $norm = $_->{Data};
	    $norm =~ s/\s+/ /g;
	    print "/[cdata]$norm";	    
	} elsif ($_->{Type} == STX_COMMENT_NODE) {
	    my $norm = $_->{Data};
	    $norm =~ s/\s+/ /g;
	    print "/[comment]$norm";	    
	} elsif ($_->{Type} == STX_PI_NODE) {
	    my $norm = $_->{Target};
	    $norm =~ s/\s+/ /g;
	    print "/[pi]$norm";	    
	} elsif ($_->{Type} == STX_ROOT_NODE) {
	    print "^";	    
	} else {
	    print "/unknown node: ", $_->{Type};	    
	}
    }
    print "\n";
}

sub _counterDBG {
    my $self = shift;

    my $index = scalar @{$self->{Stack}} - 1;
    print "COUNTER:$index";
     foreach (keys %{$self->{Counter}->[$index]}) {
	 my $cnt = $self->{Counter}->[$index]->{$_};
	 print " $_->$cnt";
     }
    print "\n";
}

sub _nsDBG {
    my $self = shift;

    my @prefixes = $self->{ns}->get_prefixes;
    print "PREFIXES: ", join("|",@prefixes), "\n";

#     foreach (@prefixes) {
# 	my $uri = $self->{ns}->get_uri($_);
# 	print " >$_:$uri\n";
#     }

    my @prefixes2 = $self->{ns_out}->get_prefixes;
    print "RESULT PREFIXES: ", join("|",@prefixes2), "\n";
}

sub _grpDBG {
    my $self = shift;

    print "exG: ";
    foreach my $frm (@{$self->{Stack}}) {
	print "/";
	foreach (@{$self->{exG}->{$frm->{Index}}}) {
	    print "{$_}";
	}
    }
    print "\n";
}

1;
__END__

( run in 0.658 second using v1.01-cache-2.11-cpan-39bf76dae61 )