File Coverage

blib/lib/Thrift/Protocol.pm
Criterion Covered Total %
statement 60 228 26.3
branch 0 52 0.0
condition 0 3 0.0
subroutine 20 63 31.7
pod 0 43 0.0
total 80 389 20.5


line stmt bran cond sub pod time code
1             #
2             # Licensed to the Apache Software Foundation (ASF) under one
3             # or more contributor license agreements. See the NOTICE file
4             # distributed with this work for additional information
5             # regarding copyright ownership. The ASF licenses this file
6             # to you under the Apache License, Version 2.0 (the
7             # "License"); you may not use this file except in compliance
8             # with the License. You may obtain a copy of the License at
9             #
10             # http://www.apache.org/licenses/LICENSE-2.0
11             #
12             # Unless required by applicable law or agreed to in writing,
13             # software distributed under the License is distributed on an
14             # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15             # KIND, either express or implied. See the License for the
16             # specific language governing permissions and limitations
17             # under the License.
18             #
19              
20 3     3   36 use 5.10.0;
  3         9  
21 3     3   15 use strict;
  3         5  
  3         58  
22 3     3   14 use warnings;
  3         5  
  3         90  
23              
24 3     3   16 use Thrift;
  3         6  
  3         72  
25 3     3   26 use Thrift::Exception;
  3         6  
  3         78  
26 3     3   15 use Thrift::Type;
  3         6  
  3         110  
27              
28             #
29             # Protocol exceptions
30             #
31             package Thrift::TProtocolException;
32 3     3   18 use base('Thrift::TException');
  3         12  
  3         1282  
33 3     3   21 use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
  3         45  
  3         16  
34              
35 3     3   305 use constant UNKNOWN => 0;
  3         15  
  3         161  
36 3     3   26 use constant INVALID_DATA => 1;
  3         36  
  3         159  
37 3     3   18 use constant NEGATIVE_SIZE => 2;
  3         5  
  3         159  
38 3     3   18 use constant SIZE_LIMIT => 3;
  3         6  
  3         164  
39 3     3   17 use constant BAD_VERSION => 4;
  3         4  
  3         135  
40 3     3   18 use constant NOT_IMPLEMENTED => 5;
  3         5  
  3         128  
41 3     3   16 use constant DEPTH_LIMIT => 6;
  3         12  
  3         301  
42              
43             sub new {
44 0     0   0 my $classname = shift;
45              
46 0         0 my $self = $classname->SUPER::new();
47              
48 0         0 return bless($self,$classname);
49             }
50              
51             #
52             # Protocol base class module.
53             #
54             package Thrift::Protocol;
55 3     3   20 use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
  3         39  
  3         16  
