File Coverage

blib/lib/AMF/Perl/IO/InputStream.pm
Criterion Covered Total %
statement 3 71 4.2
branch 0 26 0.0
condition n/a
subroutine 1 8 12.5
pod 3 7 42.8
total 7 112 6.2


line stmt bran cond sub pod time code
1             package AMF::Perl::IO::InputStream;
2             # Copyright (c) 2003 by Vsevolod (Simon) Ilyushchenko. All rights reserved.
3             # This program is free software; you can redistribute it and/or modify it
4             # under the same terms as Perl itself.
5             # The code is based on the -PHP project (http://amfphp.sourceforge.net/)
6              
7              
8             =head1 NAME
9              
10             AMF::Perl::IO::InputStream
11              
12             =head1 DESCRIPTION
13              
14             InputStream package built to handle getting the binary data from the raw input stream.
15              
16             =head1 CHANGES
17              
18             =head2 Sun Sep 19 13:01:35 EDT 2004
19             =item Patch from Kostas Chatzikokolakis about error checking of input data length.
20              
21             =head2 Tue Jun 22 19:28:30 EDT 2004
22             =item Improved the check in readDouble to append "0" to the string instead of skipping
23             the value. Otherwise the number 16 did not go through.
24             =item Added defined($thisByte) in readInt, otherwise the character "0" (say, in string length of 30)
25             did not go through.
26              
27             =head2 Sat Mar 13 16:39:29 EST 2004
28              
29             =item Changed calls to ord() in readByte() and concatenation readDouble()
30             to prevent the appearance of the "uninitialized" warning.
31              
32             =head2 Sun May 11 16:41:52 EDT 2003
33              
34             =item Rewrote readInt to get rid of the "uninitialized" warning when reading bytes of value 0.
35              
36             =head2 Sun Jul 11 18:45:40 EDT 2004
37              
38             =item Added the check for endianness.
39              
40              
41             =cut
42              
43 1     1   9 use strict;
  1         2  
  1         953  
