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         52  
2 17     17   117 use strict;
  17         28  
  17         425  
3 17     17   73 use warnings;
  17         35  
  17         437  
4 17     17   81 use utf8;
  17         47  
  17         96  
5              
6             package Neo4j::Driver::Record;
7             # ABSTRACT: Container for Cypher result values
8             $Neo4j::Driver::Record::VERSION = '0.38';
9              
10 17     17   1148 use Carp qw(croak);
  17         45  
  17         1076  
11 17     17   6908 use JSON::MaybeXS 1.003003 qw(is_bool);
  17         88482  
  17         951  
12              
13 17     17   6259 use Neo4j::Driver::ResultSummary;
  17         39  
  17         968  
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   271 my $value = shift;
20             # if the utf8 flag is on, it almost certainly started as a string
21 186 100       461 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   114 no warnings 'numeric';
  17         31  
  17         9610  
27 185 100       2023 return unless length((my $dummy = "") & $value);
28 78 100       236 return unless $value eq int $value;
29 77 100       188 return unless $value * 0 == 0;
30 76         163 return 1;
31             }
32              
33              
34             sub get {
35 247     247 1 43484 my ($self, $field) = @_;
36            
37 247 100       598 if ( ! defined $field ) {
38 62 100       75 warnings::warnif ambiguous => "Ambiguous get() on " . __PACKAGE__ . " with multiple fields" if @{$self->{row}} > 1;
  62         193  
39 62         965 return $self->{row}->[0];
40             }
41            
42 185 100       451 if ( _looks_like_int $field ) {
43 76 100 100     210 croak "Field $field not present in query result" if $field < 0 || $field >= @{$self->{row}};
  75         314  
44 74         452 return $self->{row}->[$field];
45             }
46            
47 109         375 my $key = $self->{column_keys}->key($field);
48 109 100       1558 croak "Field '$field' not present in query result" if ! defined $key;
49 104         715 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 1394 my ($self, $field) = @_;
64 3         74 warnings::warnif deprecated => __PACKAGE__ . "->get_bool is deprecated";
65            
66 3         986 my $value = $self->get($field);
67 3 100       13 return $value if ! is_bool $value;
68 2 100       44 return $value if !! $value;
69 1         9 return undef; ##no critic (ProhibitExplicitReturnUndef)
70             }
71              
72              
73             sub data {
74 1     1 1 3 my ($self) = @_;
75            
76 1         2 my %data = ();
77 1         3 foreach my $key (keys %{ $self->{column_keys} }) {
  1         6  
78 3         10 $data{$key} = $self->{row}->[ $self->{column_keys}->key($key) ];
79             }
80 1         18 return \%data;
81             }
82              
83              
84             sub summary {
85 2     2 0 434 my ($self) = @_;
86            
87 2   66     17 $self->{_summary} //= Neo4j::Driver::ResultSummary->new;
88 2         11 return $self->{_summary}->_init;
89             }
90              
91              
92             sub stats {
93             # uncoverable pod (see Deprecations.pod)
94 4     4 0 6 my ($self) = @_;
95 4         60 warnings::warnif deprecated => __PACKAGE__ . "->stats is deprecated; use summary instead";
96            
97 4 100       1197 return $self->{_summary} ? $self->{_summary}->counters : {};
98             }
99              
100              
101             1;
102              
103             __END__