XML::Filter::NSNormalise - SAX filter to normalise namespace prefixes

  use XML::SAX::Machines qw( :all );
  use XML::Filter::NSNormalise;

  my $p = Pipeline(
    XML::Filter::NSNormalise->new(
      Map => {
        'http://purl.org/dc/elements/1.1/' => 'dc',
        'http://purl.org/rss/1.0/modules/syndication/' => 'syn'
      }
    )
    => \*STDOUT
  );

  $p->parse_uri($filename);

  <rdf:RDF
   xmlns="http://purl.org/rss/1.0/"
   xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
   xmlns:theonetruedublincore="http://purl.org/dc/elements/1.1/" >
    <theonetruedublincore:date>2002-10-08</theonetruedublincore:date>
  </rdf:RDF>

  XML::Filter::NSNormalise->new(
    Map => {
      'http://purl.org/dc/elements/1.1/' => 'dc'
    }
  )

  <rdf:RDF
   xmlns="http://purl.org/rss/1.0/"
   xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
   xmlns:dc="http://purl.org/dc/elements/1.1/" >
    <dc:date>2002-10-08</dc:date>
  </rdf:RDF>

  XML::Filter::NSNormalise->new(
    Map => {
      'http://purl.org/dc/elements/1.1/' => 'dc',
      'http://www.w3.org/1999/02/22-rdf-syntax-ns#' => 'rdf',
      'http://purl.org/rss/1.0/modules/syndication/' => 'syn'
    }
  )

  XML::Filter::NSNormalise->new(
    Map => {
      'http://x.com/ => 'z',
      'http://y.com/ => 'z'
    }
  )

# $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__