1 package URI::urn; # RFC 2141
9 use vars qw(%implementor);
13 my $self = $class->SUPER::_init(@_);
16 my $impclass = $implementor{$nid};
17 return $impclass->_urn_init($self, $nid) if $impclass;
19 $impclass = "URI::urn";
20 if ($nid =~ /^[A-Za-z\d][A-Za-z\d\-]*\z/) {
22 # make it a legal perl identifier
24 $id = "_$id" if $id =~ /^\d/;
26 $impclass = "URI::urn::$id";
28 unless (@{"${impclass}::ISA"}) {
30 eval "require $impclass";
31 die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
32 $impclass = "URI::urn" unless @{"${impclass}::ISA"};
36 carp("Illegal namespace identifier '$nid' for URN '$self'") if $^W;
38 $implementor{$nid} = $impclass;
40 return $impclass->_urn_init($self, $nid);
44 my($class, $self, $nid) = @_;
50 my $opaque = $self->opaque;
56 # XXX possible rebless
62 sub nid { # namespace identifier
64 my $nid = $self->_nid(@_);
65 $nid = lc($nid) if defined($nid);
69 sub nss { # namespace specific string
71 my $opaque = $self->opaque;
76 $v =~ s/(:|\z).*/:$new/;
83 return undef unless $opaque =~ s/^[^:]*://;
89 my $nid = $self->_nid;
90 my $new = $self->SUPER::canonical;
91 return $new if $nid !~ /[A-Z]/ || $nid =~ /%/;
92 $new = $new->clone if $new == $self;