File: Namespace.pm

package info (click to toggle)
liburi-namespacemap-perl 1.12-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 248 kB
  • sloc: perl: 412; makefile: 2; sh: 1
file content (143 lines) | stat: -rw-r--r-- 3,443 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
package URI::Namespace;
use Moo 1.006000;
use URI;
use IRI 0.003;
use Scalar::Util qw(blessed);
use Types::Namespace 0.004 qw( Iri );
use namespace::autoclean;

our $VERSION = '1.10';

=head1 NAME

URI::Namespace - A namespace URI/IRI class with autoload methods

=head1 SYNOPSIS

  use URI::Namespace;
  my $foaf = URI::Namespace->new( 'http://xmlns.com/foaf/0.1/' );
  print $foaf->as_string;
  print $foaf->name;

=head1 DESCRIPTION

This module provides an object with a URI/IRI attribute, typically used
prefix-namespace pairs, typically used in XML, RDF serializations,
etc. The local part can be used as a method, these are autoloaded.

=head1 METHODS

=over

=item C<< new ( $string | URI | IRI ) >>

This is the constructor. You may pass a string with a URI or a URI object.

=item C<< uri ( [ $local_part ] ) >>

Returns a L<URI> object with the namespace IRI. Optionally, the method
can take a local part as argument, in which case, it will return the
namespace URI with the local part appended.

=item C<< iri ( [ $local_part ] ) >>

Returns a L<IRI> object with the namespace IRI. Optionally, the method
can take a local part as argument, in which case, it will return the
namespace IRI with the local part appended.

=item C<< local_part ( $uri ) >>

Returns the local part string if the given argument URI (which may be
a string, L<URI> or L<IRI> object) matches the namespace URI, or
C<undef> if not.


=back

The following methods from L<URI> can be used on an URI::Namespace object: C<as_string>, C<as_iri>, C<canonical>, C<eq>, C<abs>, C<rel>.

One important usage for this module is to enable you to create L<URI>s for full URIs, e.g.:

  print $foaf->Person->as_string;

will return

  http://xmlns.com/foaf/0.1/Person

=head1 FURTHER DETAILS

See L<URI::NamespaceMap> for further details about authors, license, etc.

=cut

around BUILDARGS => sub {
	my ($next, $self, @parameters) = @_;
	return $self->$next(@_) if ((@parameters > 1) || (ref($parameters[0]) eq 'HASH'));
	return { _uri => $parameters[0] };
};

has _uri => (
             is => "ro",
             isa => Iri,
             coerce => 1,
             required => 1,
             handles => {
                         'as_string' => 'as_string',
                         'as_iri' => 'as_string',
                        }
            );

sub iri {
	my ($self, $name) = @_;
	if (defined($name)) {
		my $str = $self->_uri->as_string;
		# XSD is given without hash in XML world, but hash should be added anyway (see issue #14)
		$str .= '#' if ($str eq 'http://www.w3.org/2001/XMLSchema');
		return IRI->new($str . "$name");
	} else {
		return $self->_uri;
	}
}

sub uri {
	my ($self, $name) = @_;
	my $iri = $self->_uri->as_string;
	if (defined($name)) {
		$iri .= '#' if ($iri eq 'http://www.w3.org/2001/XMLSchema');
		return URI->new($iri . "$name");
	} else {
		return URI->new($iri);
	}
}

sub local_part {
  my ($self, $fulluri) = @_;
  my $local_part = undef;
  if (blessed($fulluri) && $fulluri->isa('IRI')) {
	 $fulluri = $fulluri->as_string;
  }
  my $iri = $self->_uri->as_string;
  if ($fulluri =~ m/^$iri(.+)/) {
	 $local_part = $1;
  } else {
	 # TODO: throw error?
  }
  return $local_part;
}


for my $method (qw/ abs rel eq canonical /) {
	eval qq[ sub $method { shift->uri->${method}(\@_) } ];
}

sub DESTROY { }

our $AUTOLOAD;
sub AUTOLOAD {
	my $self = shift;
	my ($name) = $AUTOLOAD =~ /::(\w+)$/;
	return $self->uri($name);
}

1;
__END__