File Coverage

lib/Neo4j/Driver/Record.pm
Criterion Covered Total %
statement 59 59 100.0
branch 24 24 100.0
condition 5 6 83.3
subroutine 14 14 100.0
pod 2 5 80.0
total 104 108 98.1


line stmt bran cond sub pod time code
1 17     17   280 use 5.010;
  17         51  
2 17     17   110 use strict;
  17         27  
  17         356  
3 17     17   85 use warnings;
  17         38  
  17         409  
4 17     17   74 use utf8;
  17         27  
  17         85  
5              
6             package Neo4j::Driver::Record;
7             # ABSTRACT: Container for Cypher result values
8             $Neo4j::Driver::Record::VERSION = '0.39';
9              
10 17     17   1094 use Carp qw(croak);
  17         40  
  17         1034  
11 17     17   7120 use JSON::MaybeXS 1.003003 qw(is_bool);
  17         89499  
  17         953  
12              
13 17     17   6395 use Neo4j::Driver::ResultSummary;
  17         37  
  17         1033  
14              
15              
16             # Based on _looks_like_number() in JSON:PP 4.05, originally by HAARG.
17             # Modified on 2020 OCT 13 to detect only integers (column index).
18             sub _looks_like_int {
19 186     186   308 my $value = shift;
20             # if the utf8 flag is on, it almost certainly started as a string
21 186 100       481 return if utf8::is_utf8($value);
22             # detect numbers
23             # string & "" -> ""
24             # number & "" -> 0 (with warning)
25             # nan and inf can detect as numbers, so check with * 0
26 17     17   117 no warnings 'numeric';
  17         28  
  17         9913  
27 185 100       765 return unless length((my $dummy = "") & $value);
28 78 100       225 return unless $value eq int $value;
29 77 100       175 return unless $value * 0 == 0;
30 76         184 return 1;
31             }
32              
33              
34             sub get {
35 247     247 1 43113 my ($self, $field) = @_;
36            
37 247 100       546 if ( ! defined $field ) {
38 62 100       76 warnings::warnif ambiguous => "Ambiguous get() on " . __PACKAGE__ . " with multiple fields" if @{$self->{row}} > 1;
  62         189  
39 62         948 return $self->{row}->[0];
40             }
41            
42 185 100       403 if ( _looks_like_int $field ) {
43 76 100 100     207 croak "Field $field not present in query result" if $field < 0 || $field >= @{$self->{row}};
  75         256  
44 74         404 return $self->{row}->[$field];
45             }
46            
47 109         380 my $key = $self->{column_keys}->key($field);
48 109 100       303 croak "Field '$field' not present in query result" if ! defined $key;
49 104         769 return $self->{row}->[$key];
50             }
51              
52              
53             # The various JSON modules for Perl tend to represent a boolean false value
54             # using a blessed scalar overloaded to evaluate to false in Perl expressions.
55             # This almost always works perfectly fine. However, some tests might not expect
56             # a non-truthy value to be blessed, which can result in wrong interpretation of
57             # query results. The get_bool method was meant to ensure boolean results would
58             # evaluate correctly in such cases. Given that such cases are rare and that no
59             # specific examples for such cases are currently known, this method now seems
60             # superfluous.
61             sub get_bool {
62             # uncoverable pod (see Deprecations.pod)
63 3     3 0 1398 my ($self, $field) = @_;
64 3         74 warnings::warnif deprecated => __PACKAGE__ . "->get_bool is deprecated";
65            
66 3         1027 my $value = $self->get($field);
67 3 100       20 return $value if ! is_bool $value;
68 2 100       47 return $value if !! $value;
69 1         13 return undef; ##no critic (ProhibitExplicitReturnUndef)
70             }
71              
72              
73             sub data {
74 1     1 1 4 my ($self) = @_;
75            
76 1         3 my %data = ();
77 1         2 foreach my $key (keys %{ $self->{column_keys} }) {
  1         5  
78 3         8 $data{$key} = $self->{row}->[ $self->{column_keys}->key($key) ];
79             }
80 1         13 return \%data;
81             }
82              
83              
84             sub summary {
85 2     2 0 435 my ($self) = @_;
86            
87 2   66     17 $self->{_summary} //= Neo4j::Driver::ResultSummary->new;
88 2         9 return $self->{_summary}->_init;
89             }
90              
91              
92             sub stats {
93             # uncoverable pod (see Deprecations.pod)
94 4     4 0 7 my ($self) = @_;
95 4         58 warnings::warnif deprecated => __PACKAGE__ . "->stats is deprecated; use summary instead";
96            
97 4 100       1210 return $self->{_summary} ? $self->{_summary}->counters : {};
98             }
99              
100              
101             1;
102              
103             __END__