44              
45             #InputStream constructor
46             sub new
47             {
48 0     0 0   my ($proto, $rd )=@_;
49 0           my $self={};
50 0           bless $self, $proto;
51 0           $self->{current_byte}=0;
52             # store the stream in this object
53 0           my @array = split //, $rd;
54 0           $self->{raw_data} = \@array;
55             # grab the total length of this stream
56 0           $self->{content_length} = @{$self->{raw_data}};
  0            
57 0 0         if (unpack("h*", pack("s", 1)) =~ /01/)
58             {
59 0           $self->{byteorder} = 'big-endian';
60             }
61             else
62             {
63 0           $self->{byteorder} = 'little-endian';
64             }
65 0           return $self;
66             }
67              
68              
69             # returns a single byte value.
70             sub readByte
71             {
72 0     0 1   my ($self)=@_;
73             # boundary check
74 0 0         die "Malformed AMF data, cannot readByte\n"
75             if $self->{current_byte} > $self->{content_length} - 1;
76             # return the next byte
77 0           my $nextByte = $self->{raw_data}->[$self->{current_byte}];
78 0           my $result;
79 0 0         $result = ord($nextByte) if $nextByte;
80 0           $self->{current_byte} += 1;
81 0           return $result;
82             }
83              
84             # returns the value of 2 bytes
85             sub readInt
86             {
87 0     0 1   my ($self)=@_;
88              
89             # boundary check
90 0 0         die "Malformed AMF data, cannot readInt\n"
91             if $self->{current_byte} > $self->{content_length} - 2;
92              
93             # read the next 2 bytes, shift and add
94 0           my $thisByte = $self->{raw_data}->[$self->{current_byte}];
95 0           my $nextByte = $self->{raw_data}->[$self->{current_byte}+1];
96              
97 0 0         my $thisNum = defined($thisByte) ? ord($thisByte) : 0;
98 0 0         my $nextNum = defined($nextByte) ? ord($nextByte) : 0;
99              
100 0           my $result = (($thisNum) << 8) | $nextNum;
101              
102 0           $self->{current_byte} += 2;
103 0           return $result;
104             }
105              
106             # returns the value of 4 bytes
107             sub readLong
108             {
109 0     0 0   my ($self)=@_;
110            
111             # boundary check
112 0 0         die "Malformed AMF data, cannot readLong\n"
113             if $self->{current_byte} > $self->{content_length} - 4;
114              
115 0           my $byte1 = $self->{current_byte};
116 0           my $byte2 = $self->{current_byte}+1;
117 0           my $byte3 = $self->{current_byte}+2;
118 0           my $byte4 = $self->{current_byte}+3;
119             # read the next 4 bytes, shift and add
120 0           my $result = ((ord($self->{raw_data}->[$byte1]) << 24) |
121             (ord($self->{raw_data}->[$byte2]) << 16) |
122             (ord($self->{raw_data}->[$byte3]) << 8) |
123             ord($self->{raw_data}->[$byte4]));
124 0           $self->{current_byte} = $self->{current_byte} + 4;
125 0           return $result;
126             }
127              
128             sub readDouble
129             {
130 0     0 1   my ($self)=@_;
131             # boundary check
132 0 0         die "Malformed AMF data, cannot readDouble\n"
133             if $self->{current_byte} > $self->{content_length} - 8;
134             # container to store the reversed bytes
135 0           my $invertedBytes = "";
136 0 0         if ($self->{byteorder} eq 'little-endian')
137             {
138             # create a loop with a backwards index
139 0           for(my $i = 7 ; $i >= 0 ; $i--)
140             {
141             # grab the bytes in reverse order from the backwards index
142 0           my $nextByte = $self->{raw_data}->[$self->{current_byte}+$i];
143 0 0         $nextByte = "0" unless $nextByte;
144 0           $invertedBytes .= $nextByte;
145             }
146             }
147             else
148             {
149 0           for(my $i = 0 ; $i < 8 ; $i++)
150             {
151             # grab the bytes in forwards order
152 0           my $nextByte = $self->{raw_data}->[$self->{current_byte}+$i];
153 0 0         $nextByte = "0" unless $nextByte;
154 0           $invertedBytes .= $nextByte;
155             }
156             }
157             # move the seek head forward 8 bytes
158 0           $self->{current_byte} += 8;
159             # unpack the bytes
160 0           my @zz = unpack("d", $invertedBytes);
161             # return the number from the associative array
162 0           return $zz[0];
163             }
164              
165             # returns a UTF string
166             sub readUTF
167             {
168 0     0 0   my ($self) = @_;
169             # get the length of the string (1st 2 bytes)
170 0           my $length = $self->readInt();
171             # boundary check
172 0 0         die "Malformed AMF data, cannot readUTF\n"
173             if $self->{current_byte} > $self->{content_length} - $length;
174             # grab the string
175 0           my @slice = @{$self->{raw_data}}[$self->{current_byte}.. $self->{current_byte}+$length-1];
  0            
176 0           my $val = join "", @slice;
177             # move the seek head to the end of the string
178 0           $self->{current_byte} += $length;
179             # return the string
180 0           return $val;
181             }
182              
183             # returns a UTF string with a LONG representing the length
184             sub readLongUTF
185             {
186 0     0 0   my ($self) = @_;
187             # get the length of the string (1st 4 bytes)
188 0           my $length = $self->readLong();
189             # boundary check
190 0 0         die "Malformed AMF data, cannot readLongUTF\n"
191             if $self->{current_byte} > $self->{content_length} - $length;
192             # grab the string
193 0           my @slice = @{$self->{raw_data}}[$self->{current_byte} .. $self->{current_byte}+$length-1];
  0            
194 0           my $val = join "", @slice;
195             # move the seek head to the end of the string
196 0           $self->{current_byte} += $length;
197             # return the string
198 0           return $val;
199             }
200              
201             1;