view release on metacpan or  search on metacpan

lib/AtteanX/Parser/RDFXML.pm  view on Meta::CPAN

	} elsif ($el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}nodeID'}) {
		my $name	= $el->{Attributes}{'{http://www.w3.org/1999/02/22-rdf-syntax-ns#}nodeID'}{Value};
		return $self->get_named_bnode( $name );
	} else {
		return $self->new_bnode;
	}
}

sub handle_scoped_values {
	my $self	= shift;
	my $el		= shift;
	my %new;

	{
		# xml:base
		my $base	= '';
		if (exists($el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}base'})) {
			my $uri	= $el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}base'}{Value};
			$base	= $self->new_resource( $uri );
		}
		$self->push_base( $base );
	}

	{
		# language
		my $lang	= '';
		if (exists($el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}lang'})) {
			$lang	= $el->{Attributes}{'{http://www.w3.org/XML/1998/namespace}lang'}{Value};
		}
		$self->push_language( $lang );
	}

	{
		# namespaces
		my @ns		= grep { m<^[{]http://www.w3.org/2000/xmlns/[}]> } (keys %{ $el->{Attributes} });
		foreach my $n (@ns) {
			my ($prefix)	= substr($n, 31);
			my $value		= $el->{Attributes}{$n}{Value};
			$new{ $prefix }	= $value;
			if (blessed(my $ns = $self->{namespaces})) {
				unless ($ns->namespace_uri($prefix)) {
					$ns->add_mapping( $prefix => $value );
				}
			}
		}
	
		if (exists($el->{Attributes}{'{}xmlns'})) {
			my $value		= $el->{Attributes}{'{}xmlns'}{Value};
			$new{ '' }		= $value;
		}
	
		$self->push_namespace_pad( \%new );
	}
}

sub push_base {
	my $self	= shift;
	my $base	= shift;
	if ($base) {
		my $uri		= (blessed($base) and $base->isa('URI')) ? $base : URI->new($base->value );
		$uri->fragment( undef );
		$base	= iri( "$uri" );
	}
	unshift( @{ $self->{base} }, $base );
}

sub pop_base {
	my $self	= shift;
	shift( @{ $self->{base} } );
}

sub get_base {
	my $self	= shift;
	return first { length($_) } @{ $self->{base} };
}

sub push_language {
	my $self	= shift;
	my $lang	= shift;
	unshift( @{ $self->{language} }, $lang );
}

sub pop_language {
	my $self	= shift;
	shift( @{ $self->{language} } );
}

sub get_language {
	my $self	= shift;
	my $lang	= first { length($_) } @{ $self->{language} };
	return $lang // '';
}

sub push_namespace_pad {
	my $self	= shift;
	my $pad		= shift;
	unshift( @{ $self->{_namespaces} }, $pad );
}

sub pop_namespace_pad {
	my $self	= shift;
	shift( @{ $self->{_namespaces} } );
}

sub get_namespace {
	my $self	= shift;
	my $prefix	= shift;
	foreach my $level (0 .. $#{ $self->{_namespaces} }) {
		my $pad		= $self->{_namespaces}[ $level ];
		if (exists($pad->{ $prefix })) {
			my $uri		= $pad->{ $prefix };
			return $uri;
		}
	}
	die "Unknown namespace: $prefix";
}

sub new_bnode {
	my $self	= shift;
	if (my $prefix = $self->{prefix}) {
		my $id	= $prefix . ++$self->{counter};