File Coverage

blib/lib/XML/Filter/NSNormalise.pm

Criterion	Covered	Total	%
statement	75	75	100.0
branch	21	22	95.4
condition	5	9	55.5
subroutine	10	10	100.0
pod	5	5	100.0
total	116	121	95.8

# $Id: NSNormalise.pm,v 1.5 2002/10/11 02:01:43 grantm Exp $

package XML::Filter::NSNormalise;

use strict;
use warnings;
use Carp;

use XML::SAX::Base;

use vars qw($VERSION @ISA);

$VERSION = '0.04';

@ISA = qw(XML::SAX::Base);


##############################################################################
# Constructor: new()
#
# Validate mappings and delegate to base class constructor.
#

sub new {
  my $class = shift;
  my %args  = @_;

  if(!$args{Map}  or  !ref($args{Map})  or  !%{$args{Map}}) {
    croak "No 'Map' option in call to XML::Filter::NSNormalise->new()";
  }
  my %revmap;
  while(my($uri, $prefix) = each %{$args{Map}} ) {
    if($revmap{$prefix}  and  $revmap{$prefix} ne $uri) {
      croak "Multiple URIs mapped to prefix '$prefix'"
    }
    $revmap{$prefix} = $uri;
  }

  $class->SUPER::new(@_, ReverseMap => \%revmap);
}


##############################################################################
# Method: start_prefix_mapping()
# Method: end_prefix_mapping()
#
# Intercept any namespace prefix events for which we have a mapping and
# normalise the 'Prefix'.
#

sub start_prefix_mapping {
  my $self = shift;
  my $event = shift;

  if($self->{Map}->{$event->{NamespaceURI}}) {
    $event = { %$event };
    $event->{Prefix} = $self->{Map}->{$event->{NamespaceURI}};
  }
  $self->SUPER::start_prefix_mapping($event);
}

sub end_prefix_mapping {
  my $self = shift;
  my $event = shift;

  if($self->{Map}->{$event->{NamespaceURI}}) {
    $event = { %$event };
    $event->{Prefix} = $self->{Map}->{$event->{NamespaceURI}};
  }
  $self->SUPER::end_prefix_mapping($event);
}


##############################################################################
# Method: start_element()
# Method: end_element()
#
# - Fix the 'Prefix' and 'Name' data for elements in a mapped namespace
# - Fix the 'LocalName' and 'Name' data for namespace declaration attributes
# - Fix the 'Prefix' and 'Name' data for attributes in a mapped namespace
#

sub start_element {
  my $self = shift;
  my $event = shift;

  $event = { %$event }; # make a (shallow) copy of the event data
  my %new_attr;

  if($self->{Map}->{$event->{NamespaceURI}}) {
    $event->{Prefix} = $self->{Map}->{$event->{NamespaceURI}};
    $event->{Name}   = "$event->{Prefix}:$event->{LocalName}";
  }
  foreach my $key (keys %{$event->{Attributes}}) {
    my $attr = $event->{Attributes}->{$key};

    if($attr->{Prefix} eq 'xmlns') {
      if($self->{ReverseMap}->{$attr->{LocalName}}) {
        if($attr->{Value} ne $self->{ReverseMap}->{$attr->{LocalName}}) {
	  die "Cannot map '$self->{ReverseMap}->{$attr->{LocalName}}' to " .
	      "'$attr->{LocalName}' - prefix already occurs in document";
        }
      }
      if($self->{Map}->{$attr->{Value}}) {
	$attr = { %$attr };
        $attr->{LocalName} = $self->{Map}->{$attr->{Value}};
        $attr->{Name}      = "xmlns:$attr->{LocalName}";
	$new_attr{"{http://www.w3.org/2000/xmlns/}$attr->{LocalName}"} = $attr;
      }
      else {
        $new_attr{$key} = $attr;
      }
    }
    elsif($self->{Map}->{$attr->{NamespaceURI}}) {
      $attr = { %$attr };
      $attr->{Prefix} = $self->{Map}->{$attr->{NamespaceURI}};
      $attr->{Name}   = "$attr->{Prefix}:$attr->{LocalName}";
      my $new_key = "{$attr->{NamespaceURI}}$attr->{LocalName}";
      $new_attr{$new_key} = $attr;
      delete($event->{Attributes}->{$key});
    }
    else {
      $new_attr{$key} = $attr;
    }

  }
  $event->{Attributes} = \%new_attr;
  $self->SUPER::start_element($event);
}

sub end_element {
  my $self = shift;
  my $event = shift;

  if($self->{Map}->{$event->{NamespaceURI}}) {
    $event = { %$event };
    $event->{Prefix} = $self->{Map}->{$event->{NamespaceURI}};
    $event->{Name}   = "$event->{Prefix}:$event->{LocalName}";
  }
  $self->SUPER::end_element($event);
}


1;
__END__