File Coverage

blib/lib/REST/Neo4p/Constraint/Relationship.pm
Criterion Covered Total %
statement 75 104 72.1
branch 32 58 55.1
condition 17 42 40.4
subroutine 9 11 81.8
pod 6 7 85.7
total 139 222 62.6


line stmt bran cond sub pod time code
1             #$Id$
2             package REST::Neo4p::Constraint::Relationship;
3 4     4   2457 use base 'REST::Neo4p::Constraint';
  4         12  
  4         405  
4 4     4   28 use strict;
  4         11  
  4         81  
5 4     4   19 use warnings;
  4         6  
  4         163  
6              
7             BEGIN {
8 4     4   5295 $REST::Neo4p::Constraint::Relationship::VERSION = '0.4003';
9             }
10              
11             sub new {
12 9     9 1 37 my $class = shift;
13 9         42 my $self = $class->SUPER::new(@_);
14 9         19 $self->{_type} = 'relationship';
15 9         44 return $self;
16              
17             }
18              
19             sub new_from_constraint_hash {
20 9     9 0 20 my $self = shift;
21 9         19 my ($constraints) = @_;
22 9 50       28 die "tag not defined" unless $self->tag;
23 9 50 33     63 die "constraint hash not defined or not a hashref" unless defined $constraints && (ref $constraints eq 'HASH');
24 9 100       25 if (my $cond = $constraints->{_condition}) {
25 6 50       49 unless (grep(/^$cond$/,qw( only none ))) {
26 0         0 die "Relationship constraint condition must be only|none";
27             }
28             }
29 9   100     37 $constraints->{_condition} ||= 'only';
30 9   50     86 $constraints->{_priority} ||= 0;
31 9 50       53 unless (ref $constraints->{_descriptors} eq 'ARRAY') {
32 0         0 die "relationship constraint descriptors must be array of hashrefs";
33             }
34 9         15 foreach (@{$constraints->{_descriptors}}) {
  9         28  
35 13 50       43 unless (ref eq 'HASH') {
36 0         0 die "relationship constraint descriptor must by a hashref";
37             }
38             }
39 9         20 $self->{_constraints} = $constraints;
40 9         23 return $self;
41             }
42              
43 24     24 1 62 sub rtype { shift->constraints->{_relationship_type} }
44              
45             sub add_constraint {
46 4     4 1 97 my $self = shift;
47 4         9 my ($value) = @_;
48 4 50       11 return unless defined $value;
49 4 50       12 unless (ref($value) eq 'HASH') {
50 0         0 REST::Neo4p::LocalException->throw("Relationship descriptor must be a hashref { node_property_constraint_tag => node_property_constraint_tag }\n");
51             }
52 4         19 my $constraints = $self->constraints;
53 4   50     13 $constraints->{_descriptors} ||= [];
54 4         18 while ( my ($tag1, $tag2) = each %$value ) {
55 4 100       80 unless ( grep(/^$tag1$/, keys %$REST::Neo4p::Constraint::CONSTRAINT_TABLE) ) {
56 1         10 REST::Neo4p::LocalException->throw("Constraint '$tag1' is not defined\n");
57             }
58 3 100       48 unless ( grep(/^$tag2$/, keys %$REST::Neo4p::Constraint::CONSTRAINT_TABLE) ) {
59 1         6 REST::Neo4p::LocalException->throw("Constraint '$tag2' is not defined\n");
60             }
61 2         5 push @{$constraints->{_descriptors}}, $value;
  2         10  
62             }
63 2         8 return 1;
64             }
65              
66             sub remove_constraint {
67 0     0 1 0 my $self = shift;
68 0         0 my ($from, $to) = @_;
69 0         0 my $ret;
70 0         0 my $descr = $self->constraints->{_descriptors};
71 0         0 for my $i (0..$#{$descr}) {
  0         0  
72 0         0 my ($k, $v) = each %{$descr->[$i]};
  0         0  
73 0 0 0     0 if ( ($k eq $from) && ( $v eq $to ) ) {
74 0         0 $ret = delete $descr->[$i];
75 0         0 last;
76             }
77             }
78 0         0 return $ret;
79             }
80              
81             sub set_condition {
82 0     0 1 0 my $self = shift;
83 0         0 my ($condition) = @_;
84 0 0       0 unless ($condition =~ /^(only|none)$/) {
85 0         0 REST::Neo4p::LocalException->throw("Relationship condition must be one of (only|none)\n");
86             }
87 0         0 return $self->{_constraints}{_condition} = $condition;
88             }
89              
90             sub validate {
91              
92 10     10 1 24 my $self = shift;
93 10         21 my ($from, $to, $reln_type, $reln_props) = @_;
94 10         18 my ($reln) = @_;
95 10 50       26 return unless defined $from;
96 10 50       28 if (ref($reln) =~ /Neo4p::Relationship$/) {
97 0         0 $from = $reln->start_node->get_properties;
98 0         0 $to = $reln->end_node->get_properties;
99 0         0 $reln_type = $reln->type;
100             }
101 10 50       21 REST::Neo4p::LocalException->throw("Relationship type (arg3) must be provided to validate\n") unless defined $reln_type;
102 10 50 33     23 REST::Neo4p::LocalException->throw("Relationship properties (arg4) must be a hashref of properties\n") unless (!$reln_props) || (ref $reln_props eq 'HASH');
103              
104 10 50 33     96 unless ((ref($from) =~ /Neo4p::Node|HASH$/) &&
105             (ref($to) =~ /Neo4p::Node|HASH$/)) {
106 0         0 REST::Neo4p::LocalException->throw("validate() requires a pair of Node objects, a pair of hashrefs, or a single Relationship object\n");
107             }
108             # first check if relationship type is defined and
109             # is represented in this constraint (or the constraint has
110             # wildcard type)
111 10 100 66     29 return 0 unless (($self->rtype eq '*') || ($reln_type eq $self->rtype));
112             # if rtype validation is strict, fail if type undefined or not found
113             # if validation is lax, continue
114 9 50       25 if ($REST::Neo4p::Constraint::STRICT_RELN_TYPES) {
115 9 50       32 return 0 unless REST::Neo4p::Constraint::validate_relationship_type($reln_type);
116             }
117              
118 9 50 33     29 return 1 if ( ($self->condition eq 'none') && !defined $self->constraints->{$reln_type} );
119              
120 9         16 my @descriptors = @{$self->constraints->{_descriptors}};
  9         21  
121 9 50       24 $from = $from->get_properties if ref($from) =~ /Neo4p::Node$/;
122 9 50       19 $to = $to->get_properties if ref($to) =~ /Neo4p::Node$/;
123             # $to, $from now normalized to property hashrefs
124              
125 9         23 my $from_constraint = REST::Neo4p::Constraint::validate_properties($from);
126 9         21 my $to_constraint = REST::Neo4p::Constraint::validate_properties($to);
127              
128 9   33     33 $from_constraint = $from_constraint && $from_constraint->tag;
129 9   33     28 $to_constraint = $to_constraint && $to_constraint->tag;
130             # $to_constraint, $from_constraint contain undef or the matching
131             # constraint tag
132              
133             # filter @descriptors based on $from_constraint tag
134 9   50     21 $to_constraint ||= '*';
135 9   50     16 $from_constraint ||= '*';
136 9         20 @descriptors = grep { defined $_->{ $from_constraint } } @descriptors;
  23         64  
137              
138 9 100       22 if (@descriptors) {
139 8         13 my $found = grep /^\Q$to_constraint\E$/, map {$_->{$from_constraint}} @descriptors;
  10         123  
140 8 100 66     27 return 0 if (($self->condition eq 'only') && !$found);
141 5 50 33     15 return 0 if (($self->condition eq 'none') && $found);
142             }
143             else {
144 1 50       4 return 0 if ($self->condition eq 'only');
145             }
146              
147              
148             # TODO: validate relationship properties here
149 5 50       21 if ($REST::Neo4p::Constraint::STRICT_RELN_PROPS) {
150 0   0     0 $reln_props ||= {};
151 0         0 $reln_props->{__type} = 'relationship';
152 0         0 $reln_props->{_relationship_type} = $reln_type;
153 0 0       0 return 0 unless REST::Neo4p::Constraint::validate_properties($reln_props);
154             }
155              
156 5         30 return 1;
157             }
158              
159             =head1 NAME
160              
161             REST::Neo4p::Constraint::Relationship - Neo4j Relationship Constraints
162              
163             =head1 SYNOPSIS
164              
165             # use REST::Neo4p::Constrain, it's nicer
166              
167             $rc = REST::Neo4p::Constraint::Relationship->new(
168             'allowed_contains_relns' =>
169             { _condition => 'only',
170             _relationship_type => 'contains',
171             _priority => 0,
172             _descriptors => [ {'module' => 'method'},
173             {'module' => 'variable'},
174             {'method' => 'variable'} ] }
175             );
176              
177             =head1 DESCRIPTION
178              
179             C is a class that represents
180             constraints on the type and direction of relationships between nodes
181             that satisfy given sets of property constraints.
182              
183             Constraint hash specification:
184              
185             {
186             _condition => <'only'|'none'>,
187             _relationship_type => ,
188             _priority => ,
189             _descriptors => [{ property_constraint_tag =>
190             property_constraint_tag },...] }
191             }
192              
193             =head1 METHODS
194              
195             =over
196              
197             =item new()
198              
199             $rc = $REST::Neo4p::Constraint::Relationship->new(
200             $tag => $constraint_hash
201             );
202              
203             =item add_constraint()
204              
205             $rc->add_constraint( { 'star' => 'planet' });
206              
207             =item remove_constraint()
208              
209             $rc->remove_constraint( { 'developer' => 'parole_officer' } );
210              
211             =item tag()
212              
213             Returns the constraint tag.
214              
215             =item type()
216              
217             Returns the constraint type ('relationship').
218              
219             =item rtype()
220              
221             The relationship type to which this constraint applies.
222              
223             =item constraints()
224              
225             Returns the internal constraint spec hashref.
226              
227             =item priority()
228              
229             =item set_priority()
230              
231             Constraints with higher priority will be checked before constraints
232             with lower priority by
233             L|REST::Neo4p::Constraint/Functional
234             interface for validation>.
235              
236             =item condition()
237              
238             =item set_condition()
239              
240             $r->set_condition('only');
241              
242             Get/set 'only' or 'none' for a given relationship constraint. See
243             L.
244              
245             =item validate()
246              
247             $c->validate( $relationship_object );
248             $c->validate( $node_object1 => $node_object2,
249             $reln_type );
250             $c->validate( { name => 'Steve', instrument => 'banjo' } =>
251             { name => 'Marcia', instrument => 'blunt' },
252             'avoids' );
253              
254             Returns true if the item meets the constraint, false if not.
255              
256             =back
257              
258             =head1 SEE ALSO
259              
260             L, L, L,
261             L, L,
262             L.
263              
264             =head1 AUTHOR
265              
266             Mark A. Jensen
267             CPAN ID: MAJENSEN
268             majensen -at- cpan -dot- org
269              
270             =head1 LICENSE
271              
272             Copyright (c) 2012-2022 Mark A. Jensen. This program is free software; you
273             can redistribute it and/or modify it under the same terms as Perl
274             itself.
275              
276             =cut
277              
278             1;