File Coverage

blib/lib/URI/BNode.pm
Criterion Covered Total %
statement 19 21 90.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 26 28 92.8


line stmt bran cond sub pod time code
1             package URI::BNode;
2              
3 1     1   23738 use 5.010;
  1         3  
  1         33  
4 1     1   4 use strict;
  1         3  
  1         37  
5 1     1   4 use warnings FATAL => 'all';
  1         5  
  1         53  
6              
7 1     1   7 use base qw(URI);
  1         1  
  1         2869  
8              
9 1     1   15887 use Carp ();
  1         2  
  1         18  
10 1     1   8 use Scalar::Util ();
  1         2  
  1         16  
11 1     1   638 use Data::GUID::Any ();
  0            
  0            
12             use Data::UUID::NCName ();
13              
14             # lolol
15              
16             our $PN_CHARS_BASE = qr/[A-Za-z\x{00C0}-\x{00D6}}\x{00D8}-\x{00F6}
17             \x{00F8}-\x{02FF}\x{0370}-\x{037D}
18             \x{037F}-\x{1FFF}\x{200C}-\x{200D}
19             \x{2070}-\x{218F}\x{2C00}-\x{2FEF}
20             \x{3001}-\x{D7FF}\x{F900}-\x{FDCF}
21             \x{FDF0}-\x{FFFD}\x{10000}-\x{EFFFF}]/ox;
22              
23             # from the turtle spec: http://www.w3.org/TR/turtle/#BNodes
24             our $BNODE = qr/^\s*(_:)?((?:$PN_CHARS_BASE|[_0-9])
25             (?:$PN_CHARS_BASE|[._0-9\x{00B7}
26             \x{0300}-\x{036F}\x{203F}-\x{2040}-])*
27             (?:$PN_CHARS_BASE|[_0-9\x{00B7}
28             \x{0300}-\x{036F}\x{203F}-\x{2040}-])*)
29             \s*$/osmx;
30              
31             sub _uuid () {
32             lc Data::GUID::Any::v4_guid_as_string();
33             }
34              
35             =head1 NAME
36              
37             URI::BNode - RDF blank node identifiers which are also URI objects
38              
39             =head1 VERSION
40              
41             Version 0.06
42              
43             =cut
44              
45             our $VERSION = '0.06';
46              
47             =head1 SYNOPSIS
48              
49             my $bnode = URI::BNode->new;
50              
51             print "$bnode\n"; # something like _:EH_kW827XQ6vvX0yF8YzRA
52              
53             =head1 DESCRIPTION
54              
55             This module has two purposes:
56              
57             =over 4
58              
59             =item 1
60              
61             Provide a reliable factory interface for generating RDF blank nodes
62             (via random UUIDs permuted through L).
63              
64             =item 2
65              
66             When an RDF blank node class is a subclass of URI, you can use
67             identity tests to make more robust RDF interfaces, like so:
68              
69             $node->isa('URI'); # either URI or bnode, but not literal
70             $node->isa('URI::BNode'); # narrow it down further
71              
72             Along the same vein, coerce string literals into the correct class by
73             heuristic:
74              
75             my $subject = '_:foo';
76             my $node = URI::BNode->new($subject); # _:foo becomes a bnode
77              
78             # URI::BNode->new('http://foo/') would properly become
79             # a URI::http object.
80              
81             =back
82              
83             =head1 METHODS
84              
85             =head2 new [$ID]
86              
87             Creates a new blank node identifier. If C<$ID> is undefined or empty,
88             one will be generated using L. If C<$ID> has a
89             value, it must either begin with C<_:> or conform to the blank node
90             syntax from the Turtle spec. Other values, including other URIs, will
91             be passed to the L constructor.
92              
93             =cut
94              
95             sub new {
96             my $class = shift;
97              
98             my $bnode = _validate(@_);
99             return URI->new(@_) unless defined $bnode;
100              
101             bless \$bnode, $class;
102             }
103              
104             sub _validate {
105             my $val = shift;
106              
107             if (!defined $val or $val eq '' or $val eq '_:') {
108             $val = Data::UUID::NCName::to_ncname(_uuid);
109             }
110             elsif (my ($scheme, $opaque) = ($val =~ $BNODE)) {
111             $val = $opaque;
112             }
113             else {
114             return;
115             }
116              
117             "_:$val";
118             }
119              
120             =head2 name [$NEWVAL]
121              
122             Alias for L.
123              
124             =head2 opaque [$NEWVAL]
125              
126             Retrieve or, if supplied a value, replace the blank node's value with
127             a new one. This method will croak if passed a C<$NEWVAL> which doesn't
128             match the spec in L.
129              
130             =cut
131              
132             sub opaque {
133             my $self = shift;
134             if (@_) {
135             my $val = _validate(@_) or
136             Carp::croak("Blank node identifier doesn't match Turtle spec");
137             $$self = $val;
138             }
139              
140             (split(/:/, $$self, 2))[1];
141             }
142              
143             *name = \&opaque;
144              
145             # dirty little scheme function
146             sub _scheme {
147             return '_';
148             }
149              
150             =head2 from_uuid_urn $UUID
151              
152             Takes a L object and turns it into a blank node. Can
153             be invoked as either a class or an instance method.
154              
155             =cut
156              
157             sub from_uuid_urn {
158             my ($class, $uuid) = @_;
159             return unless defined $uuid and Scalar::Util::blessed($uuid)
160             and $uuid->isa('URI::urn::uuid');
161             $class = ref $class || $class;
162             $class->new('_:' . Data::UUID::NCName::to_ncname($uuid->uuid));
163             }
164              
165             =head2 to_uuid_urn
166              
167             Takes a blank node (in L) and
168             turns it into a L object.
169              
170             =cut
171              
172             sub to_uuid_urn {
173             my $self = shift;
174             my $opaque = $self->opaque;
175             return unless $opaque =~ /^[A-J][0-9A-Za-z_-]{21}(?:[0-9A-Z]{4})?$/;
176             URI->new('urn:uuid:' . Data::UUID::NCName::from_ncname($opaque));
177             }
178              
179             =head2 skolemize $AUTHORITY
180              
181             Return the skolemized URI (C<$AUTHORITY/.well-known/genid/...>) for a
182             given blank node. See
183             L.
184              
185             =cut
186              
187             sub skolemize {
188             my ($self, $base) = @_;
189             return unless Scalar::Util::blessed($base) and $base->isa('URI')
190             and $base->can('authority') and $base->can('path');
191             $base = $base->canonical->clone;
192             $base->path('/.well-known/genid/' . $self->opaque);
193             $base;
194             }
195              
196             =head2 de_skolemize $URI
197              
198             Take a skolemized URI like C
199             and turn it into C<_:asdf>.
200              
201             =cut
202              
203             sub de_skolemize {
204             my ($class, $uri) = @_;
205             return unless Scalar::Util::blessed($uri) and $uri->isa('URI')
206             and $uri->can('authority') and $uri->can('path')
207             and $uri->path =~ m!^/.well-known/genid/(.*)!;
208              
209             # check this sucka up front
210             my $candidate = _validate($1) or return;
211              
212             # this is a static method
213             $class = ref $class || $class;
214              
215             # no need to invoke the constructor, candidate is already valid.
216             bless \$candidate, $class;
217             }
218              
219             =head1 AUTHOR
220              
221             Dorian Taylor, C<< >>
222              
223             =head1 BUGS
224              
225             Please report any bugs or feature requests to C
226             rt.cpan.org>, or through the web interface at
227             L. I will
228             be notified, and then you'll automatically be notified of progress on
229             your bug as I make changes.
230              
231              
232             =head1 SUPPORT
233              
234             You can find documentation for this module with the perldoc command.
235              
236             perldoc URI::BNode
237              
238              
239             You can also look for information at:
240              
241             =over 4
242              
243             =item * RT: CPAN's request tracker (report bugs here)
244              
245             L
246              
247             =item * AnnoCPAN: Annotated CPAN documentation
248              
249             L
250              
251             =item * CPAN Ratings
252              
253             L
254              
255             =item * Search CPAN
256              
257             L
258              
259             =back
260              
261              
262             =head1 SEE ALSO
263              
264             =over 4
265              
266             =item L
267              
268             =item L
269              
270             =back
271              
272             =head1 LICENSE AND COPYRIGHT
273              
274             Copyright 2013 Dorian Taylor.
275              
276             Licensed under the Apache License, Version 2.0 (the "License"); you
277             may not use this file except in compliance with the License. You may
278             obtain a copy of the License at
279             L.
280              
281             Unless required by applicable law or agreed to in writing, software
282             distributed under the License is distributed on an "AS IS" BASIS,
283             WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
284             See the License for the specific language governing permissions and
285             limitations under the License.
286              
287              
288             =cut
289              
290             1; # End of URI::BNode