X-Git-Url: http://git.maemo.org/git/?p=dh-make-perl;a=blobdiff_plain;f=dev%2Farm%2Fliburi-perl%2Fliburi-perl-1.35.dfsg.1%2FURI%2Furn.pm;fp=dev%2Farm%2Fliburi-perl%2Fliburi-perl-1.35.dfsg.1%2FURI%2Furn.pm;h=12d40b265bc29f5a511820f6a1d4ec94b6dbb461;hp=0000000000000000000000000000000000000000;hb=f477fa73365d491991707e7ed9217b48d6994551;hpb=da95c414033799c3a62606f299c3c00b5c77ca11

diff --git a/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/URI/urn.pm b/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/URI/urn.pm
new file mode 100644
index 0000000..12d40b2
--- /dev/null
+++ b/dev/arm/liburi-perl/liburi-perl-1.35.dfsg.1/URI/urn.pm
@@ -0,0 +1,97 @@
+package URI::urn;  # RFC 2141
+
+require URI;
+@ISA=qw(URI);
+
+use strict;
+use Carp qw(carp);
+
+use vars qw(%implementor);
+
+sub _init {
+    my $class = shift;
+    my $self = $class->SUPER::_init(@_);
+    my $nid = $self->nid;
+
+    my $impclass = $implementor{$nid};
+    return $impclass->_urn_init($self, $nid) if $impclass;
+
+    $impclass = "URI::urn";
+    if ($nid =~ /^[A-Za-z\d][A-Za-z\d\-]*\z/) {
+	my $id = $nid;
+	# make it a legal perl identifier
+	$id =~ s/-/_/g;
+	$id = "_$id" if $id =~ /^\d/;
+
+	$impclass = "URI::urn::$id";
+	no strict 'refs';
+	unless (@{"${impclass}::ISA"}) {
+	    # Try to load it
+	    eval "require $impclass";
+	    die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
+	    $impclass = "URI::urn" unless @{"${impclass}::ISA"};
+	}
+    }
+    else {
+	carp("Illegal namespace identifier '$nid' for URN '$self'") if $^W;
+    }
+    $implementor{$nid} = $impclass;
+
+    return $impclass->_urn_init($self, $nid);
+}
+
+sub _urn_init {
+    my($class, $self, $nid) = @_;
+    bless $self, $class;
+}
+
+sub _nid {
+    my $self = shift;
+    my $opaque = $self->opaque;
+    if (@_) {
+	my $v = $opaque;
+	my $new = shift;
+	$v =~ s/[^:]*/$new/;
+	$self->opaque($v);
+	# XXX possible rebless
+    }
+    $opaque =~ s/:.*//s;
+    return $opaque;
+}
+
+sub nid {  # namespace identifier
+    my $self = shift;
+    my $nid = $self->_nid(@_);
+    $nid = lc($nid) if defined($nid);
+    return $nid;
+}
+
+sub nss {  # namespace specific string
+    my $self = shift;
+    my $opaque = $self->opaque;
+    if (@_) {
+	my $v = $opaque;
+	my $new = shift;
+	if (defined $new) {
+	    $v =~ s/(:|\z).*/:$new/;
+	}
+	else {
+	    $v =~ s/:.*//s;
+	}
+	$self->opaque($v);
+    }
+    return undef unless $opaque =~ s/^[^:]*://;
+    return $opaque;
+}
+
+sub canonical {
+    my $self = shift;
+    my $nid = $self->_nid;
+    my $new = $self->SUPER::canonical;
+    return $new if $nid !~ /[A-Z]/ || $nid =~ /%/;
+    $new = $new->clone if $new == $self;
+    $new->nid(lc($nid));
+    return $new;
+}
+
+1;