| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package RDF::KV; |
|
2
|
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
121820
|
use 5.010; |
|
|
2
|
|
|
|
|
9
|
|
|
4
|
2
|
|
|
2
|
|
11
|
use strict; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
74
|
|
|
5
|
2
|
|
|
2
|
|
19
|
use warnings FATAL => 'all'; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
80
|
|
|
6
|
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# might as well use full-blown moose if URI::NamespaceMap uses it |
|
8
|
2
|
|
|
2
|
|
3094
|
use Moose; |
|
|
2
|
|
|
|
|
1054212
|
|
|
|
2
|
|
|
|
|
11
|
|
|
9
|
2
|
|
|
2
|
|
14913
|
use Moose::Util::TypeConstraints; |
|
|
2
|
|
|
|
|
5
|
|
|
|
2
|
|
|
|
|
25
|
|
|
10
|
2
|
|
|
2
|
|
6005
|
use namespace::autoclean; |
|
|
2
|
|
|
|
|
17578
|
|
|
|
2
|
|
|
|
|
6
|
|
|
11
|
2
|
|
|
2
|
|
129
|
use Try::Tiny; |
|
|
2
|
|
|
|
|
4
|
|
|
|
2
|
|
|
|
|
109
|
|
|
12
|
|
|
|
|
|
|
|
|
13
|
2
|
|
|
2
|
|
13
|
use Carp (); |
|
|
2
|
|
|
|
|
11
|
|
|
|
2
|
|
|
|
|
28
|
|
|
14
|
2
|
|
|
2
|
|
13
|
use Scalar::Util (); |
|
|
2
|
|
|
|
|
3
|
|
|
|
2
|
|
|
|
|
24
|
|
|
15
|
2
|
|
|
2
|
|
1156
|
use XML::RegExp (); |
|
|
2
|
|
|
|
|
1305
|
|
|
|
2
|
|
|
|
|
57
|
|
|
16
|
2
|
|
|
2
|
|
1008
|
use Data::GUID::Any (); |
|
|
2
|
|
|
|
|
289556
|
|
|
|
2
|
|
|
|
|
91
|
|
|
17
|
2
|
|
|
2
|
|
1958
|
use Data::UUID::NCName (); |
|
|
2
|
|
|
|
|
537971
|
|
|
|
2
|
|
|
|
|
82
|
|
|
18
|
|
|
|
|
|
|
|
|
19
|
2
|
|
|
2
|
|
1290
|
use URI; |
|
|
2
|
|
|
|
|
10054
|
|
|
|
2
|
|
|
|
|
64
|
|
|
20
|
2
|
|
|
2
|
|
922
|
use URI::BNode; |
|
|
2
|
|
|
|
|
2851
|
|
|
|
2
|
|
|
|
|
81
|
|
|
21
|
2
|
|
|
2
|
|
1025
|
use URI::NamespaceMap; |
|
|
2
|
|
|
|
|
856135
|
|
|
|
2
|
|
|
|
|
111
|
|
|
22
|
|
|
|
|
|
|
# XXX remind me to rewrite this using Moo. |
|
23
|
|
|
|
|
|
|
|
|
24
|
2
|
|
|
2
|
|
1042
|
use RDF::KV::Patch; |
|
|
2
|
|
|
|
|
9
|
|
|
|
2
|
|
|
|
|
8349
|
|
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
=head1 NAME |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
RDF::KV - Embed RDF linked data in plain old HTML forms |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 VERSION |
|
31
|
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Version 0.10 |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=cut |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
our $VERSION = '0.10'; |
|
37
|
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
class_type 'URI'; |
|
39
|
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# here's ye olde grammar: |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# XXX I know I said in the spec that the protocol should be parseable |
|
43
|
|
|
|
|
|
|
# by a single regex, but regexes make for lame, all-or-nothing |
|
44
|
|
|
|
|
|
|
# parsers. As such, this should really be rewritten when there's time |
|
45
|
|
|
|
|
|
|
# to create a more helpful (in the error message sense) parser. |
|
46
|
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# ok you know what? no. This is waaaaaaay simpler. |
|
48
|
|
|
|
|
|
|
my $MODIFIER = qr/(?:[!=+-]|[+-]!|![+-])/o; |
|
49
|
|
|
|
|
|
|
my $PREFIX = qr/(?:$XML::RegExp::NCName|[A-Za-z][0-9A-Za-z.+-]*)/o; |
|
50
|
|
|
|
|
|
|
my $TERM = qr/(?:$PREFIX:\S*)/o; |
|
51
|
|
|
|
|
|
|
my $RFC5646 = qr/(?:[A-Za-z]+(?:-[0-9A-Za-z]+)*)/o; |
|
52
|
|
|
|
|
|
|
my $DESIGNATOR = qr/(?:[:_']|\@$RFC5646|\^$TERM)/o; |
|
53
|
|
|
|
|
|
|
my $DECLARATION = qr/^\s*\$\s+($XML::RegExp::NCName)(?:\s+(\$))?\s*$/mo; |
|
54
|
|
|
|
|
|
|
my $MACRO = qr/(?:\$\{($XML::RegExp::NCName)\}| |
|
55
|
|
|
|
|
|
|
\$($XML::RegExp::NCName))/xo; |
|
56
|
|
|
|
|
|
|
my $NOT_MACRO = qr/(?:(?!\$$XML::RegExp::NCName| |
|
57
|
|
|
|
|
|
|
\$\{$XML::RegExp::NCName\}).)*/xso; |
|
58
|
|
|
|
|
|
|
my $MACROS = qr/($NOT_MACRO)(?:$MACRO)?($NOT_MACRO)/smo; |
|
59
|
|
|
|
|
|
|
my $PARTIAL_STMT = qr/^\s*(?:($MODIFIER)\s+)? |
|
60
|
|
|
|
|
|
|
(?:($TERM)(?:\s+($TERM))?(?:\s+($DESIGNATOR))?| |
|
61
|
|
|
|
|
|
|
($TERM)\s+($DESIGNATOR)\s+($TERM)| |
|
62
|
|
|
|
|
|
|
($TERM)\s+($TERM)(?:\s+($DESIGNATOR))?\s+($TERM)) |
|
63
|
|
|
|
|
|
|
(?:\s+(\$))?\s*$/xsmo; |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my @MAP = qw(modifier term1 term2 designator term1 designator graph |
|
66
|
|
|
|
|
|
|
term1 term2 designator graph deref); |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
my $kv = RDF::KV->new( |
|
71
|
|
|
|
|
|
|
subject => $uri, # ordinarily the Request-URI |
|
72
|
|
|
|
|
|
|
graph => $graphuri, # URI for the default graph |
|
73
|
|
|
|
|
|
|
namespaces => $ns, # default namespace prefix map |
|
74
|
|
|
|
|
|
|
callback => \&rewrite, # form-results-rewriting callback |
|
75
|
|
|
|
|
|
|
); |
|
76
|
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# Processes a hashref-of-parameters, like found in Catalyst or |
|
78
|
|
|
|
|
|
|
# Plack::Request. This call will ignore obviously non-matching |
|
79
|
|
|
|
|
|
|
# keys, but will croak on botched attempts to use the protocol. |
|
80
|
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
my $patch = eval { $kv->process($params) }; |
|
82
|
|
|
|
|
|
|
if ($@) { |
|
83
|
|
|
|
|
|
|
# return 409 Conflict ... |
|
84
|
|
|
|
|
|
|
} |
|
85
|
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# add/remove statements from the graph |
|
87
|
|
|
|
|
|
|
$patch->apply($model); |
|
88
|
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
90
|
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
This module provides a reference implementation for the L<RDF-KV |
|
92
|
|
|
|
|
|
|
protocol|http://doriantaylor.com/rdf-kv>. The objective of this |
|
93
|
|
|
|
|
|
|
protocol is to convey RDF linked data from a web browser to a web |
|
94
|
|
|
|
|
|
|
server using no mechanism beyond conventional |
|
95
|
|
|
|
|
|
|
C<application/x-www-form-urlencoded> HTML forms. The overarching |
|
96
|
|
|
|
|
|
|
purpose is to facilitate the development of linked data applications |
|
97
|
|
|
|
|
|
|
by making the apparatus of JavaScript an I<optional>, rather than a |
|
98
|
|
|
|
|
|
|
I<mandatory>, consideration. |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
This protocol implementation works by culling key-value pairs denoted |
|
101
|
|
|
|
|
|
|
in a prescribed syntax from POSTed form input (parsed by something |
|
102
|
|
|
|
|
|
|
like L<CGI>, L<Plack::Request> or L<Catalyst>), and then stitching |
|
103
|
|
|
|
|
|
|
them together to create a L<patch object|RDF::KV::Patch> which is then |
|
104
|
|
|
|
|
|
|
applied to an L<RDF::Trine::Model> graph. |
|
105
|
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=head1 METHODS |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=head2 new |
|
109
|
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
Instantiate the object. The following parameters are also (read-only) |
|
111
|
|
|
|
|
|
|
accessors. |
|
112
|
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
=over 4 |
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=item subject |
|
116
|
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
This is the default subject URI (or blank node). |
|
118
|
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
=cut |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
has subject => ( |
|
122
|
|
|
|
|
|
|
is => 'rw', |
|
123
|
|
|
|
|
|
|
isa => 'Str|URI', |
|
124
|
|
|
|
|
|
|
required => 1, |
|
125
|
|
|
|
|
|
|
); |
|
126
|
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=item graph |
|
128
|
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
This is the default graph URI. |
|
130
|
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=cut |
|
132
|
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
has graph => ( |
|
134
|
|
|
|
|
|
|
is => 'rw', |
|
135
|
|
|
|
|
|
|
isa => 'Str|URI', |
|
136
|
|
|
|
|
|
|
default => '', |
|
137
|
|
|
|
|
|
|
); |
|
138
|
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=item namespaces |
|
140
|
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
This L<URI::NamespaceMap> object will enable URI abbreviation through |
|
142
|
|
|
|
|
|
|
the use of CURIEs in form input. |
|
143
|
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=cut |
|
145
|
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
has namespaces => ( |
|
147
|
|
|
|
|
|
|
is => 'ro', |
|
148
|
|
|
|
|
|
|
isa => 'URI::NamespaceMap', |
|
149
|
|
|
|
|
|
|
default => sub { URI::NamespaceMap->new }, |
|
150
|
|
|
|
|
|
|
); |
|
151
|
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item callback |
|
153
|
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
Supply a callback function that will be applied to subject and object |
|
155
|
|
|
|
|
|
|
values, for instance to rewrite a URI. The return value of this |
|
156
|
|
|
|
|
|
|
function must be understood by L<RDF::KV::Patch/add_this>. |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=cut |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
has callback => ( |
|
161
|
|
|
|
|
|
|
is => 'ro', |
|
162
|
|
|
|
|
|
|
isa => 'CodeRef', |
|
163
|
|
|
|
|
|
|
default => sub { sub { shift } }, |
|
164
|
|
|
|
|
|
|
); |
|
165
|
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=back |
|
167
|
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 process \%CONTENT |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Process form content and return an L<RDF::KV::Patch> object. This is |
|
171
|
|
|
|
|
|
|
the only significant method. |
|
172
|
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=cut |
|
174
|
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
# variants of parameter getters |
|
176
|
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub _1 { |
|
178
|
0
|
|
|
0
|
|
|
my ($params, $k) = @_; |
|
179
|
0
|
|
|
|
|
|
$params->get_all($k); |
|
180
|
|
|
|
|
|
|
} |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub _2 { |
|
183
|
0
|
|
|
0
|
|
|
my ($params, $k) = @_; |
|
184
|
0
|
|
|
|
|
|
my $val = $params->{$k}; |
|
185
|
0
|
0
|
|
|
|
|
ref $val ? @$val : $val; |
|
186
|
|
|
|
|
|
|
} |
|
187
|
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub _uuid4 () { |
|
189
|
0
|
|
|
0
|
|
|
lc Data::GUID::Any::v4_guid_as_string(); |
|
190
|
|
|
|
|
|
|
} |
|
191
|
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
sub _uuid4urn () { |
|
193
|
0
|
|
|
0
|
|
|
'urn:uuid:' . _uuid4; |
|
194
|
|
|
|
|
|
|
} |
|
195
|
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
sub _uuid4bn () { |
|
197
|
0
|
|
|
0
|
|
|
URI::BNode->new; |
|
198
|
|
|
|
|
|
|
} |
|
199
|
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# XXX these should all get syntax checks/CURIE expansion/etc |
|
201
|
|
|
|
|
|
|
my %SPECIALS = ( |
|
202
|
|
|
|
|
|
|
SUBJECT => sub { |
|
203
|
|
|
|
|
|
|
my ($self, $val) = @_; |
|
204
|
|
|
|
|
|
|
$self->subject($val->[-1]) if @$val; |
|
205
|
|
|
|
|
|
|
}, |
|
206
|
|
|
|
|
|
|
GRAPH => sub { |
|
207
|
|
|
|
|
|
|
my ($self, $val) = @_; |
|
208
|
|
|
|
|
|
|
$self->graph($val->[-1]) if @$val; |
|
209
|
|
|
|
|
|
|
}, |
|
210
|
|
|
|
|
|
|
PREFIX => sub { |
|
211
|
|
|
|
|
|
|
my ($self, $val) = @_; |
|
212
|
|
|
|
|
|
|
# XXX CHECK THIS MUTHA |
|
213
|
|
|
|
|
|
|
for my $v (@$val) { |
|
214
|
|
|
|
|
|
|
#warn $v; |
|
215
|
|
|
|
|
|
|
my ($prefix, $uri) = ($v =~ /^\s*(\S+):\s+(.*)$/) |
|
216
|
|
|
|
|
|
|
or Carp::croak("Invalid prefix mapping $val"); |
|
217
|
|
|
|
|
|
|
#warn $uri; |
|
218
|
|
|
|
|
|
|
$self->namespaces->add_mapping($prefix, $uri); |
|
219
|
|
|
|
|
|
|
} |
|
220
|
|
|
|
|
|
|
}, |
|
221
|
|
|
|
|
|
|
); |
|
222
|
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
my %GENERATED = ( |
|
224
|
|
|
|
|
|
|
NEW_UUID => [[\&_uuid4, 0]], |
|
225
|
|
|
|
|
|
|
NEW_UUID_URN => [[\&_uuid4urn, 0]], |
|
226
|
|
|
|
|
|
|
NEW_BNODE => [[\&_uuid4bn, 0]], |
|
227
|
|
|
|
|
|
|
); |
|
228
|
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub _deref_content { |
|
230
|
0
|
|
|
0
|
|
|
my ($val, $macros) = @_; |
|
231
|
0
|
|
|
|
|
|
my @out; |
|
232
|
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# if $val is scalar, this loop will run just once. |
|
234
|
0
|
0
|
|
|
|
|
for my $v (ref $val ? @$val : ($val)) { |
|
235
|
|
|
|
|
|
|
# make this versatile |
|
236
|
0
|
0
|
|
|
|
|
$v = $v->[0] if ref $v; |
|
237
|
|
|
|
|
|
|
|
|
238
|
0
|
|
|
|
|
|
my @chunks; |
|
239
|
0
|
|
|
|
|
|
while ($v =~ /\G$MACROS/gco) { |
|
240
|
|
|
|
|
|
|
#warn "seen me"; |
|
241
|
0
|
|
|
|
|
|
my $pre = $1; |
|
242
|
0
|
|
0
|
|
|
|
my $macro = $2 || $3; |
|
243
|
0
|
|
|
|
|
|
my $post = $4; |
|
244
|
|
|
|
|
|
|
|
|
245
|
0
|
0
|
|
|
|
|
unless (defined $macro) { |
|
246
|
0
|
0
|
|
|
|
|
if (@chunks) { |
|
247
|
0
|
|
|
|
|
|
@chunks = map { "$_$pre$post" } @chunks; |
|
|
0
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
else { |
|
250
|
0
|
|
|
|
|
|
@chunks = ($pre . $post); |
|
251
|
|
|
|
|
|
|
} |
|
252
|
0
|
|
|
|
|
|
next; |
|
253
|
|
|
|
|
|
|
} |
|
254
|
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# do the actual macro dereferencing or noop in |
|
256
|
|
|
|
|
|
|
# lieu of a bound macro |
|
257
|
|
|
|
|
|
|
my @x = (defined $macros->{$macro} && @{$macros->{$macro}} ? |
|
258
|
0
|
0
|
|
|
|
|
(map { sprintf('%s%s%s', |
|
259
|
|
|
|
|
|
|
$pre, ref $_ ? &$_ : $_, $post) |
|
260
|
0
|
0
|
0
|
|
|
|
} @{$macros->{$macro}}) : ("$pre\$$macro$post")); |
|
|
0
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
# XXX LOLOLOL THIS IS THE MOST ILLEGIBLE PILE OF NONSENSE |
|
262
|
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# it says: if a macro value is present, sub it or no-op, |
|
264
|
|
|
|
|
|
|
# but if the macro is a code ref, run it. |
|
265
|
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
#warn 'wat: ' . Data::Dumper::Dumper(\@x); |
|
267
|
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
# initialize chunks |
|
269
|
0
|
0
|
|
|
|
|
unless (@chunks) { |
|
270
|
|
|
|
|
|
|
#warn 'correct!'; |
|
271
|
0
|
|
|
|
|
|
@chunks = @x; |
|
272
|
0
|
|
|
|
|
|
next; |
|
273
|
|
|
|
|
|
|
} |
|
274
|
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
# replace chunks with product of itself and x |
|
276
|
0
|
0
|
|
|
|
|
if (@x) { |
|
277
|
0
|
|
|
|
|
|
my @y; |
|
278
|
0
|
|
|
|
|
|
for my $c (@chunks) { |
|
279
|
0
|
|
|
|
|
|
for my $d (@x) { |
|
280
|
|
|
|
|
|
|
#warn 'halp wtf'; |
|
281
|
0
|
|
|
|
|
|
push @y, "$c$d"; |
|
282
|
|
|
|
|
|
|
} |
|
283
|
|
|
|
|
|
|
} |
|
284
|
0
|
|
|
|
|
|
@chunks = @y; |
|
285
|
|
|
|
|
|
|
} |
|
286
|
|
|
|
|
|
|
} |
|
287
|
|
|
|
|
|
|
|
|
288
|
0
|
|
|
|
|
|
push @out, @chunks; |
|
289
|
|
|
|
|
|
|
} |
|
290
|
|
|
|
|
|
|
#warn 'hurr: ' . Data::Dumper::Dumper(\@out); |
|
291
|
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
|
|
293
|
0
|
0
|
|
|
|
|
wantarray ? @out : \@out; |
|
294
|
|
|
|
|
|
|
} |
|
295
|
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub _massage_macros { |
|
297
|
0
|
|
|
0
|
|
|
my $macros = shift; |
|
298
|
|
|
|
|
|
|
# XXX this currently makes destructive changes to $macros insofar |
|
299
|
|
|
|
|
|
|
# as it rewrites the 'deref' flag with the actual variables to |
|
300
|
|
|
|
|
|
|
# dereference, or to 0 if there aren't any. If this becomes a |
|
301
|
|
|
|
|
|
|
# problem, just use Clone. |
|
302
|
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# cycle detect, finished product |
|
304
|
0
|
|
|
|
|
|
my (%seen, %done); |
|
305
|
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
# shallow-copy the hash |
|
307
|
0
|
|
|
|
|
|
my %pending = %$macros; |
|
308
|
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# get rid of generated |
|
310
|
0
|
|
|
|
|
|
map { delete $pending{$_} } keys %GENERATED; |
|
|
0
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
# Start a queue with a (quasi) random macro. |
|
313
|
0
|
|
|
|
|
|
my @queue = (keys %pending)[0]; |
|
314
|
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# If none of them contain a (bound) macro references, that macro |
|
316
|
|
|
|
|
|
|
# is 'done'. |
|
317
|
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# If the values *do* contain bound macro references, check to see |
|
319
|
|
|
|
|
|
|
# if those are 'done'. If they aren't, *prepend* the keys to the |
|
320
|
|
|
|
|
|
|
# queue, before the current macro. |
|
321
|
|
|
|
|
|
|
|
|
322
|
0
|
|
|
|
|
|
while (@queue) { |
|
323
|
|
|
|
|
|
|
#warn 'Initial ' . join(';', @queue); |
|
324
|
0
|
|
|
|
|
|
my $k = shift @queue; |
|
325
|
|
|
|
|
|
|
#warn "beginning \$$k"; |
|
326
|
|
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
|
$seen{$k}++; |
|
328
|
|
|
|
|
|
|
|
|
329
|
0
|
|
|
|
|
|
my @vals = @{$macros->{$k}}; |
|
|
0
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# 'done' and 'pending' macros |
|
332
|
0
|
|
|
|
|
|
my (%dm, %pm); |
|
333
|
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
# Examine each of its values. |
|
335
|
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# Note: this test is equivalent to concatenating the values |
|
337
|
|
|
|
|
|
|
# together with spaces and performing the regex on that. But |
|
338
|
|
|
|
|
|
|
# we can't do that because we're storing the macro-matching |
|
339
|
|
|
|
|
|
|
# state of individual values. |
|
340
|
0
|
|
|
|
|
|
for my $pair (@vals) { |
|
341
|
0
|
|
|
|
|
|
my ($val, $deref) = @$pair; |
|
342
|
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
# no expando |
|
344
|
0
|
0
|
|
|
|
|
next unless $deref; |
|
345
|
|
|
|
|
|
|
|
|
346
|
0
|
0
|
|
|
|
|
if (ref $deref) { |
|
347
|
|
|
|
|
|
|
# already been scanned |
|
348
|
0
|
|
|
|
|
|
for my $m (@$deref) { |
|
349
|
0
|
0
|
|
|
|
|
defined $done{$m} ? $dm{$m}++ : $pm{$m}++; |
|
350
|
|
|
|
|
|
|
} |
|
351
|
|
|
|
|
|
|
} |
|
352
|
|
|
|
|
|
|
else { |
|
353
|
0
|
|
|
|
|
|
my %m; |
|
354
|
0
|
|
|
|
|
|
for my $m (grep { defined $_ } ($val =~ /$MACRO/og)) { |
|
|
0
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
# check first to see if it's bound |
|
357
|
0
|
0
|
|
|
|
|
next unless $macros->{$m}; |
|
358
|
|
|
|
|
|
|
#warn $m; |
|
359
|
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
# if it's yourself, explode |
|
361
|
0
|
0
|
|
|
|
|
Carp::croak("Self reference found!") if $m eq $k; |
|
362
|
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
# get this to replace deref |
|
364
|
0
|
|
|
|
|
|
$m{$m}++; |
|
365
|
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
# and get this to figure out if we can deref |
|
367
|
0
|
0
|
|
|
|
|
defined $done{$m} ? $dm{$m}++ : $pm{$m}++; |
|
368
|
|
|
|
|
|
|
} |
|
369
|
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# now replace deref |
|
371
|
0
|
0
|
|
|
|
|
$pair->[1] = keys %m ? [sort keys %m] : 0; |
|
372
|
|
|
|
|
|
|
} |
|
373
|
|
|
|
|
|
|
} |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# macro values have pending matches |
|
376
|
0
|
0
|
|
|
|
|
if (keys %pm) { |
|
|
|
0
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# this is where we would detect a cycle |
|
378
|
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# right HERE |
|
380
|
|
|
|
|
|
|
|
|
381
|
0
|
|
|
|
|
|
my @q; |
|
382
|
0
|
|
|
|
|
|
for my $m (keys %pm) { |
|
383
|
0
|
0
|
|
|
|
|
Carp::croak("Cycle detected between $k and $m") if $seen{$m}; |
|
384
|
0
|
|
|
|
|
|
push @q, $m; |
|
385
|
|
|
|
|
|
|
} |
|
386
|
|
|
|
|
|
|
#warn join '/', @q; |
|
387
|
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# do it again |
|
389
|
0
|
|
|
|
|
|
unshift @queue, @q, $k; |
|
390
|
|
|
|
|
|
|
#warn join ',', @queue; |
|
391
|
|
|
|
|
|
|
|
|
392
|
0
|
|
|
|
|
|
next; |
|
393
|
|
|
|
|
|
|
} |
|
394
|
|
|
|
|
|
|
elsif (keys %dm) { |
|
395
|
|
|
|
|
|
|
# macro values have actionable matches |
|
396
|
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
#warn "replacing values for \$$k"; |
|
398
|
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
# replace contents and mark done |
|
400
|
0
|
|
|
|
|
|
$done{$k} = _deref_content(\@vals, \%done); |
|
401
|
|
|
|
|
|
|
} |
|
402
|
|
|
|
|
|
|
else { |
|
403
|
|
|
|
|
|
|
#warn Data::Dumper::Dumper(\@vals); |
|
404
|
|
|
|
|
|
|
# nothing to do, mark done |
|
405
|
0
|
|
|
|
|
|
$done{$k} = [map { $_->[0] } @vals]; |
|
|
0
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
} |
|
407
|
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
# remember to remove this guy or we'll loop forever |
|
409
|
0
|
|
|
|
|
|
delete $pending{$k}; |
|
410
|
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# replenish the queue with another pending object |
|
412
|
0
|
0
|
0
|
|
|
|
push @queue, (keys %pending)[0] if !@queue and keys %pending; |
|
413
|
|
|
|
|
|
|
} |
|
414
|
|
|
|
|
|
|
|
|
415
|
0
|
|
|
|
|
|
\%done; |
|
416
|
|
|
|
|
|
|
} |
|
417
|
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub process { |
|
420
|
0
|
|
|
0
|
1
|
|
my ($self, $params) = @_; |
|
421
|
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# assume this can also be a Hash::MultiValue |
|
423
|
0
|
0
|
0
|
|
|
|
my $sub = Scalar::Util::blessed($params) |
|
424
|
|
|
|
|
|
|
&& $params->can('get_all') ? \&_1 : \&_2; |
|
425
|
|
|
|
|
|
|
# XXX do we want to do ->isa instead? |
|
426
|
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
# begin by seeding macros with generators |
|
428
|
0
|
|
|
|
|
|
my %macros = %GENERATED; |
|
429
|
|
|
|
|
|
|
|
|
430
|
0
|
|
|
|
|
|
my (%maybe, %neither); |
|
431
|
|
|
|
|
|
|
|
|
432
|
0
|
|
|
|
|
|
for my $k (keys %$params) { |
|
433
|
|
|
|
|
|
|
# Step 0: get the values into a homogeneous list |
|
434
|
0
|
|
|
|
|
|
my @v = $sub->($params, $k); |
|
435
|
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# Step 1: pull out all the macro declarations |
|
437
|
0
|
0
|
0
|
|
|
|
if (my ($name, $sigil) = ($k =~ $DECLARATION)) { |
|
|
|
0
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# Step 1.0.1: create [content, deref flag] pairs |
|
439
|
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
# skip over generated macros |
|
441
|
0
|
0
|
|
|
|
|
next if $GENERATED{$name}; |
|
442
|
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
# OOH VERY CLEVER |
|
444
|
0
|
|
0
|
|
|
|
push @{$macros{$name} ||= []}, (map { [$_, int(!!$sigil)] } @v); |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
} |
|
446
|
|
|
|
|
|
|
# Step 1.1: set aside candidate statements |
|
447
|
|
|
|
|
|
|
elsif ($k =~ /^\s*\S+\s+\S+.*?/ or $k =~ /[:\$]/) { |
|
448
|
|
|
|
|
|
|
# valid partial statements will contain space or : or $ |
|
449
|
0
|
|
0
|
|
|
|
push @{$maybe{$k} ||= []}, @v; |
|
|
0
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
} |
|
451
|
|
|
|
|
|
|
# Step 1.2: put the rest in a discard pile |
|
452
|
|
|
|
|
|
|
else { |
|
453
|
0
|
|
0
|
|
|
|
push @{$neither{$k} ||= []}, @v; |
|
|
0
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
} |
|
455
|
|
|
|
|
|
|
} |
|
456
|
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
# cycles should cause a 409 Conflict error, but that isn't our job |
|
458
|
|
|
|
|
|
|
# here. |
|
459
|
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
# XXX although it may be useful to return an object in $@ that was |
|
461
|
|
|
|
|
|
|
# more informative. |
|
462
|
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# Step 2: dereference all the macros (that asked to be) |
|
464
|
|
|
|
|
|
|
try { |
|
465
|
0
|
|
|
0
|
|
|
my $x = _massage_macros(\%macros); |
|
466
|
0
|
|
|
|
|
|
%macros = %$x; |
|
467
|
|
|
|
|
|
|
} catch { |
|
468
|
|
|
|
|
|
|
# move this error up in the stack |
|
469
|
0
|
|
|
0
|
|
|
Carp::croak($@); |
|
470
|
0
|
|
|
|
|
|
}; |
|
471
|
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
# Step 2.1: overwrite any reserved/magic macros |
|
473
|
|
|
|
|
|
|
#$macros{NEW_UUID} = [[\&_uuid4, 1]]; |
|
474
|
|
|
|
|
|
|
#$macros{NEW_UUID_URN} = [[\&_uuid4urn, 1]]; |
|
475
|
|
|
|
|
|
|
#$macros{NEW_BNODE} = [[\&_uuid4bn, 1]]; |
|
476
|
|
|
|
|
|
|
# XXX make this extensible? |
|
477
|
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
# Step 3: apply special control macros to $self |
|
479
|
|
|
|
|
|
|
try { |
|
480
|
0
|
|
|
0
|
|
|
for my $k (keys %SPECIALS) { |
|
481
|
0
|
0
|
|
|
|
|
next unless $macros{$k}; |
|
482
|
0
|
|
|
|
|
|
$SPECIALS{$k}->($self, $macros{$k}); |
|
483
|
|
|
|
|
|
|
} |
|
484
|
|
|
|
|
|
|
} catch { |
|
485
|
|
|
|
|
|
|
# cough any errors up the stack |
|
486
|
0
|
|
|
0
|
|
|
Carp::croak($@); |
|
487
|
0
|
|
|
|
|
|
}; |
|
488
|
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
#require Data::Dumper; |
|
490
|
|
|
|
|
|
|
#warn Data::Dumper::Dumper(\%macros); |
|
491
|
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# add/remove statements |
|
494
|
0
|
|
|
|
|
|
my $patch = RDF::KV::Patch->new; |
|
495
|
0
|
|
|
|
|
|
my (%pos, %neg); |
|
496
|
0
|
|
|
|
|
|
for my $k (keys %maybe) { |
|
497
|
|
|
|
|
|
|
# Step 4: dereference macros in statements |
|
498
|
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
# Step 4.1 dereference macros in statement *templates* first |
|
500
|
|
|
|
|
|
|
# so we can figure out which values need to be dereferenced |
|
501
|
|
|
|
|
|
|
# (since the terminating $ indicator can be substituted in via |
|
502
|
|
|
|
|
|
|
# macro). |
|
503
|
0
|
0
|
|
|
|
|
my @k = grep { defined $_ } ($k =~ /$MACRO/og) ? |
|
|
0
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
_deref_content($k, \%macros) : ($k); |
|
505
|
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
# we want to check the values for empty strings *before* we |
|
507
|
|
|
|
|
|
|
# dereference them so it's still possible to express the empty |
|
508
|
|
|
|
|
|
|
# string through the use of a macro |
|
509
|
0
|
|
|
|
|
|
my @v = grep { $_ ne '' } map { $_ =~ s/^\s*(.*?)\s*$/$1/sm; $_ } |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
510
|
0
|
0
|
|
|
|
|
grep { defined $_ } @{$maybe{$k} || []}; |
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
#require Data::Dumper; |
|
513
|
|
|
|
|
|
|
#warn Data::Dumper::Dumper($maybe{$k}); |
|
514
|
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
# very well could loop just once here |
|
516
|
0
|
|
|
|
|
|
for my $template (@k) { |
|
517
|
|
|
|
|
|
|
#warn "lol $template"; |
|
518
|
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
# nope actually we're parsing the template now |
|
520
|
0
|
|
|
|
|
|
my @tokens = ($template =~ $PARTIAL_STMT); |
|
521
|
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
#warn scalar @tokens; |
|
523
|
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
# ignore if there wasn't a match XXX WARN SOMEHOW? |
|
525
|
0
|
0
|
|
|
|
|
next unless @tokens; |
|
526
|
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
# do not ignore, however, if this screws up |
|
528
|
0
|
0
|
|
|
|
|
die 'INTERNAL ERROR: regex does not match map' |
|
529
|
|
|
|
|
|
|
unless @tokens == @MAP; |
|
530
|
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# now make a nice hash of the contents |
|
532
|
0
|
|
|
|
|
|
my %contents; |
|
533
|
|
|
|
|
|
|
map { |
|
534
|
0
|
0
|
|
|
|
|
$contents{$MAP[$_]} = $tokens[$_] if defined $tokens[$_] |
|
|
0
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
} (0..$#MAP); |
|
536
|
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# just to recap, %contents can contain, at maximum: |
|
538
|
|
|
|
|
|
|
# * modifier (reverse statement, negate, etc) |
|
539
|
|
|
|
|
|
|
# * term1 (either subject or predicate) |
|
540
|
|
|
|
|
|
|
# * term2 (either predicate or object) |
|
541
|
|
|
|
|
|
|
# * designator (treat input values as URI/blank/literal[type?]) |
|
542
|
|
|
|
|
|
|
# * graph URI |
|
543
|
|
|
|
|
|
|
# * macro-dereference instruction |
|
544
|
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
# pull out the statement modifier first |
|
546
|
|
|
|
|
|
|
$contents{modifier} = { |
|
547
|
0
|
|
0
|
|
|
|
map { $_ => 1 } (split //, $contents{modifier} || '') }; |
|
|
0
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
# now deal with designator |
|
550
|
0
|
0
|
|
|
|
|
if ($contents{designator}) { |
|
551
|
0
|
|
|
|
|
|
my ($sigil, $symbol) = ($contents{designator} =~ /^(.)(.*)$/); |
|
552
|
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
Carp::croak("Reversed statement templates " . |
|
554
|
|
|
|
|
|
|
"cannot specify literals ($template)") |
|
555
|
0
|
0
|
0
|
|
|
|
if ($contents{modifier}{'!'} and $sigil =~ /['@^]/); |
|
556
|
|
|
|
|
|
|
|
|
557
|
0
|
0
|
|
|
|
|
if ($sigil eq '^') { |
|
558
|
|
|
|
|
|
|
# expand datatype URI |
|
559
|
0
|
|
0
|
|
|
|
$symbol = $self->namespaces->uri($symbol) || $symbol; |
|
560
|
|
|
|
|
|
|
} |
|
561
|
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
$contents{designator} = |
|
563
|
0
|
0
|
|
|
|
|
$symbol eq '' ? [$sigil] : [$sigil, $symbol]; |
|
564
|
|
|
|
|
|
|
} |
|
565
|
|
|
|
|
|
|
else { |
|
566
|
|
|
|
|
|
|
# single-tick is the default designator for forward |
|
567
|
|
|
|
|
|
|
# statements, : is for reverse. |
|
568
|
|
|
|
|
|
|
$contents{designator} = [ |
|
569
|
0
|
0
|
|
|
|
|
$contents{modifier}{'!'} ? ':' : q/'/ ]; |
|
570
|
|
|
|
|
|
|
} |
|
571
|
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# now we should expand the rest of the abbreviations |
|
573
|
0
|
|
|
|
|
|
for my $which (qw(term1 term2 graph)) { |
|
574
|
0
|
0
|
|
|
|
|
if (defined $contents{$which}) { |
|
575
|
|
|
|
|
|
|
my $uri = $self->namespaces->uri($contents{$which}) |
|
576
|
0
|
|
0
|
|
|
|
|| $contents{$which}; |
|
577
|
|
|
|
|
|
|
# XXX should we do some sort of relative uri |
|
578
|
|
|
|
|
|
|
# resolution thing? |
|
579
|
0
|
|
|
|
|
|
$contents{$which} = $uri; |
|
580
|
|
|
|
|
|
|
} |
|
581
|
|
|
|
|
|
|
} |
|
582
|
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# I suppose we can do this now |
|
584
|
0
|
0
|
|
|
|
|
if ($contents{deref}) { |
|
585
|
|
|
|
|
|
|
# XXX might want to trim bounding whitespace again |
|
586
|
0
|
|
|
|
|
|
@v = map { _deref_content($_, \%macros) } @v; |
|
|
0
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
} |
|
588
|
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
#require Data::Dumper; |
|
590
|
|
|
|
|
|
|
#warn Data::Dumper::Dumper([\%contents, \@v]); |
|
591
|
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# statement reversal behaviour is not entirely symmetric. |
|
593
|
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
# + is a noop of the default behaviour: assert S P O or O P S. |
|
595
|
|
|
|
|
|
|
# = means remove S P * before asserting S P O. (no reversal) |
|
596
|
|
|
|
|
|
|
# - means either remove S P *, S P O or O P S, but not O P *. |
|
597
|
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
# No, you know what? Restricting reverse wildcards is |
|
599
|
|
|
|
|
|
|
# going to make it a hell of a problem to do things like |
|
600
|
|
|
|
|
|
|
# completely disconnect one resource from another set of |
|
601
|
|
|
|
|
|
|
# resources. This protocol has to assume the end user is |
|
602
|
|
|
|
|
|
|
# allowed to make these kinds of changes. We'll mop up the |
|
603
|
|
|
|
|
|
|
# permission stuff elsewhere. |
|
604
|
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
# thinking this oughta do it: |
|
606
|
|
|
|
|
|
|
# { g => { s => { p => [{ o => 1 }, { langordt => { o => 1 }}]}}} |
|
607
|
|
|
|
|
|
|
|
|
608
|
0
|
|
0
|
|
|
|
my $g = $contents{graph} || $self->graph; |
|
609
|
|
|
|
|
|
|
|
|
610
|
0
|
0
|
|
|
|
|
if ($contents{modifier}{'!'}) { |
|
611
|
|
|
|
|
|
|
# reverse statement (O P S) |
|
612
|
0
|
|
|
|
|
|
my $p = $contents{term1}; |
|
613
|
0
|
|
0
|
|
|
|
my $o = URI::BNode->new($contents{term2} || $self->subject); |
|
614
|
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
# don't forget to do this |
|
616
|
0
|
0
|
|
|
|
|
$o = $self->callback->($o) if $self->callback; |
|
617
|
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
# you know what, it makes no sense for a reverse |
|
619
|
|
|
|
|
|
|
# statement to be anything but a URI or a blank node. |
|
620
|
|
|
|
|
|
|
|
|
621
|
0
|
0
|
|
|
|
|
next unless $contents{designator}[0] =~ /[_:]/; |
|
622
|
|
|
|
|
|
|
|
|
623
|
0
|
0
|
|
|
|
|
if ($contents{modifier}{'-'}) { |
|
624
|
|
|
|
|
|
|
# remove these triples |
|
625
|
0
|
|
|
|
|
|
for my $s (@v) { |
|
626
|
0
|
0
|
|
|
|
|
if ($contents{designator}[0] eq '_') { |
|
627
|
0
|
0
|
|
|
|
|
$s = '_:' . $s unless $s =~ /^_:/; |
|
628
|
|
|
|
|
|
|
} |
|
629
|
|
|
|
|
|
|
else { |
|
630
|
0
|
|
|
|
|
|
$s = URI->new_abs($s, $o); |
|
631
|
0
|
0
|
|
|
|
|
$s = $self->callback->($s) if $self->callback; |
|
632
|
|
|
|
|
|
|
} |
|
633
|
|
|
|
|
|
|
|
|
634
|
0
|
|
0
|
|
|
|
$neg{$g} ||= {}; |
|
635
|
0
|
|
0
|
|
|
|
$neg{$g}{$s} ||= {}; |
|
636
|
0
|
|
0
|
|
|
|
$neg{$g}{$s}{$p} ||= [{}, {}]; |
|
637
|
0
|
0
|
|
|
|
|
$neg{$g}{$s}{$p}[0]{$o} = 1 if ref $neg{$g}{$s}{$p}; |
|
638
|
|
|
|
|
|
|
|
|
639
|
0
|
|
|
|
|
|
$patch->remove_this($s, $p, $o, $g); |
|
640
|
|
|
|
|
|
|
} |
|
641
|
|
|
|
|
|
|
} |
|
642
|
|
|
|
|
|
|
else { |
|
643
|
|
|
|
|
|
|
# add these triples |
|
644
|
0
|
|
|
|
|
|
for my $s (@v) { |
|
645
|
0
|
0
|
|
|
|
|
next if $s eq ''; |
|
646
|
0
|
0
|
|
|
|
|
if ($contents{designator}[0] eq '_') { |
|
647
|
0
|
0
|
|
|
|
|
$s = '_:' . $s unless $s =~ /^_:/; |
|
648
|
|
|
|
|
|
|
} |
|
649
|
|
|
|
|
|
|
else { |
|
650
|
0
|
|
|
|
|
|
$s = URI->new_abs($s, $o); |
|
651
|
0
|
0
|
|
|
|
|
$s = $self->callback->($s) if $self->callback; |
|
652
|
|
|
|
|
|
|
} |
|
653
|
|
|
|
|
|
|
|
|
654
|
0
|
|
0
|
|
|
|
$pos{$g} ||= {}; |
|
655
|
0
|
|
0
|
|
|
|
$pos{$g}{$s} ||= {}; |
|
656
|
0
|
|
0
|
|
|
|
$pos{$g}{$s}{$p} ||= [{}, {}]; |
|
657
|
0
|
0
|
|
|
|
|
$pos{$g}{$s}{$p}[0]{$o} = 1 if ref $pos{$g}{$s}{$p}; |
|
658
|
|
|
|
|
|
|
|
|
659
|
0
|
|
|
|
|
|
$patch->add_this($s, $p, $o, $g); |
|
660
|
|
|
|
|
|
|
} |
|
661
|
|
|
|
|
|
|
} |
|
662
|
|
|
|
|
|
|
} |
|
663
|
|
|
|
|
|
|
else { |
|
664
|
|
|
|
|
|
|
# forward statement (S P O) |
|
665
|
0
|
|
|
|
|
|
my ($s, $p); |
|
666
|
0
|
0
|
|
|
|
|
if ($contents{term2}) { |
|
667
|
0
|
|
|
|
|
|
($s, $p) = @contents{qw(term1 term2)}; |
|
668
|
|
|
|
|
|
|
} |
|
669
|
|
|
|
|
|
|
else { |
|
670
|
0
|
|
|
|
|
|
$s = $self->subject; |
|
671
|
0
|
|
|
|
|
|
$p = $contents{term1}; |
|
672
|
|
|
|
|
|
|
} |
|
673
|
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
# (potentially) rewrite the URI |
|
675
|
0
|
0
|
|
|
|
|
$s = $self->callback->($s) if $self->callback; |
|
676
|
|
|
|
|
|
|
|
|
677
|
0
|
0
|
|
|
|
|
if ($contents{modifier}{'-'}) { |
|
678
|
|
|
|
|
|
|
# remove these triples |
|
679
|
0
|
|
0
|
|
|
|
$neg{$g} ||= {}; |
|
680
|
0
|
|
0
|
|
|
|
$neg{$g}{$s} ||= {}; |
|
681
|
0
|
|
0
|
|
|
|
$neg{$g}{$s}{$p} ||= [{}, {}]; |
|
682
|
|
|
|
|
|
|
|
|
683
|
0
|
0
|
0
|
|
|
|
if (@v and ref $neg{$g}{$s}{$p}) { |
|
684
|
0
|
|
|
|
|
|
for my $o (@v) { |
|
685
|
|
|
|
|
|
|
# empty string is a wildcard on negated |
|
686
|
|
|
|
|
|
|
# templates |
|
687
|
0
|
0
|
|
|
|
|
if ($o eq '') { |
|
688
|
0
|
|
|
|
|
|
$neg{$g}{$s}{$p} = 1; |
|
689
|
0
|
|
|
|
|
|
$patch->remove_this($s, $p, $o, $g); |
|
690
|
0
|
|
|
|
|
|
last; |
|
691
|
|
|
|
|
|
|
} |
|
692
|
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
# haha holy shit |
|
694
|
0
|
|
|
|
|
|
my $d = $contents{designator}; |
|
695
|
0
|
0
|
|
|
|
|
if ($d->[0] =~ /[_:]/) { |
|
|
|
0
|
|
|
|
|
|
|
696
|
0
|
0
|
0
|
|
|
|
$o = "_:$o" if $d->[0] eq '_' and $o !~ /^_:/; |
|
697
|
0
|
|
0
|
|
|
|
my $uri = $self->namespaces->uri($o) || $o; |
|
698
|
0
|
0
|
|
|
|
|
if ($d->[0] eq ':') { |
|
699
|
0
|
|
|
|
|
|
$uri = URI->new_abs($uri, $s); |
|
700
|
0
|
0
|
|
|
|
|
$uri = $self->callback->($uri) |
|
701
|
|
|
|
|
|
|
if $self->callback; |
|
702
|
|
|
|
|
|
|
} |
|
703
|
0
|
|
|
|
|
|
$neg{$g}{$s}{$p}[0]{$uri} = 1; |
|
704
|
|
|
|
|
|
|
|
|
705
|
0
|
|
|
|
|
|
$o = $uri; |
|
706
|
|
|
|
|
|
|
} |
|
707
|
|
|
|
|
|
|
elsif ($d->[0] =~ /[@^]/) { |
|
708
|
0
|
|
|
|
|
|
my $x = join '', @$d; |
|
709
|
0
|
|
0
|
|
|
|
my $y = $neg{$g}{$s}{$p}[1]{$x} ||= {}; |
|
710
|
0
|
|
|
|
|
|
$y->{$o} = 1; |
|
711
|
0
|
0
|
|
|
|
|
$o = [$o, $d->[0] eq '@' ? |
|
712
|
|
|
|
|
|
|
$d->[1] : (undef, $d->[1])]; |
|
713
|
|
|
|
|
|
|
} |
|
714
|
|
|
|
|
|
|
else { |
|
715
|
0
|
|
0
|
|
|
|
my $x = $neg{$g}{$s}{$p}[1]{''} ||= {}; |
|
716
|
0
|
|
|
|
|
|
$x->{$o} = 1; |
|
717
|
|
|
|
|
|
|
} |
|
718
|
|
|
|
|
|
|
|
|
719
|
0
|
|
|
|
|
|
$patch->remove_this($s, $p, $o, $g); |
|
720
|
|
|
|
|
|
|
} |
|
721
|
|
|
|
|
|
|
} |
|
722
|
|
|
|
|
|
|
} |
|
723
|
|
|
|
|
|
|
else { |
|
724
|
0
|
0
|
|
|
|
|
if ($contents{modifier}{'='}) { |
|
725
|
|
|
|
|
|
|
# remove triple wildcard |
|
726
|
0
|
|
0
|
|
|
|
$neg{$g} ||= {}; |
|
727
|
0
|
|
0
|
|
|
|
$neg{$g}{$s} ||= {}; |
|
728
|
0
|
|
|
|
|
|
$neg{$g}{$s}{$p} = 1; |
|
729
|
|
|
|
|
|
|
|
|
730
|
0
|
|
|
|
|
|
$patch->remove_this($s, $p, undef, $g); |
|
731
|
|
|
|
|
|
|
} |
|
732
|
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
# add triples |
|
734
|
0
|
|
0
|
|
|
|
$pos{$g} ||= {}; |
|
735
|
0
|
|
0
|
|
|
|
$pos{$g}{$s} ||= {}; |
|
736
|
0
|
|
0
|
|
|
|
$pos{$g}{$s}{$p} ||= [{}, {}]; |
|
737
|
|
|
|
|
|
|
|
|
738
|
0
|
|
|
|
|
|
for my $o (@v) { |
|
739
|
0
|
|
|
|
|
|
my $d = $contents{designator}; |
|
740
|
0
|
0
|
|
|
|
|
if ($d->[0] =~ /[_:]/) { |
|
|
|
0
|
|
|
|
|
|
|
741
|
0
|
0
|
|
|
|
|
next if $o eq ''; |
|
742
|
|
|
|
|
|
|
|
|
743
|
0
|
0
|
0
|
|
|
|
$o = "_:$o" if $d->[0] eq '_' and $o !~ /^_:/; |
|
744
|
0
|
|
0
|
|
|
|
my $uri = $self->namespaces->uri($o) || $o; |
|
745
|
0
|
0
|
|
|
|
|
if ($d->[0] eq ':') { |
|
746
|
0
|
|
|
|
|
|
$uri = URI->new_abs($uri, $s); |
|
747
|
0
|
0
|
|
|
|
|
$uri = $self->callback->($uri) |
|
748
|
|
|
|
|
|
|
if $self->callback; |
|
749
|
|
|
|
|
|
|
} |
|
750
|
|
|
|
|
|
|
|
|
751
|
0
|
|
|
|
|
|
$pos{$g}{$s}{$p}[0]{$uri} = 1; |
|
752
|
|
|
|
|
|
|
|
|
753
|
0
|
|
|
|
|
|
$o = $uri; |
|
754
|
|
|
|
|
|
|
} |
|
755
|
|
|
|
|
|
|
elsif ($d->[0] =~ /[@^]/) { |
|
756
|
0
|
|
|
|
|
|
my $x = join '', @$d; |
|
757
|
0
|
|
0
|
|
|
|
my $y = $pos{$g}{$s}{$p}[1]{$x} ||= {}; |
|
758
|
0
|
|
|
|
|
|
$y->{$o} = 1; |
|
759
|
|
|
|
|
|
|
|
|
760
|
0
|
0
|
|
|
|
|
$o = [$o, |
|
761
|
|
|
|
|
|
|
$d->[0] eq '@' ? $d->[1] : (undef, $d->[1])]; |
|
762
|
|
|
|
|
|
|
} |
|
763
|
|
|
|
|
|
|
else { |
|
764
|
0
|
|
0
|
|
|
|
my $x = $pos{$g}{$s}{$p}[1]{''} ||= {}; |
|
765
|
0
|
|
|
|
|
|
$x->{$o} = 1; |
|
766
|
|
|
|
|
|
|
} |
|
767
|
|
|
|
|
|
|
|
|
768
|
0
|
|
|
|
|
|
$patch->add_this($s, $p, $o, $g); |
|
769
|
|
|
|
|
|
|
} |
|
770
|
|
|
|
|
|
|
} |
|
771
|
|
|
|
|
|
|
} |
|
772
|
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
# you can tell a blank node from a resource if it starts |
|
774
|
|
|
|
|
|
|
# with _: |
|
775
|
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
# for negative wildcards: { g => { s => { p => 1 } } } |
|
777
|
|
|
|
|
|
|
# since removing S P * overrides any S P O. |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
# an empty @v means there was no value for this key that |
|
780
|
|
|
|
|
|
|
# was more than whitespace/empty string. |
|
781
|
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
# in this case we probably can't be clever and reuse the |
|
784
|
|
|
|
|
|
|
# values for multiple templates because some may or may |
|
785
|
|
|
|
|
|
|
# not include the indicator. |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
# actually we can reuse the values, we just can't parse |
|
788
|
|
|
|
|
|
|
# them until we've parsed the statement templates, because |
|
789
|
|
|
|
|
|
|
# those tell us what to do with the values. |
|
790
|
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
# which also means we have to parse the statement |
|
792
|
|
|
|
|
|
|
# templates immediately. |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
# there is still the issue of the empty string: what does |
|
795
|
|
|
|
|
|
|
# it mean, and in what context? |
|
796
|
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
# Step 4.2 dereference macros in statement *values* (that |
|
798
|
|
|
|
|
|
|
# asked to be) |
|
799
|
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
# Step 5: parse statement templates |
|
802
|
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
# Step 5.1 expand qnames |
|
804
|
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
# Step 6: generate complete statements |
|
806
|
|
|
|
|
|
|
} |
|
807
|
|
|
|
|
|
|
} |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
#return [\%neg, \%pos]; |
|
810
|
|
|
|
|
|
|
|
|
811
|
0
|
|
|
|
|
|
return $patch; |
|
812
|
|
|
|
|
|
|
} |
|
813
|
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
=head1 CAVEATS |
|
815
|
|
|
|
|
|
|
|
|
816
|
|
|
|
|
|
|
B<BYOS> == Bring Your Own Security. |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=head1 AUTHOR |
|
819
|
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
Dorian Taylor, C<< <dorian at cpan.org> >> |
|
821
|
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
=head1 BUGS |
|
823
|
|
|
|
|
|
|
|
|
824
|
|
|
|
|
|
|
Please report any bugs or feature requests to C<bug-rdf-kv at |
|
825
|
|
|
|
|
|
|
rt.cpan.org>, or through the web interface at |
|
826
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=RDF-KV>. I will be |
|
827
|
|
|
|
|
|
|
notified, and then you'll automatically be notified of progress on |
|
828
|
|
|
|
|
|
|
your bug as I make changes. |
|
829
|
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
=head1 SUPPORT |
|
831
|
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
|
833
|
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
perldoc RDF::KV |
|
835
|
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
You can also look for information at: |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=over 4 |
|
839
|
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker (report bugs here) |
|
841
|
|
|
|
|
|
|
|
|
842
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=RDF-KV> |
|
843
|
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
|
845
|
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
L<http://annocpan.org/dist/RDF-KV> |
|
847
|
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
=item * CPAN Ratings |
|
849
|
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/RDF-KV> |
|
851
|
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
=item * Search CPAN |
|
853
|
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/RDF-KV/> |
|
855
|
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=back |
|
857
|
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
859
|
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
=over 4 |
|
861
|
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
=item L<RDF::KV::Patch> |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=item L<URI::BNode> |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
=item L<RDF::Trine> |
|
867
|
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
=back |
|
869
|
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
|
871
|
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
Copyright 2013 Dorian Taylor. |
|
873
|
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
Licensed under the Apache License, Version 2.0 (the "License"); you |
|
875
|
|
|
|
|
|
|
may not use this file except in compliance with the License. You may |
|
876
|
|
|
|
|
|
|
obtain a copy of the License at |
|
877
|
|
|
|
|
|
|
L<http://www.apache.org/licenses/LICENSE-2.0>. |
|
878
|
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
Unless required by applicable law or agreed to in writing, software |
|
880
|
|
|
|
|
|
|
distributed under the License is distributed on an "AS IS" BASIS, |
|
881
|
|
|
|
|
|
|
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or |
|
882
|
|
|
|
|
|
|
implied. See the License for the specific language governing |
|
883
|
|
|
|
|
|
|
permissions and limitations under the License. |
|
884
|
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=cut |
|
886
|
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
__PACKAGE__->meta->make_immutable; |
|
888
|
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
1; # End of RDF::KV |