File Coverage

blib/lib/REST/Neo4p/Constraint/RelationshipType.pm
Criterion Covered Total %
statement 45 66 68.1
branch 12 26 46.1
condition 5 10 50.0
subroutine 10 13 76.9
pod 7 9 77.7
total 79 124 63.7


line stmt bran cond sub pod time code
1             #$Id$
2             package REST::Neo4p::Constraint::RelationshipType;
3 4     4   2463 use base 'REST::Neo4p::Constraint';
  4         48  
  4         419  
4 4     4   30 use strict;
  4         8  
  4         103  
5 4     4   25 use warnings;
  4         9  
  4         152  
6              
7             BEGIN {
8 4     4   3400 $REST::Neo4p::Constraint::RelationshipType::VERSION = '0.4003';
9             }
10              
11             sub new {
12 5     5 1 17 my $class = shift;
13 5         28 my $self = $class->SUPER::new(@_);
14 5         11 $self->{_type} = 'relationship_type';
15 5         32 return $self;
16             }
17              
18             sub new_from_constraint_hash {
19 5     5 0 11 my $self = shift;
20 5         13 my ($constraints) = @_;
21 5 50       25 die "tag not defined" unless $self->tag;
22 5 50 33     41 die "constraint hash not defined or not a hashref" unless defined $constraints && (ref $constraints eq 'HASH');
23 5 100       17 if (my $cond = $constraints->{_condition}) {
24 3 50       33 unless (grep(/^$cond$/,qw( only none ))) {
25 0         0 die "Relationship type constraint condition must be one of (only|none)";
26             }
27             }
28             else {
29 2         5 $constraints->{_condition} = 'only'; # default
30             }
31 5   100     34 $constraints->{_priority} ||= 0;
32 5 50 33     43 unless ( defined $constraints->{_type_list} &&
33             ref $constraints->{_type_list} eq 'ARRAY' ) {
34 0         0 die "Relationship type constraint must contain an arrayref of types"
35             }
36              
37 5         20 $self->{_constraints} = $constraints;
38 5         16 return $self;
39             }
40              
41             sub add_constraint {
42 1     1 1 3 my $self = shift;
43 1         3 my ($key, $value) = @_;
44 1         5 return $self->add_types(@_);
45             }
46              
47             sub add_types {
48 1     1 1 2 my $self = shift;
49 1         15 my @types = @_;
50 1   50     6 $self->constraints->{_type_list} ||= [];
51 1         3 for (@types) {
52 1 50       4 if (ref) {
53 0         0 REST::Neo4p::LocalException->throw("Relationship types must be strings\n");
54             }
55 1         2 push @{$self->constraints->{_type_list}}, $_;
  1         3  
56             }
57 1         5 return 1;
58             }
59              
60             sub type_list {
61 16     16 0 30 my $self = shift;
62 16         46 my $constraints = $self->constraints;
63 16 50       45 return @{$constraints->{_type_list}} if (defined $constraints->{_type_list});
  16         313  
64 0         0 return;
65             }
66              
67 0     0 1 0 sub remove_constraint { shift->remove_type(@_) }
68              
69             sub remove_type {
70 0     0 1 0 my $self = shift;
71 0         0 my ($tag) = @_;
72 0         0 my $ret;
73 0 0       0 return unless $self->type_list;
74 0         0 my $constraints = $self->constraints;
75 0         0 for my $i (0..$#{$constraints->{_type_list}}) {
  0         0  
76 0 0       0 if ($tag eq $constraints->{_type_list}->{$i}) {
77 0         0 $ret = delete $constraints->{_type_list}->{$i};
78 0         0 last;
79             }
80             }
81 0         0 return $ret;
82             }
83              
84             sub set_condition {
85 0     0 1 0 my $self = shift;
86 0         0 my ($condition) = @_;
87 0 0       0 unless ($condition =~ /^(only|none)$/) {
88 0         0 REST::Neo4p::LocalException->throw("Relationship type condition must be one of (only|none)\n");
89             }
90 0         0 return $self->{_constraints}{_condition} = $condition;
91             }
92              
93             sub validate {
94 14     14 1 23 my $self = shift;
95 14         36 my ($type) = (@_);
96 14 50       29 return unless defined $type;
97 14 50       43 $type = $type->type if (ref($type) =~ /Neo4p::Relationship$/);
98 14 100       32 return grep(/^$type$/,$self->type_list) ? 1 : 0;
99             }
100              
101             =head1 NAME
102              
103             REST::Neo4p::Constraint::RelationshipType - Neo4j Relationship Type Constraints
104              
105             =head1 SYNOPSIS
106              
107             # use REST::Neo4p::Constrain, it's nicer
108              
109             $rtc = REST::Neo4p::Constraint::RelationshipType->new(
110             'allowed_reln_types' =>
111             { _condition => 'only',
112             _type_list => [qw(contains has)] }
113             );
114              
115             =head1 DESCRIPTION
116              
117             C is a class that represent
118             the set of relationship types that Relationships must (or must not)
119             use.
120              
121             Constraint hash specification:
122              
123             {
124             _condition => <'only'|'none'>,
125             _priority => ,
126             _type_list => [ 'type_name_1', 'type_name_2', ...] }
127             }
128              
129             =head1 METHODS
130              
131             =over
132              
133             =item new()
134              
135             $rt = REST::Neo4p::Constraint::RelationshipType->new(
136             $tag => $constraint_hash
137             );
138              
139             =item add_constraint()
140              
141             =item add_types()
142              
143             $rc->add_constraint('new_type');
144             $rc->add_type('new_type');
145              
146             =item remove_constraint()
147              
148             =item remove_type()
149              
150             $rc->remove_constraint('old_type');
151             $rc->remove_type('old_type');
152              
153             =item tag()
154              
155             Returns the constraint tag.
156              
157             =item type()
158              
159             Returns the constraint type ('relationship_type').
160              
161             =item condition()
162              
163             =item set_condition()
164              
165             Get/set 'only' or 'none' for a given relationship constraint. See
166             L.
167              
168             =item priority()
169              
170             =item set_priority()
171              
172             Constraints with higher priority will be checked before constraints
173             with lower priority by
174             L|REST::Neo4p::Constraint/Functional
175             interface for validation>.
176              
177             =item constraints()
178              
179             Returns the internal constraint spec hashref.
180              
181             =item validate()
182              
183             $c->validate( 'avoids' );
184              
185             Returns true if the item meets the constraint, false if not.
186              
187             =back
188              
189             =head1 SEE ALSO
190              
191             L, L, L,
192             L, L,
193             L.
194              
195             =head1 AUTHOR
196              
197             Mark A. Jensen
198             CPAN ID: MAJENSEN
199             majensen -at- cpan -dot- org
200              
201             =head1 LICENSE
202              
203             Copyright (c) 2012-2022 Mark A. Jensen. This program is free software; you
204             can redistribute it and/or modify it under the same terms as Perl
205             itself.
206              
207             =cut
208              
209             1;