view release on metacpan or  search on metacpan

STX/Functions.pm  view on Meta::CPAN

# STRING = namespace-uri(node) --------------------
sub F_namespace_uri($){
    my ($self, $seq) = @_;

    return [['',STX_STRING]] if @{$seq} == 0;

    if ($seq->[0] and $seq->[0]->[1] == STX_NODE) {

	if ($seq->[0]->[0]->{Type} == 1 or $seq->[0]->[0]->{Type} == 6) {
	    return [[$seq->[0]->[0]->{NamespaceURI},STX_STRING]]
	      if $seq->[0]->[0]->{NamespaceURI};
	    return [['',STX_STRING]];

	} else {
	    return [['',STX_STRING]];
	}

    } else {
	$self->doError('105', 3, 'namespace-uri', 'node', $self->_type($seq));
    }
}

# STRING = local-name(node) --------------------
sub F_local_name($){
    my ($self, $seq) = @_;

    return [['',STX_STRING]] if @{$seq} == 0;

    if ($seq->[0] and $seq->[0]->[1] == STX_NODE) {

	if ($seq->[0]->[0]->{Type} == 1 or $seq->[0]->[0]->{Type} == 6) {
	    return [[$seq->[0]->[0]->{LocalName},STX_STRING]]
	      if $seq->[0]->[0]->{LocalName};
	    return [[$seq->[0]->[0]->{Name},STX_STRING]];

	} elsif ($seq->[0]->[0]->{Type} == 4) {
	    return [[$seq->[0]->[0]->{Target},STX_STRING]];

	} else {
	    return [['',STX_STRING]];
	}

    } else {
	$self->doError('105', 3, 'local-name', 'node', $self->_type($seq));
    }
}

# STRING = node-kind(node) --------------------
sub F_node_kind($){
    my ($self, $seq) = @_;

    if ($seq->[0] and $seq->[0]->[1] == STX_NODE) {

	if ($seq->[0]->[0]->{Type} == 1) {
	    return [['element' ,STX_STRING]];

	} elsif ($seq->[0]->[0]->{Type} == 2) {
	    return [['text' ,STX_STRING]];

	} elsif ($seq->[0]->[0]->{Type} == 3) {
	    return [['cdata' ,STX_STRING]];

	} elsif ($seq->[0]->[0]->{Type} == 4) {
	    return [['processing-instruction' ,STX_STRING]];

	} elsif ($seq->[0]->[0]->{Type} == 5) {
	    return [['comment' ,STX_STRING]];

	} elsif ($seq->[0]->[0]->{Type} == 6) {
	    return [['attribute' ,STX_STRING]];

	} else {
	    return [['document' ,STX_STRING]];
	}

    } else {
	$self->doError('105', 3, 'node-kind', 'node', $self->_type($seq));
    }
}

# SEQ = get-in-scope-prefixes(node) --------------------
sub F_get_in_scope_prefixes($){
    my ($self, $seq) = @_;

    $self->doError('105', 3, 'get-in-scope-prefixes', 'element', 
 		   $self->_type($seq)) unless $seq->[0] 
 		     and $seq->[0]->[1] == STX_NODE
 		       and $seq->[0]->[0]->{Type} == 1; #element

    return [map([$_, STX_STRING], sort keys %{$seq->[0]->[0]->{inScopeNS}})];
}


# STRING = get-namespace_uri-for-prefix(node, string) --------------------
sub F_get_namespace_uri_for_prefix($$){
    my ($self, $seq, $pref) = @_;

    $self->doError('105', 3, 'get-namespaceuri-for-prefixs', 'element', 
 		   $self->_type($seq)) unless $seq->[0] 
 		     and $seq->[0]->[1] == STX_NODE
 		       and $seq->[0]->[0]->{Type} == 1; #element

    my $str = $pref->[0]->[1] == STX_STRING 
      ? $pref->[0] : $self->F_string($pref->[0]);

    return [[$seq->[0]->[0]->{inScopeNS}->{$str->[0]}, STX_STRING]];
}

# BOOLEAN = starts-with(string, string) --------------------
sub F_starts_with($$){
    my ($self, $seq1, $seq2) = @_;

    return [] unless $seq1->[0] and $seq2->[0];

    my $str = $seq1->[0]->[1] == STX_STRING 
      ? $seq1->[0] : $self->F_string($seq1->[0]);

    my $start = $seq2->[0]->[1] == STX_STRING 
      ? $seq2->[0] : $self->F_string($seq2->[0]);

    return [[1, STX_BOOLEAN]] if index($str->[0], $start->[0]) == 0;