line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# RDF::Trine::VariableBindings |
2
|
|
|
|
|
|
|
# ----------------------------------------------------------------------------- |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
=head1 NAME |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
RDF::Trine::VariableBindings - Variable bindings |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 VERSION |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
This document describes RDF::Trine::VariableBindings version 1.017 |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 SYNOPSIS |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use RDF::Trine qw(literal); |
15
|
|
|
|
|
|
|
use RDF::Trine::VariableBindings; |
16
|
|
|
|
|
|
|
my $vb = RDF::Trine::VariableBindings->new( {} ); |
17
|
|
|
|
|
|
|
$vb->set( foo => literal("bar") ); |
18
|
|
|
|
|
|
|
$vb->set( baz => literal("blee") ); |
19
|
|
|
|
|
|
|
$vb->variables; # qw(foo baz) |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
my $x = RDF::Trine::VariableBindings->new( { foo => literal("bar") } ); |
22
|
|
|
|
|
|
|
$x->set( greeting => literal("hello") ); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $j = $vb->join( $x ); # { foo => "bar", baz => "blee", greeting => "hello" } |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
my @keys = qw(baz greeting); |
27
|
|
|
|
|
|
|
my $p = $j->project( @keys ); # { baz => "blee", greeting => "hello" } |
28
|
|
|
|
|
|
|
print $p->{greeting}->literal_value; # "hello" |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
RDF::Trine::VariableBindings objects provide a mapping from variable names to |
33
|
|
|
|
|
|
|
RDF::Trine::Node objects. The objects may be used as a hash reference, with |
34
|
|
|
|
|
|
|
variable names used as hash keys. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 METHODS |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
=over 4 |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
=cut |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
package RDF::Trine::VariableBindings; |
43
|
|
|
|
|
|
|
|
44
|
68
|
|
|
68
|
|
487
|
use strict; |
|
68
|
|
|
|
|
177
|
|
|
68
|
|
|
|
|
1851
|
|
45
|
68
|
|
|
68
|
|
349
|
use warnings; |
|
68
|
|
|
|
|
151
|
|
|
68
|
|
|
|
|
3243
|
|
46
|
68
|
|
|
68
|
|
378
|
use overload '""' => sub { $_[0]->as_string }; |
|
68
|
|
|
3719
|
|
167
|
|
|
68
|
|
|
|
|
771
|
|
|
3719
|
|
|
|
|
12037
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
my %VB_LABELS; |
49
|
|
|
|
|
|
|
|
50
|
68
|
|
|
68
|
|
8950
|
use Scalar::Util qw(blessed refaddr); |
|
68
|
|
|
|
|
174
|
|
|
68
|
|
|
|
|
4331
|
|
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
###################################################################### |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
our ($VERSION); |
55
|
|
|
|
|
|
|
BEGIN { |
56
|
68
|
|
|
68
|
|
50283
|
$VERSION = '1.017'; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
###################################################################### |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=item C<< new ( \%bindings ) >> |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=cut |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub new { |
66
|
1855
|
|
|
1855
|
1
|
3770
|
my $class = shift; |
67
|
1855
|
|
|
|
|
3377
|
my $bindings = shift; |
68
|
1855
|
|
|
|
|
7602
|
my $self = bless( { %$bindings }, $class ); |
69
|
|
|
|
|
|
|
|
70
|
1855
|
50
|
33
|
|
|
7533
|
if (blessed($bindings) and $bindings->isa('RDF::Trine::VariableBindings')) { |
71
|
0
|
|
|
|
|
0
|
my $addr = refaddr($bindings); |
72
|
0
|
0
|
|
|
|
0
|
if (ref($VB_LABELS{ $addr })) { |
73
|
0
|
|
|
|
|
0
|
$VB_LABELS{ refaddr($self) } = { %{ $VB_LABELS{ $addr } } }; |
|
0
|
|
|
|
|
0
|
|
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
1855
|
|
|
|
|
5243
|
return $self; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=item C<< set ( $variable_name => $node ) >> |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=cut |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub set { |
85
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
86
|
0
|
|
|
|
|
0
|
my $name = shift; |
87
|
0
|
|
|
|
|
0
|
my $node = shift; |
88
|
0
|
|
|
|
|
0
|
$self->{ $name } = $node; |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item C<< join ( $row ) >> |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Returns a new VariableBindings object based on the join of this object and C<< $row >>. |
94
|
|
|
|
|
|
|
If the two variable binding objects cannot be joined, returns undef. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=cut |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub join { |
99
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
100
|
0
|
|
|
|
|
0
|
my $class = ref($self); |
101
|
0
|
|
|
|
|
0
|
my $rowb = shift; |
102
|
|
|
|
|
|
|
|
103
|
0
|
|
|
|
|
0
|
my %keysa; |
104
|
0
|
|
|
|
|
0
|
my @keysa = keys %$self; |
105
|
0
|
|
|
|
|
0
|
@keysa{ @keysa } = (1) x scalar(@keysa); |
106
|
0
|
|
|
|
|
0
|
my @shared = grep { exists $keysa{ $_ } } (keys %$rowb); |
|
0
|
|
|
|
|
0
|
|
107
|
0
|
|
|
|
|
0
|
foreach my $key (@shared) { |
108
|
0
|
|
|
|
|
0
|
my $val_a = $self->{ $key }; |
109
|
0
|
|
|
|
|
0
|
my $val_b = $rowb->{ $key }; |
110
|
0
|
0
|
0
|
|
|
0
|
next unless (defined($val_a) and defined($val_b)); |
111
|
0
|
|
0
|
|
|
0
|
my $equal = (refaddr($val_a) == refaddr($val_b)) || ($val_a == $val_b) || $val_a->equal( $val_b ); |
112
|
0
|
0
|
|
|
|
0
|
unless ($equal) { |
113
|
0
|
|
|
|
|
0
|
return; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
0
|
my $row = { (map { $_ => $self->{$_} } grep { defined($self->{$_}) } keys %$self), (map { $_ => $rowb->{$_} } grep { defined($rowb->{$_}) } keys %$rowb) }; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
118
|
0
|
|
|
|
|
0
|
my $joined = $class->new( $row ); |
119
|
0
|
|
|
|
|
0
|
$joined->copy_labels_from( $self ); |
120
|
0
|
|
|
|
|
0
|
$joined->copy_labels_from( $rowb ); |
121
|
|
|
|
|
|
|
|
122
|
0
|
|
|
|
|
0
|
return $joined; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=item C<< variables >> |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=cut |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
sub variables { |
130
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
131
|
0
|
|
|
|
|
0
|
return (keys %$self); |
132
|
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item C<< project ( @keys ) >> |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
Returns a new binding with values for only the keys listed. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=cut |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub project { |
141
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
142
|
0
|
|
|
|
|
0
|
my $class = ref($self); |
143
|
0
|
|
|
|
|
0
|
my @keys = @_; |
144
|
0
|
|
|
|
|
0
|
my %data = map { $_ => $self->{ $_ } } @keys; |
|
0
|
|
|
|
|
0
|
|
145
|
0
|
|
|
|
|
0
|
my $p = $class->new( \%data ); |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
0
|
my $addr = refaddr($self); |
148
|
0
|
0
|
|
|
|
0
|
if (ref($VB_LABELS{ $addr })) { |
149
|
0
|
|
|
|
|
0
|
$VB_LABELS{ refaddr($p) } = { %{ $VB_LABELS{ $addr } } }; |
|
0
|
|
|
|
|
0
|
|
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
0
|
|
|
|
|
0
|
return $p; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item C<< as_string >> |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Returns a string representation of the variable bindings. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=cut |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub as_string { |
162
|
3719
|
|
|
3719
|
1
|
6902
|
my $self = shift; |
163
|
3719
|
|
|
|
|
16871
|
my @keys = sort keys %$self; |
164
|
3719
|
50
|
|
|
|
8866
|
my $string = sprintf('{ %s }', CORE::join(', ', map { CORE::join('=', $_, ($self->{$_}) ? $self->{$_}->as_string : '()') } (@keys))); |
|
13364
|
|
|
|
|
43701
|
|
165
|
3719
|
|
|
|
|
15091
|
return $string; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=item C<< label ( $label => $value ) >> |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Sets the named C<< $label >> to C<< $value >> for this variable bindings object. |
171
|
|
|
|
|
|
|
If no C<< $value >> is given, returns the current label value, or undef if none |
172
|
|
|
|
|
|
|
exists. |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=cut |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
sub label { |
177
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
178
|
0
|
|
|
|
|
0
|
my $addr = refaddr($self); |
179
|
0
|
|
|
|
|
0
|
my $label_name = shift; |
180
|
0
|
0
|
|
|
|
0
|
if (@_) { |
181
|
0
|
|
|
|
|
0
|
my $value = shift; |
182
|
0
|
|
|
|
|
0
|
$VB_LABELS{ $addr }{ $label_name } = $value; |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
0
|
|
|
|
|
0
|
my $labels = $VB_LABELS{ $addr }; |
186
|
0
|
0
|
|
|
|
0
|
if (ref($labels)) { |
187
|
0
|
|
|
|
|
0
|
my $value = $labels->{ $label_name }; |
188
|
0
|
|
|
|
|
0
|
return $value; |
189
|
|
|
|
|
|
|
} else { |
190
|
0
|
|
|
|
|
0
|
return; |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
=item C<< copy_labels_from ( $vb ) >> |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
Copies the labels from C<< $vb >>, adding them to the labels for this object. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=cut |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub copy_labels_from { |
201
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
202
|
0
|
|
|
|
|
0
|
my $rowa = shift; |
203
|
0
|
|
|
|
|
0
|
my $self_labels = $VB_LABELS{ refaddr($self) }; |
204
|
0
|
|
|
|
|
0
|
my $a_labels = $VB_LABELS{ refaddr($rowa) }; |
205
|
0
|
0
|
0
|
|
|
0
|
if ($self_labels or $a_labels) { |
206
|
0
|
|
0
|
|
|
0
|
$self_labels ||= {}; |
207
|
0
|
|
0
|
|
|
0
|
$a_labels ||= {}; |
208
|
0
|
|
|
|
|
0
|
my %new_labels = ( %$self_labels, %$a_labels ); |
209
|
|
|
|
|
|
|
|
210
|
0
|
0
|
|
|
|
0
|
if (exists $new_labels{'origin'}) { |
211
|
0
|
|
|
|
|
0
|
my %origins; |
212
|
0
|
0
|
|
|
|
0
|
foreach my $o (@{ $self_labels->{'origin'} || [] }) { |
|
0
|
|
|
|
|
0
|
|
213
|
0
|
|
|
|
|
0
|
$origins{ $o }++; |
214
|
|
|
|
|
|
|
} |
215
|
0
|
0
|
|
|
|
0
|
foreach my $o (@{ $a_labels->{'origin'} || [] }) { |
|
0
|
|
|
|
|
0
|
|
216
|
0
|
|
|
|
|
0
|
$origins{ $o }++; |
217
|
|
|
|
|
|
|
} |
218
|
0
|
|
|
|
|
0
|
$new_labels{'origin'} = [ keys %origins ]; |
219
|
|
|
|
|
|
|
} |
220
|
|
|
|
|
|
|
|
221
|
0
|
|
|
|
|
0
|
$VB_LABELS{ refaddr($self) } = \%new_labels; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub _labels { |
226
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
227
|
0
|
|
|
|
|
0
|
my $addr = refaddr($self); |
228
|
0
|
|
|
|
|
0
|
my $labels = $VB_LABELS{ $addr }; |
229
|
0
|
|
|
|
|
0
|
return $labels; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
sub DESTROY { |
233
|
1855
|
|
|
1855
|
|
8169
|
my $self = shift; |
234
|
1855
|
|
|
|
|
4800
|
my $addr = refaddr( $self ); |
235
|
1855
|
|
|
|
|
3653
|
delete $VB_LABELS{ $addr }; |
236
|
1855
|
|
|
|
|
8079
|
return; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
1; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
__END__ |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=back |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=head1 BUGS |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Please report any bugs or feature requests to through the GitHub web interface |
248
|
|
|
|
|
|
|
at L<https://github.com/kasei/perlrdf/issues>. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
=head1 AUTHOR |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
Gregory Todd Williams <gwilliams@cpan.org> |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
=head1 COPYRIGHT |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Copyright (c) 2006-2012 Gregory Todd Williams. This |
257
|
|
|
|
|
|
|
program is free software; you can redistribute it and/or modify it under |
258
|
|
|
|
|
|
|
the same terms as Perl itself. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=cut |