| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package SKOS::Simple; |
|
2
|
|
|
|
|
|
|
{ |
|
3
|
|
|
|
|
|
|
$SKOS::Simple::VERSION = '0.09_01'; |
|
4
|
|
|
|
|
|
|
} |
|
5
|
|
|
|
|
|
|
#ABSTRACT: Create simple SKOS data with entailment |
|
6
|
|
|
|
|
|
|
|
|
7
|
5
|
|
|
5
|
|
65924
|
use strict; |
|
|
5
|
|
|
|
|
13
|
|
|
|
5
|
|
|
|
|
212
|
|
|
8
|
5
|
|
|
5
|
|
28
|
use warnings; |
|
|
5
|
|
|
|
|
11
|
|
|
|
5
|
|
|
|
|
171
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
5
|
|
|
5
|
|
31
|
use Scalar::Util qw(blessed reftype); |
|
|
5
|
|
|
|
|
25
|
|
|
|
5
|
|
|
|
|
532
|
|
|
11
|
5
|
|
|
5
|
|
4500
|
use Turtle::Writer; |
|
|
5
|
|
|
|
|
5067
|
|
|
|
5
|
|
|
|
|
353
|
|
|
12
|
5
|
|
|
5
|
|
32
|
use Carp; |
|
|
5
|
|
|
|
|
13
|
|
|
|
5
|
|
|
|
|
271
|
|
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
This module provides a simple class to create and handle classifications, |
|
17
|
|
|
|
|
|
|
thesauri and similar systems in Simple Knowledge Organization System (SKOS) |
|
18
|
|
|
|
|
|
|
data model. Most features of SKOS, as specified at |
|
19
|
|
|
|
|
|
|
L, are supported. In addition there |
|
20
|
|
|
|
|
|
|
are some useful constraints, which mostly derive from best-practice. |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
In contrast to other RDF-related modules, SKOS::Simple does not depend on |
|
23
|
|
|
|
|
|
|
any non-core Perl modules, so you can install it by just copying one file. |
|
24
|
|
|
|
|
|
|
The module implements basic entailment rules of the SKOS standard without |
|
25
|
|
|
|
|
|
|
the burden of a full RDF reasoning engine. Actually, you can use this |
|
26
|
|
|
|
|
|
|
module without having to deal with any details of RDF. |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
The current version of this class is optimized form creating and serializing |
|
29
|
|
|
|
|
|
|
valid SKOS schemes, but not for reading and modifying them. A common use case |
|
30
|
|
|
|
|
|
|
of SKOS::Simple is to transform a given terminology from some custom format |
|
31
|
|
|
|
|
|
|
to SKOS, which is then L in Terse RDF |
|
32
|
|
|
|
|
|
|
Triple language (Turtle). You can then publish the Turtle data and/or process |
|
33
|
|
|
|
|
|
|
them with general RDF and SKOS tools. |
|
34
|
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
my $skos = SKOS::Simple->new( |
|
38
|
|
|
|
|
|
|
base => 'http://example.com/kos/', |
|
39
|
|
|
|
|
|
|
title => 'My little Knowledge Organization System', |
|
40
|
|
|
|
|
|
|
hierarchy => 'tree' # check classification constraints |
|
41
|
|
|
|
|
|
|
); |
|
42
|
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
$skos->addConcept( pref => { en => 'foo', ru => 'baz' } ); |
|
44
|
|
|
|
|
|
|
$skos->addConcept( notation => '42.X-23' ); |
|
45
|
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
print $skos->turtle; |
|
47
|
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=cut |
|
49
|
|
|
|
|
|
|
|
|
50
|
5
|
|
|
5
|
|
26
|
use base 'Exporter'; |
|
|
5
|
|
|
|
|
9
|
|
|
|
5
|
|
|
|
|
29191
|
|
|
51
|
|
|
|
|
|
|
our @EXPORT_OK = qw(skos); |
|
52
|
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
our %NAMESPACES = ( |
|
54
|
|
|
|
|
|
|
rdf => 'http://www.w3.org/1999/02/22-rdf-syntax-ns#', |
|
55
|
|
|
|
|
|
|
skos => 'http://www.w3.org/2004/02/skos/core#', |
|
56
|
|
|
|
|
|
|
dc => 'http://purl.org/dc/elements/1.1/', |
|
57
|
|
|
|
|
|
|
foaf => 'http://xmlns.com/foaf/0.1/', |
|
58
|
|
|
|
|
|
|
void => 'http://rdfs.org/ns/void#', |
|
59
|
|
|
|
|
|
|
dct => 'http://purl.org/dc/terms/', |
|
60
|
|
|
|
|
|
|
xsd => 'http://www.w3.org/2001/XMLSchema#', |
|
61
|
|
|
|
|
|
|
skosxl => 'http://www.w3.org/2008/05/skos-xl#', |
|
62
|
|
|
|
|
|
|
owl => 'http://www.w3.org/2002/07/owl#', |
|
63
|
|
|
|
|
|
|
); |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=head1 SKOS CONFORMANCE |
|
66
|
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
The following classes and properties from the SKOS vocabulary are supported. |
|
68
|
|
|
|
|
|
|
The numbers in brackets (B<[Sxx]>) refer to integrity conditions from the |
|
69
|
|
|
|
|
|
|
SKOS specification. Additional constraints are marked by numbers like B<[Cxx]>. |
|
70
|
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=over 4 |
|
72
|
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=item L |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Instances of C B<[S1]> are not represented as objects but as |
|
76
|
|
|
|
|
|
|
parts of a SKOS::Simple object, so every Concepts must belong to a Concept |
|
77
|
|
|
|
|
|
|
Scheme B<[C1]>. You can attach Concepts to a scheme with L. |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=item L |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
Instances of C are implemented as objects of type |
|
82
|
|
|
|
|
|
|
SKOS::Simple B<[S2]>. Concepts added to a scheme are automatically connected |
|
83
|
|
|
|
|
|
|
to the scheme via C B<[S3-S4]> (only serialized if requested). |
|
84
|
|
|
|
|
|
|
Concepts can be selected as top concepts (C / |
|
85
|
|
|
|
|
|
|
C B<[S5-S8]>). In contrast to the SKOS specification, |
|
86
|
|
|
|
|
|
|
(L) the top concepts |
|
87
|
|
|
|
|
|
|
of a scheme cannot have broader concepts in the same scheme B<[C2]>. |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Concepts and concept schemes must be disjoint B<[S9]>. This is ensured only |
|
90
|
|
|
|
|
|
|
if you do not use a C but a C parameter. |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=item L |
|
93
|
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
The label types C, C, and C |
|
95
|
|
|
|
|
|
|
are supported. In addition this module supports the label properties |
|
96
|
|
|
|
|
|
|
C and C, which are not explicitly included in the |
|
97
|
|
|
|
|
|
|
SKOS reference. |
|
98
|
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
C as super-property of C, C, |
|
100
|
|
|
|
|
|
|
and C will be supported in a later version. |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=item L |
|
103
|
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
Notations (C) must be unique per concept and scheme |
|
105
|
|
|
|
|
|
|
B<[C3]>. |
|
106
|
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
|
108
|
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
our %LABEL_PROPERTIES = map { $_ => 1 } qw(prefLabel altLabel hiddenLabel); |
|
110
|
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
our %LABEL_TYPES = ( |
|
112
|
|
|
|
|
|
|
pref => 'skos:prefLabel', # TODO: sub-property of rdfs:label |
|
113
|
|
|
|
|
|
|
alt => 'skos:altLabel', # dito |
|
114
|
|
|
|
|
|
|
hidden => 'skos:hiddenLabel', # dito |
|
115
|
|
|
|
|
|
|
title => 'dc:title' |
|
116
|
|
|
|
|
|
|
); |
|
117
|
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item L |
|
119
|
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
So called "semantic" relations (C) include |
|
121
|
|
|
|
|
|
|
C, C, and C. |
|
122
|
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
The C and C are currently |
|
124
|
|
|
|
|
|
|
not supported. |
|
125
|
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
With this module you can only model semantic relations between concepts |
|
127
|
|
|
|
|
|
|
in the same scheme. |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=cut |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
our %RELATION_PROPERTIES = map { $_ => 1 } qw(semanticRelation |
|
132
|
|
|
|
|
|
|
broader narrower related broaderTransitive narrowerTransitive); |
|
133
|
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item L |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
C, C, C, C, |
|
137
|
|
|
|
|
|
|
C, C and C can be used to |
|
138
|
|
|
|
|
|
|
document concepts. In contrast to the SKOS specification their range is |
|
139
|
|
|
|
|
|
|
limited to literal values B<[C4]>. |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=cut |
|
142
|
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
our %NOTE_PROPERTIES = map { $_ => 1 } qw(note |
|
144
|
|
|
|
|
|
|
changeNote definition editorialNote example historyNote scopeNote); |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=back |
|
147
|
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Concept Collections (C, C, |
|
149
|
|
|
|
|
|
|
C, C) and SKOS extension for labels |
|
150
|
|
|
|
|
|
|
(C etc.) are not supported. Mapping Properties |
|
151
|
|
|
|
|
|
|
(C, C, C, |
|
152
|
|
|
|
|
|
|
C, C, C) will |
|
153
|
|
|
|
|
|
|
probably be implemented in another module. |
|
154
|
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |
|
156
|
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
our %MAPPING_PROPERTIES = map { $_ => 1 } qw(mappingRelation |
|
158
|
|
|
|
|
|
|
closeMatch exactMatch broadMatch narrowMatch relatedMatch); |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# dublin core elements |
|
161
|
|
|
|
|
|
|
our %DC_PROPERTIES = map { $_ => "dc:$_" } |
|
162
|
|
|
|
|
|
|
qw(contributor coverage creator date description format identifier |
|
163
|
|
|
|
|
|
|
language publisher relation rights source subject title type); |
|
164
|
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# To add RDF data beyond the SKOS data model, you can use the |
|
166
|
|
|
|
|
|
|
# L. |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 ADDITIONAL CONSTRAINTS |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
The current version of this module aims at classifications. |
|
171
|
|
|
|
|
|
|
Support for thesauri will be implemented later. |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
An instance of SKOS::Simple holds exactely one skos:ConceptScheme with |
|
174
|
|
|
|
|
|
|
the following properties: |
|
175
|
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=over 4 |
|
177
|
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item * |
|
179
|
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
All concepts share a common URI base. By default this common prefix is |
|
181
|
|
|
|
|
|
|
also the URI of the concept scheme as whole. |
|
182
|
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=item * |
|
184
|
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
All concepts must be identifyable by a unique string, that is refered |
|
186
|
|
|
|
|
|
|
to as the concept identifier. The URI of a concept is build of the |
|
187
|
|
|
|
|
|
|
common URI prefix and the concept's identifier. The identifier must |
|
188
|
|
|
|
|
|
|
either be the skos:notation (so every concept must have one), or the |
|
189
|
|
|
|
|
|
|
skos:prefLabel in one fixed language for all concepts. The only exception |
|
190
|
|
|
|
|
|
|
to this rule are filters, for instance to uri-encode the prefLabel/notation. |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=item * |
|
193
|
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
Empty strings as literal values are ignored. In most cases you can use |
|
195
|
|
|
|
|
|
|
C and C<""> interchangeably. |
|
196
|
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=item * |
|
198
|
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
All notations have the same Datatype URI (this may be changed). |
|
200
|
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=item * |
|
202
|
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
The range of all documentation properties (C, C, |
|
204
|
|
|
|
|
|
|
C etc.) is the plain literals instead of any resource. |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=item * |
|
207
|
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
I<...sure there are some more limitations...> |
|
209
|
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
=back |
|
211
|
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
=head1 METHODS |
|
213
|
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head2 new( [ %properties ] ) |
|
215
|
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
Creates a new concept scheme with the following properties: |
|
217
|
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
=over 4 |
|
219
|
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=item base |
|
221
|
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
The URI prefix that is used for all concepts (not required but recommended). |
|
223
|
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=item scheme |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
The URI of the whole concept scheme (C). |
|
227
|
|
|
|
|
|
|
By default the C property is used as concept scheme URI. |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
=item title |
|
230
|
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
Title(s) of the concept scheme. Must be either a string or a |
|
232
|
|
|
|
|
|
|
hash that maps language tags to strings. |
|
233
|
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=item namespaces |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
An optional hash with additional namespaces. You can also override standard |
|
237
|
|
|
|
|
|
|
namespaces (e.g. C). All namespaces explicitly specified by this |
|
238
|
|
|
|
|
|
|
parameter are always included as C<< @prefix >> in the Turtle output. |
|
239
|
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=item language |
|
241
|
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Language tag of the default language. By default set to C. |
|
243
|
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=item hierarchy |
|
245
|
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
Either C or C or the empty string for no hierarchy check |
|
247
|
|
|
|
|
|
|
(default). At the moment only C is supported. |
|
248
|
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=item identity |
|
250
|
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
Specifies which property is used as concept identifier. Possible |
|
252
|
|
|
|
|
|
|
values are C |
|
253
|
|
|
|
|
|
|
and C (C). If no value is given, you must |
|
254
|
|
|
|
|
|
|
either specify C |
|
255
|
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
=item label |
|
257
|
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
Specifies how to encode concept labels. Possible values are C |
|
259
|
|
|
|
|
|
|
(C), which is the default value and implied if |
|
260
|
|
|
|
|
|
|
C<< identify => 'label' >>, C (C, |
|
261
|
|
|
|
|
|
|
C (C) and C (C). |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=item notation |
|
264
|
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Specifies whether to check notations to be unique (C) and/or |
|
266
|
|
|
|
|
|
|
mandatory (C) per concept. C<< identity => 'notation' >> |
|
267
|
|
|
|
|
|
|
implies C<< notation => 'unique' >>. |
|
268
|
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=item properties |
|
270
|
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Additional properties as structured Turtle. Triples with predicates |
|
272
|
|
|
|
|
|
|
C, C, and C are not allowed but removed. |
|
273
|
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=item description |
|
275
|
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
not supported yet. |
|
277
|
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
=back |
|
279
|
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=cut |
|
281
|
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub new { |
|
283
|
15
|
|
|
15
|
1
|
12780
|
my $class = shift; |
|
284
|
15
|
|
|
|
|
54
|
my (%arg) = @_; |
|
285
|
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
my $self = bless( { |
|
287
|
|
|
|
|
|
|
concepts => { }, |
|
288
|
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
prop => { }, |
|
290
|
|
|
|
|
|
|
related => { }, |
|
291
|
|
|
|
|
|
|
top => { }, # ids of top concepts |
|
292
|
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
u_notation => { }, |
|
294
|
|
|
|
|
|
|
u_label => { }, |
|
295
|
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
hierarchy => ($arg{hierarchy} || ""), # tree|thesaurus| |
|
297
|
|
|
|
|
|
|
base => ($arg{base} || ""), |
|
298
|
|
|
|
|
|
|
scheme => ($arg{scheme} || ""), |
|
299
|
|
|
|
|
|
|
title => ($arg{title} || ""), |
|
300
|
|
|
|
|
|
|
namespaces => ($arg{namespaces} || { }), # TODO: count usage (?) |
|
301
|
|
|
|
|
|
|
language => ($arg{language} || "en"), # TODO: check tag |
|
302
|
|
|
|
|
|
|
description => ($arg{description} || ""), # TODO: add |
|
303
|
|
|
|
|
|
|
|
|
304
|
12
|
|
|
12
|
|
33
|
idescape => $arg{idescape} || sub { $_[0]; }, # TODO: uri-escape |
|
305
|
|
|
|
|
|
|
|
|
306
|
15
|
|
50
|
|
|
2232
|
identity => ($arg{identity} || ""), |
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
307
|
|
|
|
|
|
|
label => ($arg{label} || ""), # label type |
|
308
|
|
|
|
|
|
|
notation => ($arg{notation} || ""), |
|
309
|
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
}, $class ); |
|
311
|
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
# TODO: croak "base of scheme missing" unless $self->{base}; |
|
313
|
15
|
50
|
|
|
|
73
|
croak "base must be an URI" unless uri_or_empty($self->{base}); |
|
314
|
15
|
50
|
|
|
|
48
|
croak "scheme must be an URI" unless uri_or_empty($self->{scheme}); |
|
315
|
15
|
100
|
|
|
|
64
|
$self->{scheme} = "" if $self->{scheme} eq $self->{base}; |
|
316
|
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
#### identifier, label, notation |
|
318
|
|
|
|
|
|
|
|
|
319
|
15
|
100
|
|
|
|
46
|
if ( !$self->{identity} ) { |
|
|
3
|
50
|
|
|
|
14
|
|
|
320
|
14
|
50
|
|
|
|
55
|
if ( $self->{label} eq 'unique' ) { |
|
|
|
100
|
|
|
|
|
|
|
321
|
0
|
|
|
|
|
0
|
$self->{identity} = 'label'; |
|
322
|
|
|
|
|
|
|
} elsif ( $self->{notation} eq 'unique' ) { |
|
323
|
2
|
|
|
|
|
7
|
$self->{identity} = 'notation'; |
|
324
|
|
|
|
|
|
|
} else { |
|
325
|
|
|
|
|
|
|
# TODO: do we want this? |
|
326
|
12
|
|
|
|
|
28
|
$self->{identity} = 'label'; |
|
327
|
|
|
|
|
|
|
# croak "concept identification not specified"; |
|
328
|
|
|
|
|
|
|
} |
|
329
|
|
|
|
|
|
|
} elsif ( !(grep { $self->{identity} eq $_ } qw(label notation identifier)) ) { |
|
330
|
0
|
|
|
|
|
0
|
croak "concept identification must be 'label', 'notation', or 'identifier'"; |
|
331
|
|
|
|
|
|
|
} # NOTE: we may add 'id' (internal id) as another method |
|
332
|
|
|
|
|
|
|
|
|
333
|
15
|
50
|
|
|
|
38
|
if ( $self->{label} ) { |
|
334
|
0
|
|
|
|
|
0
|
croak "label type must be one of " . join(", ", keys %LABEL_TYPES) |
|
335
|
0
|
0
|
|
|
|
0
|
unless ( grep { $self->{label} eq $_ } keys %LABEL_TYPES ); |
|
336
|
|
|
|
|
|
|
} else { |
|
337
|
15
|
|
|
|
|
34
|
$self->{label} = 'pref'; |
|
338
|
|
|
|
|
|
|
} |
|
339
|
|
|
|
|
|
|
|
|
340
|
15
|
100
|
|
|
|
40
|
if ( $self->{notation} ) { |
|
341
|
4
|
|
|
|
|
16
|
croak "notation type can only be 'unique' or 'mandatory'" |
|
342
|
2
|
50
|
|
|
|
5
|
unless ( grep { $self->{notation} eq $_ } qw(unique mandatory) ); |
|
343
|
|
|
|
|
|
|
} |
|
344
|
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
# mandatory namespaces |
|
346
|
|
|
|
|
|
|
|
|
347
|
15
|
100
|
|
|
|
74
|
$self->{namespaces}->{skos} = $NAMESPACES{skos} |
|
348
|
|
|
|
|
|
|
unless $self->{namespaces}->{skos}; |
|
349
|
|
|
|
|
|
|
|
|
350
|
15
|
50
|
33
|
|
|
54
|
$self->{namespaces}->{void} = $NAMESPACES{void} |
|
351
|
|
|
|
|
|
|
if ( $arg{void} and not $self->{namespaces}->{void} ); |
|
352
|
|
|
|
|
|
|
|
|
353
|
15
|
100
|
66
|
|
|
106
|
$self->{namespaces}->{dc} = $NAMESPACES{dc} |
|
|
|
|
100
|
|
|
|
|
|
354
|
|
|
|
|
|
|
if ( ($self->{title} || $self->{description}) && not $self->{namespaces}->{dc}); |
|
355
|
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
# Add default language, if title without language given |
|
357
|
15
|
|
|
|
|
25
|
my $lang = $self->{language}; |
|
358
|
15
|
100
|
66
|
|
|
63
|
if ($self->{title} && not ref($self->{title}) && $lang) { |
|
|
|
|
100
|
|
|
|
|
|
359
|
2
|
|
|
|
|
7
|
$self->{title} = { $lang => $self->{title} }; |
|
360
|
|
|
|
|
|
|
} |
|
361
|
|
|
|
|
|
|
|
|
362
|
15
|
|
|
|
|
41
|
my @types = ('skos:ConceptScheme'); |
|
363
|
|
|
|
|
|
|
|
|
364
|
15
|
50
|
|
|
|
48
|
if ( my $pattern = delete $arg{idpattern} ) { |
|
365
|
0
|
|
|
|
|
0
|
$self->{idregexp} = qr/^$pattern$/; |
|
366
|
0
|
|
|
|
|
0
|
my $basepattern = $self->{base}; |
|
367
|
0
|
|
|
|
|
0
|
$basepattern =~ s/[.]/\\./g; |
|
368
|
0
|
|
|
|
|
0
|
$basepattern =~ s/[?]/\\?/g; # TODO: escape more nasty stuff in base URI |
|
369
|
0
|
|
|
|
|
0
|
$self->{idpattern} = "^$basepattern$pattern\$"; |
|
370
|
|
|
|
|
|
|
} |
|
371
|
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# TODO: license (dct:license) |
|
373
|
|
|
|
|
|
|
|
|
374
|
15
|
50
|
|
|
|
39
|
if ( $arg{void} ) { |
|
375
|
0
|
|
|
|
|
0
|
$self->{void} = 1; # TODO: document this |
|
376
|
0
|
0
|
|
|
|
0
|
push @types, 'void:Dataset' if $arg{void}; |
|
377
|
0
|
|
|
|
|
0
|
$self->{prop}->{'void:uriSpace'} = turtle_uri($self->{base}); |
|
378
|
0
|
|
|
|
|
0
|
$self->{prop}->{'void:rootResource'} = turtle_uri($self->{base}); |
|
379
|
0
|
0
|
|
|
|
0
|
if ( $self->{idpattern} ) { |
|
380
|
0
|
|
|
|
|
0
|
$self->{prop}->{'void:uriRegexPattern'} = turtle_literal($self->{idpattern}); |
|
381
|
|
|
|
|
|
|
} |
|
382
|
|
|
|
|
|
|
} |
|
383
|
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
# TODO: allow additional types |
|
385
|
|
|
|
|
|
|
|
|
386
|
15
|
|
|
|
|
47
|
$self->{prop}->{a} = \@types; |
|
387
|
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# additional properties |
|
389
|
15
|
100
|
|
|
|
56
|
if ( $arg{properties} ) { |
|
390
|
1
|
|
|
|
|
3
|
my $p = $arg{properties}; |
|
391
|
1
|
|
|
|
|
3
|
my $a = delete $p->{a}; |
|
392
|
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
# TODO: also filter other namespaces and full URI forms |
|
394
|
1
|
|
|
|
|
4
|
my @s = grep { $_ =~ /skos:/ } keys %$p; |
|
|
2
|
|
|
|
|
9
|
|
|
395
|
1
|
|
|
|
|
5
|
delete $p->{$_} for @s; |
|
396
|
|
|
|
|
|
|
|
|
397
|
1
|
|
|
|
|
7
|
while ( my ($key, $value) = each %$p ) { |
|
398
|
1
|
|
|
|
|
6
|
$self->{prop}->{$key} = $value; |
|
399
|
|
|
|
|
|
|
} |
|
400
|
|
|
|
|
|
|
} |
|
401
|
|
|
|
|
|
|
|
|
402
|
15
|
100
|
|
|
|
80
|
$self->{prop}->{'dc:title'} = |
|
403
|
|
|
|
|
|
|
$self->{title} eq '' ? '' : turtle_literal_list( $self->{title} ); |
|
404
|
|
|
|
|
|
|
|
|
405
|
15
|
|
50
|
|
|
205
|
my $page = (delete $arg{page} || ""); |
|
406
|
|
|
|
|
|
|
|
|
407
|
15
|
50
|
|
|
|
63
|
$self->{prop}->{'foaf:page'} = |
|
408
|
|
|
|
|
|
|
$page eq '' ? '' : turtle_uri( $page ); |
|
409
|
|
|
|
|
|
|
|
|
410
|
15
|
50
|
33
|
|
|
46
|
$self->{namespaces}->{foaf} = $NAMESPACES{foaf} |
|
411
|
|
|
|
|
|
|
if ( $page ne "" and not $self->{namespaces}->{foaf} ); |
|
412
|
|
|
|
|
|
|
|
|
413
|
15
|
|
|
|
|
86
|
return $self; |
|
414
|
|
|
|
|
|
|
} |
|
415
|
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
sub _values { |
|
417
|
|
|
|
|
|
|
# TODO: also allow hashref (?) |
|
418
|
70
|
50
|
33
|
70
|
|
108
|
my @values = map { (reftype($_) && reftype($_) eq 'ARRAY') ? @$_ : $_ } @_; |
|
|
70
|
|
|
|
|
321
|
|
|
419
|
70
|
100
|
|
|
|
109
|
@values = grep { $_ and $_ ne '' } @values; |
|
|
70
|
|
|
|
|
825
|
|
|
420
|
70
|
|
|
|
|
134
|
return @values; |
|
421
|
|
|
|
|
|
|
} |
|
422
|
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
=head2 addConcept ( %properties ) |
|
424
|
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
Adds a concept with given properties. Only the identifying property to be |
|
426
|
|
|
|
|
|
|
used as concept id (C, C |
|
427
|
|
|
|
|
|
|
mandatory. If there already is a concept with the same id, both are merged! |
|
428
|
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
Returns the id of the added or modfied concept. |
|
430
|
|
|
|
|
|
|
|
|
431
|
|
|
|
|
|
|
=cut |
|
432
|
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
sub addConcept { |
|
434
|
7
|
|
|
7
|
1
|
2180
|
my $self = shift; |
|
435
|
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# ensures we have an 'id' and 'label' is a hashref |
|
437
|
7
|
|
|
|
|
29
|
my $arg = $self->conceptentification( @_ ); |
|
438
|
7
|
|
|
|
|
15
|
my $id = $arg->{id}; |
|
439
|
7
|
|
|
|
|
15
|
my $lang = $self->{language}; |
|
440
|
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
# TODO: check: Concepts and concept schemes must be disjoint [S9]. |
|
442
|
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# only for internal use |
|
444
|
7
|
|
|
|
|
14
|
my $nocheck = delete $arg->{_nocheck}; |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# connections to other concepts |
|
447
|
7
|
|
|
|
|
26
|
my @related = _values( delete $arg->{related} ); |
|
448
|
7
|
|
|
|
|
20
|
my @broader = _values( delete $arg->{broader} ); |
|
449
|
7
|
|
|
|
|
22
|
my @narrower = _values( delete $arg->{narrower} ); |
|
450
|
|
|
|
|
|
|
|
|
451
|
7
|
|
|
|
|
19
|
my $concept = $self->{concepts}->{$id}; |
|
452
|
7
|
100
|
|
|
|
28
|
unless ($self->{concepts}->{$id}) { |
|
453
|
5
|
|
|
|
|
38
|
$concept = $self->{concepts}->{$id} = { |
|
454
|
|
|
|
|
|
|
notation => "", |
|
455
|
|
|
|
|
|
|
broader => { }, |
|
456
|
|
|
|
|
|
|
narrower => { }, |
|
457
|
|
|
|
|
|
|
related => { }, |
|
458
|
|
|
|
|
|
|
}; |
|
459
|
|
|
|
|
|
|
} |
|
460
|
|
|
|
|
|
|
|
|
461
|
7
|
|
|
|
|
19
|
my $notation = delete $arg->{notation}; |
|
462
|
7
|
100
|
|
|
|
26
|
$notation = "" unless defined $notation; |
|
463
|
|
|
|
|
|
|
|
|
464
|
7
|
|
|
|
|
16
|
my $identifier = delete $arg->{identifier}; |
|
465
|
7
|
50
|
|
|
|
35
|
if ( defined $identifier ) { |
|
466
|
0
|
|
|
|
|
0
|
$concept->{identifier} = $identifier; |
|
467
|
0
|
|
|
|
|
0
|
$self->{uses_dc} = 1; |
|
468
|
|
|
|
|
|
|
} |
|
469
|
|
|
|
|
|
|
|
|
470
|
7
|
100
|
|
|
|
22
|
if ( $self->{notation} ) { # 'mandatory' or 'unique' |
|
471
|
6
|
50
|
33
|
|
|
37
|
$concept->{notation} = $notation |
|
472
|
|
|
|
|
|
|
if ( defined $notation and $notation ne '' ); |
|
473
|
6
|
50
|
|
|
|
16
|
croak 'Concepts must have a notation' |
|
474
|
|
|
|
|
|
|
if $concept->{notation} eq ''; |
|
475
|
6
|
50
|
|
|
|
21
|
if ( $self->{notation} eq 'unique' ) { |
|
476
|
|
|
|
|
|
|
# TODO: check uniqueness, if notation is not already the idtype |
|
477
|
|
|
|
|
|
|
# croak 'Concepts must be unique per notation' |
|
478
|
|
|
|
|
|
|
# if $self->{u_notation}->{ $notation }; |
|
479
|
|
|
|
|
|
|
# $self->{u_notation}->{ $notation } = $id; |
|
480
|
|
|
|
|
|
|
} |
|
481
|
|
|
|
|
|
|
} |
|
482
|
7
|
100
|
|
|
|
32
|
$concept->{notation} = $notation unless $notation eq ""; |
|
483
|
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
# add label properties |
|
485
|
7
|
|
|
|
|
26
|
foreach my $type ( keys %LABEL_TYPES ) { |
|
486
|
28
|
|
|
|
|
45
|
my $label = delete $arg->{$type}; |
|
487
|
28
|
100
|
|
|
|
139
|
next unless defined $label; |
|
488
|
|
|
|
|
|
|
# TODO: add to existing labels, check for unqiueness, mandatory etc. |
|
489
|
1
|
|
|
|
|
4
|
$concept->{$type} = $label; |
|
490
|
|
|
|
|
|
|
} |
|
491
|
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
# add documentation/note properties |
|
493
|
7
|
|
|
|
|
37
|
foreach my $name ( keys %NOTE_PROPERTIES ) { |
|
494
|
49
|
|
|
|
|
94
|
my @values = _values( delete $arg->{$name} ); |
|
495
|
49
|
50
|
|
|
|
154
|
if ( @values ) { |
|
496
|
0
|
|
|
|
|
0
|
push @{ $concept->{$name} }, @values; |
|
|
0
|
|
|
|
|
0
|
|
|
497
|
|
|
|
|
|
|
} |
|
498
|
|
|
|
|
|
|
# TODO: entail skos:note |
|
499
|
|
|
|
|
|
|
} |
|
500
|
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# additional constraint of SKOS::Simple |
|
502
|
7
|
50
|
66
|
|
|
42
|
croak "concept <$id> cannot have broader if it is top concept!" |
|
503
|
|
|
|
|
|
|
if ( @broader && $self->{top}->{$id} ); |
|
504
|
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# add inverse relations |
|
506
|
7
|
|
|
|
|
19
|
foreach my $i (@related) { |
|
507
|
0
|
0
|
|
|
|
0
|
next if $concept->{related}->{$i}; |
|
508
|
0
|
0
|
|
|
|
0
|
$self->addConcept( related => $id, _nocheck => 1, id => $i ) |
|
509
|
|
|
|
|
|
|
unless $nocheck; |
|
510
|
0
|
|
|
|
|
0
|
$concept->{related}->{$i} = 1; |
|
511
|
|
|
|
|
|
|
} |
|
512
|
7
|
|
|
|
|
17
|
foreach my $i (@broader) { |
|
513
|
2
|
50
|
|
|
|
10
|
next if $concept->{broader}->{$i}; |
|
514
|
2
|
50
|
|
|
|
9
|
if ( $self->{hierarchy} eq 'tree' ) { |
|
515
|
0
|
|
|
|
|
0
|
croak "tree property violated by <$id> skos:broader <$i>" |
|
516
|
0
|
0
|
|
|
|
0
|
if %{$concept->{broader}}; |
|
517
|
|
|
|
|
|
|
} # TODO: if 'multi[tree]': detect loops |
|
518
|
|
|
|
|
|
|
|
|
519
|
2
|
50
|
|
|
|
16
|
$self->addConcept( narrower => $id, _nocheck => 1, id => $i ) |
|
520
|
|
|
|
|
|
|
unless $nocheck; |
|
521
|
2
|
|
|
|
|
8
|
$concept->{broader}->{$i} = 1; |
|
522
|
|
|
|
|
|
|
} |
|
523
|
7
|
|
|
|
|
16
|
foreach my $i (@narrower) { |
|
524
|
2
|
50
|
|
|
|
10
|
next if $concept->{narrower}->{$i}; |
|
525
|
2
|
50
|
|
|
|
6
|
$self->addConcept( broader => $id, _nocheck => 1, id => $i ) |
|
526
|
|
|
|
|
|
|
unless $nocheck; |
|
527
|
2
|
|
|
|
|
11
|
$concept->{narrower}->{$i} = 1; |
|
528
|
|
|
|
|
|
|
} |
|
529
|
|
|
|
|
|
|
|
|
530
|
7
|
|
|
|
|
37
|
return $id; |
|
531
|
|
|
|
|
|
|
} |
|
532
|
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
=head2 topConcepts ( [ @ids ] ) |
|
534
|
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
Marks one or more concepts as top concepts. The given concepts must |
|
536
|
|
|
|
|
|
|
already exist and must not have any broader concepts. Without parameters, |
|
537
|
|
|
|
|
|
|
this methods returns a list of all top concept identifiers. Unless you |
|
538
|
|
|
|
|
|
|
explicitly specify top concepts, a list of I concepts without broader |
|
539
|
|
|
|
|
|
|
concepts is returned. As soon as you explicitly set some top concepts, |
|
540
|
|
|
|
|
|
|
they will be the I top concepts. You can reset the top concepts |
|
541
|
|
|
|
|
|
|
to all concepts without broader concepts, provide C as only argument. |
|
542
|
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
=cut |
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
sub topConcepts { |
|
546
|
13
|
|
|
13
|
1
|
18
|
my $self = shift; |
|
547
|
13
|
50
|
|
|
|
36
|
unless ( @_ ) { |
|
548
|
13
|
50
|
|
|
|
17
|
return keys %{ $self->{top} } if %{ $self->{top} }; |
|
|
0
|
|
|
|
|
0
|
|
|
|
13
|
|
|
|
|
47
|
|
|
549
|
5
|
|
|
|
|
42
|
return grep { |
|
550
|
5
|
|
|
|
|
8
|
not %{$self->{concepts}->{$_}->{broader}} |
|
|
13
|
|
|
|
|
51
|
|
|
551
|
13
|
|
|
|
|
22
|
} keys %{$self->{concepts}}; |
|
552
|
|
|
|
|
|
|
} |
|
553
|
0
|
0
|
0
|
|
|
0
|
if ( @_ == 1 && not defined $_[0] ) { |
|
554
|
0
|
|
|
|
|
0
|
$self->{top} = { }; |
|
555
|
0
|
|
|
|
|
0
|
return; |
|
556
|
|
|
|
|
|
|
} |
|
557
|
0
|
|
|
|
|
0
|
foreach my $id ( @_ ) { |
|
558
|
0
|
0
|
|
|
|
0
|
croak "Unknown concept <$id>" unless $self->{concepts}->{$id}; |
|
559
|
0
|
0
|
|
|
|
0
|
next if $self->{top}->{$id}; |
|
560
|
0
|
|
|
|
|
0
|
croak "Concept <$id> must not have broader to be top concept" |
|
561
|
0
|
0
|
|
|
|
0
|
if keys %{ $self->{concepts}->{broader} }; |
|
562
|
0
|
|
|
|
|
0
|
$self->{top}->{$id} = 1; |
|
563
|
|
|
|
|
|
|
} |
|
564
|
|
|
|
|
|
|
} |
|
565
|
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
=head2 concept ( %properties ) |
|
567
|
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
Returns the identifier of a concept with given notation and/or label. |
|
569
|
|
|
|
|
|
|
It is not checked whether the given concept exists in this scheme. |
|
570
|
|
|
|
|
|
|
Returns either a string or an empty string if no identifier is given. |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=cut |
|
573
|
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
sub concept { |
|
575
|
5
|
|
|
5
|
1
|
28
|
my $id = ""; |
|
576
|
5
|
|
|
|
|
9
|
eval { |
|
577
|
5
|
|
|
|
|
15
|
my $arg = shift->conceptentification( @_ ); |
|
578
|
4
|
|
|
|
|
18
|
$id = $arg->{id}; |
|
579
|
|
|
|
|
|
|
}; |
|
580
|
5
|
|
|
|
|
87
|
return $id; |
|
581
|
|
|
|
|
|
|
} |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
=head2 hasConcept ( $id | %properties ) |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
Returns whether there is a concept of a given id. Instead of providing |
|
586
|
|
|
|
|
|
|
a specific concept C you can also use unique properties (C, |
|
587
|
|
|
|
|
|
|
C |
|
588
|
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=cut |
|
590
|
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
sub hasConcept { |
|
592
|
3
|
|
|
3
|
1
|
9
|
my $self = shift; |
|
593
|
3
|
100
|
|
|
|
14
|
my $id = (@_ == 1) ? $_[0] : $self->concept( @_ ); |
|
594
|
3
|
50
|
33
|
|
|
44
|
return exists $self->{concepts}->{$id} |
|
595
|
|
|
|
|
|
|
if defined $id and $id ne ""; |
|
596
|
|
|
|
|
|
|
|
|
597
|
0
|
|
|
|
|
0
|
return 0; |
|
598
|
|
|
|
|
|
|
} |
|
599
|
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
=head2 concepts |
|
601
|
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
Returns a list of all concept's ids. |
|
603
|
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
=cut |
|
605
|
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
sub concepts { |
|
607
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
|
608
|
0
|
|
|
|
|
0
|
return keys %{ $self->{concepts} }; |
|
|
0
|
|
|
|
|
0
|
|
|
609
|
|
|
|
|
|
|
} |
|
610
|
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=head2 size |
|
612
|
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
Returns the total number of concepts. |
|
614
|
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=cut |
|
616
|
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
sub size { |
|
618
|
3
|
|
|
3
|
1
|
488
|
my $self = shift; |
|
619
|
3
|
|
|
|
|
15
|
return scalar keys %{ $self->{concepts} }; |
|
|
3
|
|
|
|
|
20
|
|
|
620
|
|
|
|
|
|
|
} |
|
621
|
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
=head2 conceptentification ( %properties ) |
|
623
|
|
|
|
|
|
|
|
|
624
|
|
|
|
|
|
|
Checks and possibly expands some given concept properties to ensure that |
|
625
|
|
|
|
|
|
|
there is a valid concept id. Returns a hashref that contains the concept |
|
626
|
|
|
|
|
|
|
id (field C) or croaks. Depending on the identification settings of |
|
627
|
|
|
|
|
|
|
this scheme you must pass at least one of C, C |
|
628
|
|
|
|
|
|
|
C, C. |
|
629
|
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
=cut |
|
631
|
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
sub conceptentification { |
|
633
|
12
|
|
|
12
|
1
|
52
|
my ($self, %arg) = @_; |
|
634
|
|
|
|
|
|
|
|
|
635
|
12
|
|
|
|
|
29
|
my $idtype = $self->{identity}; |
|
636
|
12
|
|
|
|
|
25
|
my $labeltype = $self->{label}; |
|
637
|
12
|
|
|
|
|
24
|
my $lang = $self->{language}; |
|
638
|
|
|
|
|
|
|
|
|
639
|
12
|
100
|
|
|
|
49
|
$arg{label} = '' unless defined $arg{label}; |
|
640
|
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
# rename 'label' parameter if given |
|
642
|
12
|
100
|
|
|
|
39
|
if ( $arg{label} ne '' ) { |
|
643
|
|
|
|
|
|
|
# TODO: what if arg{labeltype} is also given? better croak |
|
644
|
3
|
|
|
|
|
10
|
$arg{$labeltype} = $arg{label}; |
|
645
|
|
|
|
|
|
|
} |
|
646
|
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
# set a label's default language if only a string was given |
|
648
|
|
|
|
|
|
|
# expand label property to be a hashref on undef |
|
649
|
12
|
|
|
|
|
45
|
foreach my $type ( 'label', keys %LABEL_TYPES ) { |
|
650
|
60
|
100
|
100
|
|
|
1356
|
next unless defined $arg{$type} and $arg{$type} ne ''; |
|
651
|
6
|
50
|
|
|
|
19
|
unless ( ref($arg{$type}) ) { # HASH |
|
652
|
6
|
50
|
|
|
|
22
|
if ( $arg{$type} eq "" ) { |
|
653
|
0
|
|
|
|
|
0
|
delete $arg{$type}; |
|
654
|
|
|
|
|
|
|
} else { |
|
655
|
6
|
|
|
|
|
31
|
$arg{$type} = { $lang => $arg{$type} }; |
|
656
|
|
|
|
|
|
|
} |
|
657
|
|
|
|
|
|
|
} |
|
658
|
|
|
|
|
|
|
} |
|
659
|
|
|
|
|
|
|
|
|
660
|
12
|
100
|
|
|
|
71
|
$arg{id} = "" unless defined $arg{id}; |
|
661
|
12
|
100
|
|
|
|
48
|
$arg{$idtype} = "" unless defined $arg{$idtype}; |
|
662
|
|
|
|
|
|
|
|
|
663
|
12
|
100
|
|
|
|
40
|
if ( $arg{id} ne "" ) { |
|
664
|
|
|
|
|
|
|
# derive property from id |
|
665
|
3
|
50
|
33
|
|
|
15
|
if ( $idtype eq 'notation' or $idtype eq 'identifier' ) { |
|
666
|
3
|
50
|
33
|
|
|
12
|
if ( $arg{$idtype} ne "" and $arg{$idtype} ne $arg{id} ) { |
|
667
|
0
|
|
|
|
|
0
|
croak "concept id cannot be both '" . $arg{id} |
|
668
|
|
|
|
|
|
|
. "' and '" . $arg{$idtype} . "'"; |
|
669
|
|
|
|
|
|
|
} |
|
670
|
3
|
|
|
|
|
10
|
$arg{$idtype} = $arg{id}; |
|
671
|
|
|
|
|
|
|
} else { # $idtype eq 'label' |
|
672
|
0
|
0
|
|
|
|
0
|
$arg{label} = { } if $arg{label} eq ''; |
|
673
|
0
|
|
|
|
|
0
|
my $l = $arg{label}->{$lang}; |
|
674
|
0
|
0
|
0
|
|
|
0
|
croak "concept id cannot be both '" . $arg{id} . "' and label '$l'" |
|
|
|
|
0
|
|
|
|
|
|
675
|
|
|
|
|
|
|
if ( defined $l and $l ne "" and $l ne $arg{id} ); |
|
676
|
|
|
|
|
|
|
|
|
677
|
0
|
|
|
|
|
0
|
$arg{label}->{$lang} = $arg{id}; |
|
678
|
|
|
|
|
|
|
} |
|
679
|
|
|
|
|
|
|
} else { |
|
680
|
|
|
|
|
|
|
# derive id from property (TODO: url-encode if needed) |
|
681
|
9
|
100
|
|
|
|
29
|
if ( $idtype eq 'notation' ) { |
|
|
|
50
|
|
|
|
|
|
|
682
|
5
|
|
|
|
|
17
|
$arg{id} = $arg{notation}; |
|
683
|
|
|
|
|
|
|
} elsif ( $idtype eq 'identifier' ) { |
|
684
|
0
|
|
|
|
|
0
|
$arg{id} = $arg{identifier}; |
|
685
|
|
|
|
|
|
|
} else { # $idtype eq 'label' |
|
686
|
4
|
100
|
|
|
|
18
|
$arg{id} = $arg{$labeltype}->{ $lang } if $arg{$labeltype}; |
|
687
|
|
|
|
|
|
|
} |
|
688
|
|
|
|
|
|
|
} |
|
689
|
|
|
|
|
|
|
|
|
690
|
12
|
|
|
|
|
41
|
$arg{id} = $self->{idescape}->( $arg{id} ); |
|
691
|
|
|
|
|
|
|
|
|
692
|
12
|
50
|
|
|
|
39
|
if ( $self->{idregexp} ) { |
|
693
|
0
|
0
|
|
|
|
0
|
croak "identifier " . $arg{id} . " does not fit to pattern" |
|
694
|
|
|
|
|
|
|
unless $arg{id} =~ $self->{idregexp}; |
|
695
|
|
|
|
|
|
|
} |
|
696
|
|
|
|
|
|
|
|
|
697
|
12
|
100
|
|
|
|
287
|
croak "Missing $idtype as concept identifier" if $arg{id} eq ""; |
|
698
|
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
# TODO: check $arg{id} for well-formedness as URI part |
|
700
|
|
|
|
|
|
|
|
|
701
|
11
|
|
|
|
|
39
|
return \%arg; |
|
702
|
|
|
|
|
|
|
} |
|
703
|
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=head2 addHashref ( $hashref ) |
|
705
|
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
experimental. |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
=cut |
|
709
|
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
sub addHashref { |
|
711
|
0
|
|
|
0
|
1
|
0
|
my ($self, $hash) = @_; |
|
712
|
|
|
|
|
|
|
|
|
713
|
0
|
|
|
|
|
0
|
my $base = $self->{base}; # may be "" |
|
714
|
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# ignores all but the following predicates |
|
716
|
0
|
|
|
|
|
0
|
my %predicates = ( |
|
717
|
|
|
|
|
|
|
$NAMESPACES{rdf}.'type' => 'a', |
|
718
|
|
|
|
|
|
|
$NAMESPACES{dc}.'identifier' => 'id' |
|
719
|
|
|
|
|
|
|
); |
|
720
|
|
|
|
|
|
|
|
|
721
|
0
|
|
|
|
|
0
|
my @pnames = ( |
|
722
|
|
|
|
|
|
|
keys %NOTE_PROPERTIES, |
|
723
|
|
|
|
|
|
|
keys %RELATION_PROPERTIES, |
|
724
|
|
|
|
|
|
|
keys %LABEL_PROPERTIES, 'notation' ); |
|
725
|
|
|
|
|
|
|
|
|
726
|
0
|
|
|
|
|
0
|
foreach my $p (@pnames) { |
|
727
|
0
|
|
|
|
|
0
|
$predicates{ $NAMESPACES{skos}.$p } = $p; |
|
728
|
|
|
|
|
|
|
} |
|
729
|
|
|
|
|
|
|
|
|
730
|
0
|
|
|
|
|
0
|
foreach my $subject ( keys %$hash ) { |
|
731
|
0
|
|
|
|
|
0
|
my $subj = $subject; |
|
732
|
0
|
0
|
|
|
|
0
|
next unless ($subj =~ s/^$base//); |
|
733
|
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
# TODO: $self->{scheme} as subject |
|
735
|
|
|
|
|
|
|
|
|
736
|
0
|
|
|
|
|
0
|
my %concept = (); # => $subj ); |
|
737
|
0
|
|
|
|
|
0
|
$concept{notation} = $subj; # TODO: remove |
|
738
|
0
|
|
|
|
|
0
|
my $is_concept = 0; # TODO: check |
|
739
|
|
|
|
|
|
|
|
|
740
|
0
|
|
|
|
|
0
|
foreach my $predicate ( keys %{$hash->{$subject}} ) { |
|
|
0
|
|
|
|
|
0
|
|
|
741
|
0
|
|
0
|
|
|
0
|
my $p = $predicates{ $predicate } || next; |
|
742
|
|
|
|
|
|
|
|
|
743
|
0
|
|
|
|
|
0
|
foreach my $object ( @{ $hash->{$subject}->{$predicate} } ) { |
|
|
0
|
|
|
|
|
0
|
|
|
744
|
0
|
|
|
|
|
0
|
my $obj; |
|
745
|
|
|
|
|
|
|
|
|
746
|
0
|
0
|
|
|
|
0
|
if ( $p =~ /^(narrower|broader)$/ ) { |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
747
|
0
|
0
|
|
|
|
0
|
next unless $object->{type} eq 'uri'; |
|
748
|
0
|
|
|
|
|
0
|
$obj = $object->{value}; |
|
749
|
|
|
|
|
|
|
#print "$obj\n"; |
|
750
|
0
|
0
|
|
|
|
0
|
next unless ($obj =~ s/^$base//); |
|
751
|
0
|
|
|
|
|
0
|
push @{$concept{$p}}, $obj; |
|
|
0
|
|
|
|
|
0
|
|
|
752
|
|
|
|
|
|
|
} elsif ( $p =~ /^(prefLabel)/ ) { |
|
753
|
0
|
|
|
|
|
0
|
$obj = $object->{value}; # TODO: language |
|
754
|
0
|
|
|
|
|
0
|
$concept{label} = $obj; # TODO: unique |
|
755
|
|
|
|
|
|
|
} elsif ( $p eq 'definition' ) { |
|
756
|
|
|
|
|
|
|
} |
|
757
|
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
# TODO: map |
|
759
|
|
|
|
|
|
|
#print "$subj $p\n"; |
|
760
|
|
|
|
|
|
|
} |
|
761
|
|
|
|
|
|
|
} |
|
762
|
0
|
0
|
|
|
|
0
|
if ( %concept ) { |
|
763
|
0
|
|
|
|
|
0
|
$self->addConcept( %concept ); |
|
764
|
|
|
|
|
|
|
} |
|
765
|
|
|
|
|
|
|
} |
|
766
|
|
|
|
|
|
|
} |
|
767
|
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=head1 SERIALIZATION METHODS |
|
769
|
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
The following methods serialize the concept scheme or parts of it in |
|
771
|
|
|
|
|
|
|
L |
|
772
|
|
|
|
|
|
|
(RDF/Turtle). A valid serialization must start with some namespace |
|
773
|
|
|
|
|
|
|
declarations, and a base declaration. Both are only included by the |
|
774
|
|
|
|
|
|
|
C method, but they can also be requested independently. |
|
775
|
|
|
|
|
|
|
All return values end with a newline unless it is the empty string. |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
A later version may also support 'hashref' format for serializing. |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=head2 turtle ( [ %options ] ) |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
Returns a full Turtle serialization of this concept scheme. |
|
782
|
|
|
|
|
|
|
The return value is equivalent to calling C, |
|
783
|
|
|
|
|
|
|
C, C, and C. |
|
784
|
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
The parameter C<< lean => 1 >> enables a lean serialization, which |
|
786
|
|
|
|
|
|
|
does not include infereable RDF statements. Other parameters are |
|
787
|
|
|
|
|
|
|
passed to C and C as well. |
|
788
|
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
=cut |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
sub turtle { |
|
792
|
8
|
|
|
8
|
1
|
1126
|
my ($self,%opt) = @_; |
|
793
|
|
|
|
|
|
|
|
|
794
|
8
|
|
|
|
|
23
|
return join( "\n", |
|
795
|
|
|
|
|
|
|
$self->turtleNamespaces, |
|
796
|
|
|
|
|
|
|
$self->turtleBase , |
|
797
|
|
|
|
|
|
|
$self->turtleScheme( %opt ) , |
|
798
|
|
|
|
|
|
|
$self->turtleConcepts( %opt ) ); |
|
799
|
|
|
|
|
|
|
} |
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
=head2 turtleNamespaces |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
Returns Turtle syntax namespace declarations for this scheme. |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
=cut |
|
806
|
|
|
|
|
|
|
|
|
807
|
|
|
|
|
|
|
sub turtleNamespaces { |
|
808
|
8
|
|
|
8
|
1
|
10
|
my $self = shift; |
|
809
|
|
|
|
|
|
|
|
|
810
|
8
|
50
|
33
|
|
|
28
|
if ( $self->{uses_dc} and not $self->{namespaces}->{dc} ) { |
|
811
|
0
|
|
|
|
|
0
|
$self->{namespaces}->{dc} = $NAMESPACES{dc}; |
|
812
|
|
|
|
|
|
|
} |
|
813
|
|
|
|
|
|
|
|
|
814
|
8
|
|
|
|
|
11
|
my @lines; |
|
815
|
8
|
|
|
|
|
10
|
foreach my $name (keys %{$self->{namespaces}}) { |
|
|
8
|
|
|
|
|
31
|
|
|
816
|
16
|
|
|
|
|
63
|
push @lines, "\@prefix $name: <" . $self->{namespaces}->{$name} . "> ."; |
|
817
|
|
|
|
|
|
|
} |
|
818
|
|
|
|
|
|
|
|
|
819
|
8
|
|
|
|
|
48
|
return join("\n", @lines) . "\n"; |
|
820
|
|
|
|
|
|
|
} |
|
821
|
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=head2 turtleBase |
|
823
|
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
Returns a Turtle URI base declaration for this scheme. |
|
825
|
|
|
|
|
|
|
An empty string is returned if no URI base is set. |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
=cut |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
sub turtleBase { |
|
830
|
8
|
|
|
8
|
1
|
14
|
my $self = shift; |
|
831
|
|
|
|
|
|
|
|
|
832
|
8
|
50
|
|
|
|
44
|
return "" if $self->{base} eq ""; |
|
833
|
0
|
|
|
|
|
0
|
return "\@base <" . $self->{base} . "> .\n" |
|
834
|
|
|
|
|
|
|
} |
|
835
|
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
=head2 turtleScheme ( [ top => 0 ] ) |
|
838
|
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
Returns RDF statements about the concept scheme in Turtle syntax. |
|
840
|
|
|
|
|
|
|
Details about concepts or namespace/base declarations are not included. |
|
841
|
|
|
|
|
|
|
The option C<< top => 0 >> (enabled by default) can be used to supress |
|
842
|
|
|
|
|
|
|
serializing the C property. |
|
843
|
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
=cut |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
sub turtleScheme { |
|
847
|
14
|
|
|
14
|
1
|
94
|
my ($self,%opt) = @_; |
|
848
|
14
|
100
|
|
|
|
48
|
$opt{top} = 1 unless exists $opt{top}; |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
# note that lean => 1 does not imply top => 0 ! |
|
851
|
14
|
100
|
|
|
|
36
|
if ( $opt{top} ) { |
|
852
|
10
|
|
|
|
|
29
|
my @top = $self->topConcepts(); |
|
853
|
10
|
|
|
|
|
36
|
$self->{prop}->{'skos:hasTopConcept'} = [ map { "<$_>" } @top ]; |
|
|
1
|
|
|
|
|
10
|
|
|
854
|
|
|
|
|
|
|
} else { |
|
855
|
4
|
|
|
|
|
12
|
delete $self->{prop}->{'skos:hasTopConcept'} |
|
856
|
|
|
|
|
|
|
} |
|
857
|
|
|
|
|
|
|
|
|
858
|
14
|
|
|
|
|
38
|
return turtle_statement( "<" . $self->{scheme} . ">", %{$self->{prop}} ); |
|
|
14
|
|
|
|
|
82
|
|
|
859
|
|
|
|
|
|
|
} |
|
860
|
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=head2 turtleConcept ( $id [, %options ] ) |
|
862
|
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
Returns a concept in Turtle syntax. With option C<< top => 0 >> you can disable |
|
864
|
|
|
|
|
|
|
serializing the C property. By default, each concept is |
|
865
|
|
|
|
|
|
|
connected to its concept scheme with either C, or with |
|
866
|
|
|
|
|
|
|
C. With option C<< scheme => 0 >> you can disable serializing |
|
867
|
|
|
|
|
|
|
the latter property. With C<< scheme => 2 >> the property C |
|
868
|
|
|
|
|
|
|
is also included in the serialization if C is given, |
|
869
|
|
|
|
|
|
|
although the former can be derived as super-property of the latter. |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=cut |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
sub turtleConcept { |
|
874
|
8
|
|
|
8
|
1
|
21
|
my ($self,$id,%opt) = @_; |
|
875
|
8
|
100
|
|
|
|
32
|
$opt{top} = 1 unless exists $opt{top}; |
|
876
|
8
|
100
|
|
|
|
25
|
$opt{top} = 0 if $opt{lean}; |
|
877
|
8
|
100
|
|
|
|
23
|
$opt{scheme} = 1 unless exists $opt{scheme}; |
|
878
|
|
|
|
|
|
|
|
|
879
|
8
|
|
|
|
|
20
|
my $c = $self->{concepts}->{$id}; |
|
880
|
|
|
|
|
|
|
|
|
881
|
8
|
|
|
|
|
17
|
my %stm = ( 'a' => 'skos:Concept' ); |
|
882
|
|
|
|
|
|
|
|
|
883
|
|
|
|
|
|
|
# TODO: Support multiple notations |
|
884
|
8
|
50
|
|
|
|
33
|
if ( $c->{notation} ne '' ) { |
|
885
|
8
|
|
|
|
|
29
|
$stm{'skos:notation'} = turtle_literal( $c->{notation} ); |
|
886
|
|
|
|
|
|
|
} |
|
887
|
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
# Concept Labels: pref, alt, hidden, title |
|
889
|
8
|
|
|
|
|
233
|
while ( my ($type,$property) = each %LABEL_TYPES ) { |
|
890
|
32
|
50
|
|
|
|
154
|
next unless $c->{$type}; |
|
891
|
0
|
|
|
|
|
0
|
my $label = turtle_literal_list( $c->{$type} ); |
|
892
|
0
|
|
|
|
|
0
|
$stm{$property} = $label; |
|
893
|
|
|
|
|
|
|
# TODO: entail rdfs:label if requested (pref, alt, hidden) |
|
894
|
|
|
|
|
|
|
} |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
|
|
897
|
8
|
|
|
|
|
21
|
foreach my $rel (qw(broader narrower related)) { |
|
898
|
24
|
100
|
|
|
|
27
|
next unless %{$c->{$rel}}; |
|
|
24
|
|
|
|
|
160
|
|
|
899
|
2
|
|
|
|
|
3
|
$stm{"skos:$rel"} = [ map { "<$_>" } keys %{$c->{$rel}} ]; |
|
|
2
|
|
|
|
|
13
|
|
|
|
2
|
|
|
|
|
8
|
|
|
900
|
|
|
|
|
|
|
} |
|
901
|
|
|
|
|
|
|
|
|
902
|
8
|
|
|
|
|
15
|
my $is_top = 0; |
|
903
|
8
|
100
|
|
|
|
23
|
if ( $opt{top} ) { |
|
904
|
4
|
50
|
|
|
|
7
|
if ( (keys %{ $self->{top} }) ? $self->{top}->{$id} : not %{$c->{broader}} ) { |
|
|
4
|
100
|
|
|
|
17
|
|
|
|
4
|
|
|
|
|
14
|
|
|
905
|
3
|
|
|
|
|
13
|
$stm{"skos:topConceptOf"} = "<" . $self->{scheme} . ">"; |
|
906
|
3
|
|
|
|
|
6
|
$is_top = 1; |
|
907
|
|
|
|
|
|
|
} |
|
908
|
|
|
|
|
|
|
} |
|
909
|
|
|
|
|
|
|
|
|
910
|
|
|
|
|
|
|
# [S7] skos:topConceptOf is a sub-property of skos:inScheme |
|
911
|
8
|
100
|
|
|
|
26
|
if ( $opt{scheme} - $is_top > 0 ) { |
|
912
|
|
|
|
|
|
|
# TODO: with 'lean' => 1 and not top => 0 |
|
913
|
|
|
|
|
|
|
# this is implied if the concept is topConcept |
|
914
|
5
|
|
|
|
|
23
|
$stm{'skos:inScheme'} = '<' . $self->{scheme} . '>'; |
|
915
|
|
|
|
|
|
|
} |
|
916
|
|
|
|
|
|
|
|
|
917
|
8
|
50
|
33
|
|
|
29
|
if ( defined $c->{identifier} and $c->{identifier} ne "" ) { |
|
918
|
0
|
|
|
|
|
0
|
$stm{'dc:identifier'} = turtle_literal( $c->{identifier} ); |
|
919
|
|
|
|
|
|
|
} |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
# TODO: S17 - infer skos:note only if requested |
|
922
|
8
|
|
|
|
|
49
|
foreach my $name ( keys %NOTE_PROPERTIES ) { |
|
923
|
56
|
50
|
|
|
|
162
|
next unless $c->{$name}; |
|
924
|
0
|
|
|
|
|
0
|
$stm{"skos:$name"} = turtle_literal_list( $c->{$name} ); |
|
925
|
|
|
|
|
|
|
} |
|
926
|
|
|
|
|
|
|
|
|
927
|
8
|
|
|
|
|
48
|
return turtle_statement( "<$id>", %stm ); |
|
928
|
|
|
|
|
|
|
} |
|
929
|
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
=head2 turtleConcepts ( [ %options ] ) |
|
931
|
|
|
|
|
|
|
|
|
932
|
|
|
|
|
|
|
Returns all concepts in Turtle syntax. |
|
933
|
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
=cut |
|
935
|
|
|
|
|
|
|
|
|
936
|
|
|
|
|
|
|
sub turtleConcepts { |
|
937
|
15
|
|
|
15
|
1
|
6291
|
my ($self,%opt) = @_; |
|
938
|
15
|
|
|
|
|
23
|
delete $opt{id}; |
|
939
|
|
|
|
|
|
|
|
|
940
|
8
|
|
|
|
|
100
|
return join( "\n", |
|
941
|
15
|
|
|
|
|
108
|
map { $self->turtleConcept( $_, %opt ) } |
|
942
|
15
|
|
|
|
|
23
|
keys %{ $self->{concepts} } ); |
|
943
|
|
|
|
|
|
|
} |
|
944
|
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
=head1 EXPORTABLE FUNCTIONS |
|
946
|
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=head2 skos |
|
948
|
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
This is just a shortcut for C<< SKOS::Simple->new >>. |
|
950
|
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
=cut |
|
952
|
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
sub skos { |
|
954
|
1
|
|
|
1
|
1
|
13
|
SKOS::Simple->new(@_) |
|
955
|
|
|
|
|
|
|
} |
|
956
|
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
=head2 is_uri ( $uri ) |
|
958
|
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
Copied from L, originally by Richard Sonnen. |
|
960
|
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
=cut |
|
962
|
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
sub is_uri{ |
|
964
|
7
|
50
|
|
7
|
1
|
22
|
my $self = shift if ref($_[0]); |
|
965
|
7
|
|
|
|
|
12
|
my $value = shift; |
|
966
|
|
|
|
|
|
|
|
|
967
|
7
|
50
|
|
|
|
16
|
return unless defined($value); |
|
968
|
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
# check for illegal characters |
|
970
|
7
|
50
|
|
|
|
29
|
return if $value =~ /[^a-z0-9\:\/\?\#\[\]\@\!\$\&\'\(\)\*\+\,\;\=\.\-\_\~\%]/i; |
|
971
|
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
# check for hex escapes that aren't complete |
|
973
|
7
|
50
|
|
|
|
22
|
return if $value =~ /%[^0-9a-f]/i; |
|
974
|
7
|
50
|
|
|
|
19
|
return if $value =~ /%[0-9a-f](:?[^0-9a-f]|$)/i; |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
# from RFC 3986 |
|
977
|
7
|
|
|
|
|
50
|
my($scheme, $authority, $path, $query, $fragment) = |
|
978
|
|
|
|
|
|
|
($value =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|); |
|
979
|
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
# scheme and path are required, though the path can be empty |
|
981
|
7
|
50
|
33
|
|
|
108
|
return unless (defined($scheme) && length($scheme) && defined($path)); |
|
|
|
|
33
|
|
|
|
|
|
982
|
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
# if authority is present, the path must be empty or begin with a / |
|
984
|
7
|
50
|
33
|
|
|
35
|
if(defined($authority) && length($authority)){ |
|
985
|
7
|
50
|
66
|
|
|
30
|
return unless(length($path) == 0 || $path =~ m!^/!); |
|
986
|
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
} else { |
|
988
|
|
|
|
|
|
|
# if authority is not present, the path must not start with // |
|
989
|
0
|
0
|
|
|
|
0
|
return if $path =~ m!^//!; |
|
990
|
|
|
|
|
|
|
} |
|
991
|
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
# scheme must begin with a letter, then consist of letters, digits, +, ., or - |
|
993
|
7
|
50
|
|
|
|
48
|
return unless lc($scheme) =~ m!^[a-z][a-z0-9\+\-\.]*$!; |
|
994
|
|
|
|
|
|
|
|
|
995
|
|
|
|
|
|
|
# re-assemble the URL per section 5.3 in RFC 3986 |
|
996
|
7
|
|
|
|
|
15
|
my $out = $scheme . ':'; |
|
997
|
7
|
50
|
33
|
|
|
43
|
if(defined $authority && length($authority)){ |
|
998
|
7
|
|
|
|
|
15
|
$out .= '//' . $authority; |
|
999
|
|
|
|
|
|
|
} |
|
1000
|
7
|
|
|
|
|
11
|
$out .= $path; |
|
1001
|
7
|
50
|
33
|
|
|
20
|
if(defined $query && length($query)){ |
|
1002
|
0
|
|
|
|
|
0
|
$out .= '?' . $query; |
|
1003
|
|
|
|
|
|
|
} |
|
1004
|
7
|
50
|
33
|
|
|
21
|
if(defined $fragment && length($fragment)){ |
|
1005
|
0
|
|
|
|
|
0
|
$out .= '#' . $fragment; |
|
1006
|
|
|
|
|
|
|
} |
|
1007
|
|
|
|
|
|
|
|
|
1008
|
7
|
|
|
|
|
35
|
return $out; |
|
1009
|
|
|
|
|
|
|
} |
|
1010
|
|
|
|
|
|
|
|
|
1011
|
|
|
|
|
|
|
=head2 uri_or_empty ( $uri ) |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
Checks whether the passed parameter is either an URI or undefined. |
|
1014
|
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
=cut |
|
1016
|
|
|
|
|
|
|
|
|
1017
|
|
|
|
|
|
|
sub uri_or_empty { |
|
1018
|
30
|
|
66
|
30
|
1
|
227
|
return (not defined $_[0] or $_[0] eq '' or is_uri($_[0])); |
|
1019
|
|
|
|
|
|
|
} |
|
1020
|
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
1; |
|
1022
|
|
|
|
|
|
|
|
|
1023
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
1024
|
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
The SKOS ontology and its semantics is defined in |
|
1026
|
|
|
|
|
|
|
L and |
|
1027
|
|
|
|
|
|
|
L. Turtle format |
|
1028
|
|
|
|
|
|
|
is specified at http://www.w3.org/TeamSubmission/turtle/. |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
See also L for a similar module. |
|
1031
|
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
=cut |