File Coverage

blib/lib/Stream/DataInputStream.pm
Criterion Covered Total %
statement 76 101 75.2
branch 23 58 39.6
condition 1 6 16.6
subroutine 13 17 76.4
pod 0 15 0.0
total 113 197 57.3


line stmt bran cond sub pod time code
1             #!/usr/local/bin/perl -w
2              
3             #
4             # Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/)
5             # All rights reserved.
6             #
7              
8             package Stream::DataInputStream;
9              
10             @DataInputStream::ISA = qw(Stream::DataInputStream);
11              
12             #
13             # DataInputStream
14             #
15             # Inherits from InputStream (read, skip & readAll)
16             #
17             # Implements DataInput (the read*, skip and readAll functions)
18             #
19             # Uses an InputStream for its input
20             #
21              
22              
23 1     1   9 use strict;
  1         2  
  1         32  
24 1     1   5 use Carp;
  1         2  
  1         1231  
25              
26             sub usage
27             {
28 0     0 0 0 my ($package, $filename, $line, $subr) = caller(1);
29 0         0 $Carp::CarpLevel = 2;
30 0         0 croak "Usage: $subr(@_)";
31             }
32              
33             sub new
34             {
35 4 50   4 0 36 usage unless @_ == 2;
36 4 50       8 usage("InputStream undefined") unless defined $_[1];
37              
38 4         6 my $type = shift; my $self = {}; bless $self, $type;
  4         5  
  4         7  
39              
40 4   33     17 $self->{'is'} = shift || croak("InputStream undefined");
41              
42 4         10 $self;
43             }
44              
45             sub read
46             {
47 4 50   4 0 41 usage("count") unless @_ == 2;
48              
49 4         5 my $self = shift;
50 4         5 my $count = shift;
51 4         5 my $is = $self->{'is'};
52              
53 4         22 $is->read($count);
54             }
55              
56             sub skip
57             {
58 0 0   0 0 0 usage("count") unless @_ == 2;
59              
60 0         0 my $self = shift;
61 0         0 my $count = shift;
62 0         0 my $is = $self->{'is'};
63              
64 0         0 $is->skip($count);
65             }
66              
67             sub readAll
68             {
69 0 0   0 0 0 usage unless @_ == 1;
70              
71 0         0 my $self = shift;
72 0         0 my $is = $self->{'is'};
73              
74 0         0 $is->readAll();
75             }
76              
77             sub eoi
78             {
79 1 50   1 0 4 usage unless @_ == 1;
80              
81 1         2 my $self = shift;
82 1         7 $self->{'is'}->eoi();
83             }
84              
85              
86             sub readByte
87             {
88 4 50   4 0 22 usage unless @_ == 1;
89              
90 4         6 my $self = shift;
91 4         5 my $is = $self->{'is'};
92              
93 4         9 my $c = $is->read(1);
94 4 50       16 return unless (defined($c));
95 4         13 unpack("C", $c);
96             }
97              
98             sub readInt16
99             {
100 4 50   4 0 21 usage unless @_ == 1;
101              
102 4         6 my $self = shift;
103 4         5 my $is = $self->{'is'};
104              
105 4         12 my $data = $is->read(2);
106 4 50       9 return unless (defined($data));
107 4         10 unpack("n", $data);
108             }
109              
110             sub readInt32
111             {
112 4 50   4 0 22 usage unless @_ == 1;
113              
114 4         6 my $self = shift;
115 4         6 my $is = $self->{'is'};
116              
117 4         16 my $data = $is->read(4);
118 4 50       9 return unless (defined($data));
119 4         12 unpack("N", $data);
120             }
121              
122             sub readFloat
123             {
124 4 50   4 0 23 usage unless @_ == 1;
125              
126 4         6 my $self = shift;
127 4         5 my $is = $self->{'is'};
128              
129 4         11 my $data = $is->read(4);
130 4 50       17 return unless (defined($data));
131 4         17 unpack("f", pack("l", unpack("N", $data)));
132             }
133              
134             sub readDouble
135             {
136 4 50   4 0 23 usage unless @_ == 1;
137              
138 4         5 my $self = shift;
139 4         5 my $is = $self->{'is'};
140              
141 4         11 my $data1 = $is->read(4);
142 4         10 my $data2 = $is->read(4);
143 4 50       17 return unless (defined($data1));
144 4 50       7 return unless (defined($data2));
145             # The following is machine dependent!
146 4         19 unpack("d", pack("l", unpack("N", $data2)) . pack("l", unpack("N", $data1)));
147             }
148              
149             sub readTime
150             {
151 4 50   4 0 22 usage unless @_ == 1;
152              
153 4         5 my $self = shift;
154 4         6 my $is = $self->{'is'};
155              
156 4         15 my $data = $is->read(4);
157 4 50       9 return unless (defined($data));
158 4         11 unpack("N", $data);
159             }
160              
161             sub readLength
162             {
163 20 50   20 0 69 usage unless @_ == 1;
164              
165 20         63 my $self = shift;
166 20         23 my $is = $self->{'is'};
167              
168 20         21 my $s = 0;
169 20         17 for(;;)
170             {
171 32         67 my $c = $is->read(1);
172 32 50       63 return unless (defined($c));
173 32         33 my $n = ord($c);
174 32         35 $s = ($s << 7) + (0x7F & $n);
175 32 100       59 last if ($n < 128); # Last octet
176             }
177 20         57 $s;
178             }
179              
180             sub readString
181             {
182 4 50   4 0 20 usage unless @_ == 1;
183              
184 4         8 my $self = shift;
185 4         20 my $is = $self->{'is'};
186              
187 4         11 my $len = $self->readLength();
188 4 50       10 return unless defined $len;
189 4         10 $is->read($len);
190             }
191              
192             sub readLine
193             {
194 0 0   0 0   usage unless @_ == 1;
195              
196 0           my $self = shift;
197 0           my $is = $self->{'is'};
198              
199 0 0         return if $is->eoi();
200              
201 0           my $r = '';
202 0           for (;;)
203             {
204 0           $_ = $is->read(1);
205 0 0         last unless (defined($_));
206 0 0         if (/\n/)
207             {
208 0 0 0       chop($r) if ((length($r) > 0) && (substr($r, -1, 1) eq '\r'));
209 0           last;
210             }
211 0           $r .= $_;
212             }
213 0           $r;
214             }
215              
216             1;