56              
57             sub new {
58 21     21 0 37 my $classname = shift;
59 21         35 my $self = {};
60              
61 21         34 my $trans = shift;
62 21         41 $self->{trans}= $trans;
63              
64 21         49 return bless($self,$classname);
65             }
66              
67             sub getTransport
68             {
69 39     39 0 51 my $self = shift;
70              
71 39         98 return $self->{trans};
72             }
73              
74             #
75             # Writes the message header
76             #
77             # @param string $name Function name
78             # @param int $type message type TMessageType::CALL or TMessageType::REPLY
79             # @param int $seqid The sequence id of this message
80             #
81             sub writeMessageBegin
82             {
83 0     0 0 0 my ($name, $type, $seqid);
84 0         0 die 'abstract';
85             }
86              
87             #
88             # Close the message
89             #
90             sub writeMessageEnd {
91 0     0 0 0 die 'abstract';
92             }
93              
94             #
95             # Writes a struct header.
96             #
97             # @param string $name Struct name
98             # @throws TProtocolException on write error
99             # @return int How many bytes written
100             #
101             sub writeStructBegin {
102 0     0 0 0 my ($name);
103              
104 0         0 die 'abstract';
105             }
106              
107             #
108             # Close a struct.
109             #
110             # @throws TProtocolException on write error
111             # @return int How many bytes written
112             #
113             sub writeStructEnd {
114 0     0 0 0 die 'abstract';
115             }
116              
117             #
118             # Starts a field.
119             #
120             # @param string $name Field name
121             # @param int $type Field type
122             # @param int $fid Field id
123             # @throws TProtocolException on write error
124             # @return int How many bytes written
125             #
126             sub writeFieldBegin {
127 0     0 0 0 my ($fieldName, $fieldType, $fieldId);
128              
129 0         0 die 'abstract';
130             }
131              
132             sub writeFieldEnd {
133 0     0 0 0 die 'abstract';
134             }
135              
136             sub writeFieldStop {
137 0     0 0 0 die 'abstract';
138             }
139              
140             sub writeMapBegin {
141 0     0 0 0 my ($keyType, $valType, $size);
142              
143 0         0 die 'abstract';
144             }
145              
146             sub writeMapEnd {
147 0     0 0 0 die 'abstract';
148             }
149              
150             sub writeListBegin {
151 0     0 0 0 my ($elemType, $size);
152 0         0 die 'abstract';
153             }
154              
155             sub writeListEnd {
156 0     0 0 0 die 'abstract';
157             }
158              
159             sub writeSetBegin {
160 0     0 0 0 my ($elemType, $size);
161 0         0 die 'abstract';
162             }
163              
164             sub writeSetEnd {
165 0     0 0 0 die 'abstract';
166             }
167              
168             sub writeBool {
169 0     0 0 0 my ($bool);
170 0         0 die 'abstract';
171             }
172              
173             sub writeByte {
174 0     0 0 0 my ($byte);
175 0         0 die 'abstract';
176             }
177              
178             sub writeI16 {
179 0     0 0 0 my ($i16);
180 0         0 die 'abstract';
181             }
182              
183             sub writeI32 {
184 0     0 0 0 my ($i32);
185 0         0 die 'abstract';
186             }
187              
188             sub writeI64 {
189 0     0 0 0 my ($i64);
190 0         0 die 'abstract';
191             }
192              
193             sub writeDouble {
194 0     0 0 0 my ($dub);
195 0         0 die 'abstract';
196             }
197              
198             sub writeString
199             {
200 0     0 0 0 my ($str);
201 0         0 die 'abstract';
202             }
203              
204             #
205             # Reads the message header
206             #
207             # @param string $name Function name
208             # @param int $type message type TMessageType::CALL or TMessageType::REPLY
209             # @parem int $seqid The sequence id of this message
210             #
211             sub readMessageBegin
212             {
213 0     0 0 0 my ($name, $type, $seqid);
214 0         0 die 'abstract';
215             }
216              
217             #
218             # Read the close of message
219             #
220             sub readMessageEnd
221             {
222 0     0 0 0 die 'abstract';
223             }
224              
225             sub readStructBegin
226             {
227 0     0 0 0 my($name);
228              
229 0         0 die 'abstract';
230             }
231              
232             sub readStructEnd
233             {
234 0     0 0 0 die 'abstract';
235             }
236              
237             sub readFieldBegin
238             {
239 0     0 0 0 my ($name, $fieldType, $fieldId);
240 0         0 die 'abstract';
241             }
242              
243             sub readFieldEnd
244             {
245 0     0 0 0 die 'abstract';
246             }
247              
248             sub readMapBegin
249             {
250 0     0 0 0 my ($keyType, $valType, $size);
251 0         0 die 'abstract';
252             }
253              
254             sub readMapEnd
255             {
256 0     0 0 0 die 'abstract';
257             }
258              
259             sub readListBegin
260             {
261 0     0 0 0 my ($elemType, $size);
262 0         0 die 'abstract';
263             }
264              
265             sub readListEnd
266             {
267 0     0 0 0 die 'abstract';
268             }
269              
270             sub readSetBegin
271             {
272 0     0 0 0 my ($elemType, $size);
273 0         0 die 'abstract';
274             }
275              
276             sub readSetEnd
277             {
278 0     0 0 0 die 'abstract';
279             }
280              
281             sub readBool
282             {
283 0     0 0 0 my ($bool);
284 0         0 die 'abstract';
285             }
286              
287             sub readByte
288             {
289 0     0 0 0 my ($byte);
290 0         0 die 'abstract';
291             }
292              
293             sub readI16
294             {
295 0     0 0 0 my ($i16);
296 0         0 die 'abstract';
297             }
298              
299             sub readI32
300             {
301 0     0 0 0 my ($i32);
302 0         0 die 'abstract';
303             }
304              
305             sub readI64
306             {
307 0     0 0 0 my ($i64);
308 0         0 die 'abstract';
309             }
310              
311             sub readDouble
312             {
313 0     0 0 0 my ($dub);
314 0         0 die 'abstract';
315             }
316              
317             sub readString
318             {
319 0     0 0 0 my ($str);
320 0         0 die 'abstract';
321             }
322              
323             #
324             # The skip function is a utility to parse over unrecognized data without
325             # causing corruption.
326             #
327             # @param TType $type What type is it
328             #
329             sub skip
330             {
331 0     0 0 0 my $self = shift;
332 0         0 my $type = shift;
333              
334 0         0 my $ref;
335             my $result;
336 0         0 my $i;
337              
338 0 0       0 if($type == Thrift::TType::BOOL)
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
339             {
340 0         0 return $self->readBool(\$ref);
341             }
342             elsif($type == Thrift::TType::BYTE){
343 0         0 return $self->readByte(\$ref);
344             }
345             elsif($type == Thrift::TType::I16){
346 0         0 return $self->readI16(\$ref);
347             }
348             elsif($type == Thrift::TType::I32){
349 0         0 return $self->readI32(\$ref);
350             }
351             elsif($type == Thrift::TType::I64){
352 0         0 return $self->readI64(\$ref);
353             }
354             elsif($type == Thrift::TType::DOUBLE){
355 0         0 return $self->readDouble(\$ref);
356             }
357             elsif($type == Thrift::TType::STRING)
358             {
359 0         0 return $self->readString(\$ref);
360             }
361             elsif($type == Thrift::TType::STRUCT)
362             {
363 0         0 $result = $self->readStructBegin(\$ref);
364 0         0 while (1) {
365 0         0 my ($ftype,$fid);
366 0         0 $result += $self->readFieldBegin(\$ref, \$ftype, \$fid);
367 0 0       0 if ($ftype == Thrift::TType::STOP) {
368 0         0 last;
369             }
370 0         0 $result += $self->skip($ftype);
371 0         0 $result += $self->readFieldEnd();
372             }
373 0         0 $result += $self->readStructEnd();
374 0         0 return $result;
375             }
376             elsif($type == Thrift::TType::MAP)
377             {
378 0         0 my($keyType,$valType,$size);
379 0         0 $result = $self->readMapBegin(\$keyType, \$valType, \$size);
380 0         0 for ($i = 0; $i < $size; $i++) {
381 0         0 $result += $self->skip($keyType);
382 0         0 $result += $self->skip($valType);
383             }
384 0         0 $result += $self->readMapEnd();
385 0         0 return $result;
386             }
387             elsif($type == Thrift::TType::SET)
388             {
389 0         0 my ($elemType,$size);
390 0         0 $result = $self->readSetBegin(\$elemType, \$size);
391 0         0 for ($i = 0; $i < $size; $i++) {
392 0         0 $result += $self->skip($elemType);
393             }
394 0         0 $result += $self->readSetEnd();
395 0         0 return $result;
396             }
397             elsif($type == Thrift::TType::LIST)
398             {
399 0         0 my ($elemType,$size);
400 0         0 $result = $self->readListBegin(\$elemType, \$size);
401 0         0 for ($i = 0; $i < $size; $i++) {
402 0         0 $result += $self->skip($elemType);
403             }
404 0         0 $result += $self->readListEnd();
405 0         0 return $result;
406             }
407              
408 0         0 die Thrift::TProtocolException->new("Type $type not recognized --- corrupt data?",
409             Thrift::TProtocolException::INVALID_DATA);
410              
411             }
412              
413             #
414             # Utility for skipping binary data
415             #
416             # @param TTransport $itrans TTransport object
417             # @param int $type Field type
418             #
419             sub skipBinary
420             {
421 0     0 0 0 my $self = shift;
422 0         0 my $itrans = shift;
423 0         0 my $type = shift;
424              
425 0 0 0     0 if($type == Thrift::TType::BOOL)
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
426             {
427 0         0 return $itrans->readAll(1);
428             }
429             elsif($type == Thrift::TType::BYTE)
430             {
431 0         0 return $itrans->readAll(1);
432             }
433             elsif($type == Thrift::TType::I16)
434             {
435 0         0 return $itrans->readAll(2);
436             }
437             elsif($type == Thrift::TType::I32)
438             {
439 0         0 return $itrans->readAll(4);
440             }
441             elsif($type == Thrift::TType::I64)
442             {
443 0         0 return $itrans->readAll(8);
444             }
445             elsif($type == Thrift::TType::DOUBLE)
446             {
447 0         0 return $itrans->readAll(8);
448             }
449             elsif( $type == Thrift::TType::STRING )
450             {
451 0         0 my @len = unpack('N', $itrans->readAll(4));
452 0         0 my $len = $len[0];
453 0 0       0 if ($len > 0x7fffffff) {
454 0         0 $len = 0 - (($len - 1) ^ 0xffffffff);
455             }
456 0         0 return 4 + $itrans->readAll($len);
457             }
458             elsif( $type == Thrift::TType::STRUCT )
459             {
460 0         0 my $result = 0;
461 0         0 while (1) {
462 0         0 my $ftype = 0;
463 0         0 my $fid = 0;
464 0         0 my $data = $itrans->readAll(1);
465 0         0 my @arr = unpack('c', $data);
466 0         0 $ftype = $arr[0];
467 0 0       0 if ($ftype == Thrift::TType::STOP) {
468 0         0 last;
469             }
470             # I16 field id
471 0         0 $result += $itrans->readAll(2);
472 0         0 $result += $self->skipBinary($itrans, $ftype);
473             }
474 0         0 return $result;
475             }
476             elsif($type == Thrift::TType::MAP)
477             {
478             # Ktype
479 0         0 my $data = $itrans->readAll(1);
480 0         0 my @arr = unpack('c', $data);
481 0         0 my $ktype = $arr[0];
482             # Vtype
483 0         0 $data = $itrans->readAll(1);
484 0         0 @arr = unpack('c', $data);
485 0         0 my $vtype = $arr[0];
486             # Size
487 0         0 $data = $itrans->readAll(4);
488 0         0 @arr = unpack('N', $data);
489 0         0 my $size = $arr[0];
490 0 0       0 if ($size > 0x7fffffff) {
491 0         0 $size = 0 - (($size - 1) ^ 0xffffffff);
492             }
493 0         0 my $result = 6;
494 0         0 for (my $i = 0; $i < $size; $i++) {
495 0         0 $result += $self->skipBinary($itrans, $ktype);
496 0         0 $result += $self->skipBinary($itrans, $vtype);
497             }
498 0         0 return $result;
499             }
500             elsif($type == Thrift::TType::SET || $type == Thrift::TType::LIST)
501             {
502             # Vtype
503 0         0 my $data = $itrans->readAll(1);
504 0         0 my @arr = unpack('c', $data);
505 0         0 my $vtype = $arr[0];
506             # Size
507 0         0 $data = $itrans->readAll(4);
508 0         0 @arr = unpack('N', $data);
509 0         0 my $size = $arr[0];
510 0 0       0 if ($size > 0x7fffffff) {
511 0         0 $size = 0 - (($size - 1) ^ 0xffffffff);
512             }
513 0         0 my $result = 5;
514 0         0 for (my $i = 0; $i < $size; $i++) {
515 0         0 $result += $self->skipBinary($itrans, $vtype);
516             }
517 0         0 return $result;
518             }
519              
520 0         0 die Thrift::TProtocolException->new("Type $type not recognized --- corrupt data?",
521             Thrift::TProtocolException::INVALID_DATA);
522             }
523              
524             #
525             # Protocol factory creates protocol objects from transports
526             #
527             package Thrift::TProtocolFactory;
528 3     3   5795 use version 0.77; our $VERSION = version->declare("$Thrift::VERSION");
  3         54  
  3         19  
529              
530             sub new {
531 2     2   7 my $classname = shift;
532 2         6 my $self = {};
533              
534 2         5 return bless($self,$classname);
535             }
536              
537             #
538             # Build a protocol from the base transport
539             #
540             # @return TProtcol protocol
541             #
542             sub getProtocol
543             {
544 0     0     my ($trans);
545 0           die 'interface';
546             }
547              
548              
549             1;