File Coverage

blib/lib/Protocol/CassandraCQL/Result.pm
Criterion Covered Total %
statement 84 85 98.8
branch 14 24 58.3
condition 5 12 41.6
subroutine 15 15 100.0
pod 10 10 100.0
total 128 146 87.6


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2013-2014 -- leonerd@leonerd.org.uk
5              
6             package Protocol::CassandraCQL::Result;
7              
8 4     4   751 use strict;
  4         6  
  4         156  
9 4     4   22 use warnings;
  4         22  
  4         116  
10 4     4   21 use base qw( Protocol::CassandraCQL::ColumnMeta );
  4         6  
  4         2487  
11              
12             our $VERSION = '0.11';
13              
14 4     4   29 use Carp;
  4         14  
  4         261  
15              
16 4     4   21 use Protocol::CassandraCQL qw( :types );
  4         6  
  4         4966  
17              
18             =head1 NAME
19              
20             C - stores the result of a Cassandra CQL query
21              
22             =head1 DESCRIPTION
23              
24             Objects in this class store the result of a direct query or executed prepared
25             statement, as returned by an C giving C. It allows
26             convenient access to the decoded row data.
27              
28             As a subclass of L it also provides
29             information about column metadata, such as column names and types.
30              
31             =cut
32              
33             =head1 CONSTRUCTORS
34              
35             =head2 $result = Protocol::CassandraCQL::Result->from_frame( $frame, $version )
36              
37             Returns a new result object initialised from the given C /
38             C message frame and CQL version number. (Version will default to
39             1 if not supplied, but this may become a required parameter in a future
40             version).
41              
42             =cut
43              
44             sub from_frame
45             {
46 8     8 1 13 my $class = shift;
47 8         17 my ( $frame, $version ) = @_;
48              
49 8 50       27 defined $version or $version = 1;
50              
51 8         56 my $self = $class->SUPER::from_frame( $frame, $version );
52              
53 8         27 my $n_rows = $frame->unpack_int;
54 8         65 my $n_columns = $self->columns;
55              
56 8         37 my $has_metadata = $self->has_metadata;
57              
58 8 100       21 if( $has_metadata ) {
59 6         15 $self->{rows} = [];
60             }
61             else {
62 2         6 $self->{rowbytes} = [];
63             }
64              
65 8         21 foreach ( 1 .. $n_rows ) {
66 9         20 my @rowbytes = map { $frame->unpack_bytes } 1 .. $n_columns;
  15         50  
67              
68 9 100       24 if( $has_metadata ) {
69 7         9 push @{$self->{rows}}, [ $self->decode_data( @rowbytes ) ];
  7         295  
70             }
71             else {
72 2         6 push @{$self->{rowbytes}}, \@rowbytes;
  2         10  
73             }
74             }
75              
76 8         276 return $self;
77             }
78              
79             =head2 $result = Protocol::CassandraCQL::Result->new( %args )
80              
81             Returns a new result object initialised directly from the given row data. This
82             constructor is intended for use by unit test scripts, to create results
83             directly from mocked connection objects or similar.
84              
85             In addition to the arguments taken by the superclass constructor, it takes the
86             following named arguments:
87              
88             =over 8
89              
90             =item rows => ARRAY[ARRAY]
91              
92             An ARRAY reference containing ARRAY references of the individual rows' data.
93              
94             =back
95              
96             =cut
97              
98             sub new
99             {
100 1     1 1 900 my $class = shift;
101 1         5 my %args = @_;
102              
103 1         3 my $rows = delete $args{rows};
104              
105 1         10 my $self = $class->SUPER::new( %args );
106              
107 1         3 $self->{rows} = \my @rows;
108              
109 1         4 foreach my $ri ( 0 .. $#$rows ) {
110 3         4 my $row = $rows->[$ri];
111              
112 3         20 foreach my $ci ( 0 .. $self->columns-1 ) {
113 6 50       19 my $e = $self->column_type( $ci )->validate( $row->[$ci] ) or next;
114 0         0 croak "Cannot construct row $ri: ".$self->column_shortname( $ci ).": $e";
115             }
116              
117 3         11 push @rows, [ @$row ];
118             }
119              
120 1         5 return $self;
121             }
122              
123             =head2 $result->set_metadata( $meta )
124              
125             If the result was constructed from a message frame with the
126             C flag set, it would not have embedded metadata allowing the
127             object to correctly decode the encoded byte strings. This method allows the
128             caller to provide the metadata as previously returned by the C
129             operation that prepared the query initially, enabling its decoding.
130              
131             If the result object lacks this metadata, then before this method is called
132             only the C and C methods may be used to return the general
133             shape of the data; any of the row data methods will throw exceptions until
134             the metadata is set.
135              
136             =cut
137              
138             sub set_metadata
139             {
140 1     1 1 2 my $self = shift;
141 1         3 my ( $meta ) = @_;
142              
143 1 50       4 $self->has_metadata and croak "Cannot ->set_metadata - already have some";
144 1 50       4 $self->columns == $meta->columns or croak "Cannot ->set_metadata - column counts disagree";
145              
146             # Steal it
147 1         3 $self->{columns} = $meta->{columns};
148              
149             # Now decode the data
150 1         5 $self->{rows} = [ map {
151 1         2 [ $self->decode_data( @$_ ) ]
152 1         3 } @{ delete $self->{rowbytes} } ];
153             }
154              
155             =head2 $n = $result->rows
156              
157             Returns the number of rows
158              
159             =cut
160              
161             sub rows
162             {
163 16     16 1 37 my $self = shift;
164 16   66     24 return scalar @{ $self->{rows} // $self->{rowbytes} };
  16         98  
165             }
166              
167             =head2 $data = $result->row_array( $idx )
168              
169             Returns the row's data decoded, as an ARRAY reference
170              
171             =cut
172              
173             sub row_array
174             {
175 13     13 1 18 my $self = shift;
176 13         19 my ( $idx ) = @_;
177              
178 13 50       33 my $rows = $self->{rows} or croak "Row data is not yet decoded";
179              
180 13 50 33     62 croak "No such row $idx" unless $idx >= 0 and $idx < @$rows;
181              
182             # clone it so the caller can't corrupt our stored state
183 13         15 return [ @{ $rows->[$idx] } ];
  13         83  
184             }
185              
186             =head2 $data = $result->row_hash( $idx )
187              
188             Returns the row's data decoded, as a HASH reference mapping column short names
189             to values.
190              
191             =cut
192              
193             sub row_hash
194             {
195 11     11 1 17 my $self = shift;
196 11         17 my ( $idx ) = @_;
197              
198 11 50       29 my $rows = $self->{rows} or croak "Row data is not yet decoded";
199              
200 11 50 33     55 croak "No such row $idx" unless $idx >= 0 and $idx < @$rows;
201              
202 11         37 return { map { $self->column_shortname( $_ ) => $rows->[$idx][$_] } 0 .. $self->columns-1 };
  21         64  
203             }
204              
205             =head2 @data = $result->rows_array
206              
207             Returns a list of all the rows' data decoded as ARRAY references.
208              
209             =cut
210              
211             sub rows_array
212             {
213 5     5 1 9 my $self = shift;
214 5         13 return map { $self->row_array( $_ ) } 0 .. $self->rows-1;
  11         26  
215             }
216              
217             =head2 @data = $result->rows_hash
218              
219             Returns a list of all the rows' data decoded as HASH references.
220              
221             =cut
222              
223             sub rows_hash
224             {
225 3     3 1 6 my $self = shift;
226 3         17 return map { $self->row_hash( $_ ) } 0 .. $self->rows-1;
  9         21  
227             }
228              
229             =head2 $map = $result->rowmap_array( $keyidx )
230              
231             Returns a HASH reference mapping keys to rows deccoded as ARRAY references.
232             C<$keyidx> gives the column index of the value to use as the key in the
233             returned map.
234              
235             =cut
236              
237             sub rowmap_array
238             {
239 1     1 1 3 my $self = shift;
240 1         2 my ( $keyidx ) = @_;
241              
242 1 50 33     9 croak "No such column $keyidx" unless $keyidx >= 0 and $keyidx < $self->columns;
243              
244 1         4 return { map { $_->[$keyidx] => $_ } $self->rows_array };
  3         18  
245             }
246              
247             =head2 $map = $result->rowmap_hash( $keyname )
248              
249             Returns a HASH reference mapping keys to rows decoded as HASH references.
250             C<$keyname> gives the column shortname of the value to use as the key in the
251             returned map.
252              
253             =cut
254              
255             sub rowmap_hash
256             {
257 2     2 1 5 my $self = shift;
258 2         4 my ( $keyname ) = @_;
259              
260 2 50       16 croak "No such column '$keyname'" unless defined $self->find_column( $keyname );
261              
262 2         8 return { map { $_->{$keyname} => $_ } $self->rows_hash };
  6         42  
263             }
264              
265             =head1 SPONSORS
266              
267             This code was paid for by
268              
269             =over 2
270              
271             =item *
272              
273             Perceptyx L
274              
275             =item *
276              
277             Shadowcat Systems L
278              
279             =back
280              
281             =head1 AUTHOR
282              
283             Paul Evans
284              
285             =cut
286              
287             0x55AA;