XML::DTD::EntityManager - Perl module for managing entity declarations in a DTD

  use XML::DTD::EntityManager;

  my $em = XML::DTD::EntityManager->new;

package XML::DTD::EntityManager;

use XML::DTD::Error;

use 5.008;
use strict;
use warnings;

our @ISA = qw();

our $VERSION = '0.09';

# Constructor
sub new {
  my $arg = shift;
  my $ent = shift;

  my $cls = ref($arg) || $arg;
  my $obj = ref($arg) && $arg;

  my $self;
  if ($obj) {
    # Called as a copy constructor
    $self = { %$obj };
  } else {
    # Called as the main constructor
    $self = { };
    $self->{'PARAMETER'} = { };
    $self->{'GENERAL'} = { };
  }
  bless $self, $cls;
  return $self;
}


# Determine whether object is of this type
sub isa {
  my $cls = shift;
  my $r = shift;

  if (defined($r) && ref($r) eq $cls) {
    return 1;
  } else {
    return 0;
  }
}


# Insert an entity
sub insert {
  my $self = shift;
  my $ent = shift;

  if ($ent->isparam) {
    $self->insertpe($ent);
  } else {
    $self->insertge($ent);
  }
}


# Insert a parameter entity declaration
sub insertpe {
  my $self = shift;
  my $pe = shift;

  my $name = $pe->name;
  if (defined($self->{'PARAMETER'}->{$name})) {
    return 0;
  } else {
    $self->{'PARAMETER'}->{$name} = $pe;
    return 1;
  }
}


# Lookup a parameter entity declaration
sub pevalue {
  my $self = shift;
  my $peref = shift;

  $peref = $1 if ($peref =~ /^%(.+);$/);
  my $ent = $self->{'PARAMETER'}->{$peref};
  if (defined $ent) {
    if ($ent->isextern) {
      # The value of an external entity is just itself
      return $ent->value;
    } else {
      # The value of an internal entity has character and
      # parameter entity expansion carried out on it
      return $self->entitysubst($ent->value);
    }
  } else {
    return undef;
  }
}

# Lookup a parameter entity declaration and return
# its expansion, otherwise return the peref
sub peexpand {
  my $self = shift;
  my $peref = shift;

  my $peval = $self->pevalue($peref);
  if (defined $peval) {
    $peref = $peval;
  } else {
    $peref = '%'.$peref.';';
  }
  return $peref;
}

# Lookup a parameter entity's containing URI
sub peuri {
  my $self = shift;
  my $peref = shift;

  $peref = $1 if ($peref =~ /^%(.+);$/);
  my $ent = $self->{'PARAMETER'}->{$peref};
  if (defined $ent) {
    return $ent->uri;
  } else {
    return undef;
  }
}


# Insert a general entity declaration
sub insertge {
  my $self = shift;
  my $ge = shift;

  my $name = $ge->name;
  if (defined($self->{'GENERAL'}->{$name})) {
    return 0;
  } else {
    $self->{'GENERAL'}->{$name} = $ge;
    return 1;
  }
}


# Lookup a general entity declaration
sub gevalue {
  my $self = shift;
  my $geref = shift;

  $geref = $1 if ($geref =~ /^\&(.+);$/);
  my $ent = $self->{'GENERAL'}->{$geref};
  if (defined $ent) {
    return $ent->value;
  } else {
    return undef;
  }
}


# Convert a character entity declaration
sub cevalue {
  my $self = shift;
  my $ceref = shift;

  $ceref = $1 if ($ceref =~ /^\&#(.+);$/);
  if ($ceref =~ /^x([0-9a-fA-F]+)$/) {
    return chr hex $1;
  } elsif ($ceref =~ /^[0-9]+$/) {
    return chr $ceref;
  } else {
    return undef;
  }
}


# Perform entity substitution in text
sub entitysubst {
  my $self = shift;
  my $txt = shift;
  my $gesf = shift; # Flag selecting substitution of general entity refs

  my $lt = '';
  my $rt = $txt;
  while($rt =~ /(?:(%|\&)([\w\.:\-_]+)|(?:\&#(([0-9]+)|(x[0-9a-fA-F]+))));/) {
    $rt = $';
    $lt .= $`;
    my ($type, $val);
    my $entv;
    if (defined $1) {
      # Entity ref or parameter ref
      ($type, $val) = ($1, $2);
      if ($type eq '%') {
	# Substitute parameter refs
        $entv = $self->pevalue($type.$val.';');
      } else {
	if ($gesf) {
	  $entv = $self->gevalue($type.$val.';');
	} else {
	  # Bypass entity ref
	  $entv = $type.$val.';';
	}
      }
    } else {
      # Character ref
      ($type, $val) = ('&', '#'.$3);
      $entv = $self->cevalue($type.$val.';');
    }
    if (defined $entv) {
      $lt .= $entv;
    } else {
      $lt .= $type.$val.';';
      throw XML::DTD::Error("Reference to undefined entity in string: $txt",
			    $self);
    }
  }
  $lt .= $rt;
  return $lt;
}


# Perform entity substitution in text
sub includeaspe {
  my $self = shift;
  my $txt = shift;

  my $lt = '';
  my $rt = $txt;
  while($rt =~ /(%[\w\.:\-_]+;)/) {
    $rt = $';
    $lt .= $`;
    my $entv;
    if (defined $1) {
	# Substitute parameter ref
        $entv = $self->pevalue($1);
    }
    if (defined $entv) {
      $lt .= ' '.$entv.' ';
    } else {
      $lt .= $1;
      throw XML::DTD::Error("Reference to undefined entity in string: $txt",
			    $self);
    }
  }
  $lt .= $rt;
  return $lt;
}


1;
__END__