File Coverage

blib/lib/XML/DOM/XML_Base.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package XML::DOM::XML_Base;
use XML::DOM;
our $VERSION = '0.02';

BEGIN { }

package XML::DOM::Element;
use strict;

our $scheme_re  = '[a-zA-Z][a-zA-Z0-9.+\-]*';

sub _isAbsolute {
  return shift =~ /^($scheme_re):/so ? 1 : 0
}

sub getBase {
  my ( $self ) = @_;
  my $parent = $self;
  my $fullbase = '';
  do {
    if ( $parent->isa( 'XML::DOM::Element' ) ) {
      if ( my $base = $parent->getAttribute( 'xml:base' ) ) {
        $fullbase = $base.$fullbase;
        # [2] done
        if ( _isAbsolute( $fullbase ) ) {
          return $fullbase;
        }
      }
    }
  } while ( $parent = $parent->getParentNode() );
  # [3,4] wasn't possible to get an absolute URI, so return the best
  # relative URI we have
  return $fullbase;
}

sub getAttributeWithBase {
  my ( $self, $name ) = @_;
  # XML Base spec (http://www.w3.org/TR/xmlbase/) says:
  # The rules for determining the base URI can be summarized as follows (highest priority to lowest):
  #  [1] The base URI is embedded in the document's content.
  #  [2] The base URI is that of the encapsulating entity (message, document, or none).
  #  [3] The base URI is the URI used to retrieve the entity.
  #  [4] The base URI is defined by the context of the application.

  my $val = $self->getAttribute( $name ) or return undef;

  # [1] done
  if ( _isAbsolute( $val ) ) {
    return $val;
  }
  else {
    return $self->getBase().$val;
  }
}

1;
__END__