1package Data::ParseBinary::Stream::Reader;
2use strict;
3use warnings;
4
5sub _readBitsForByteStream {
6    my ($self, $bitcount) = @_;
7    my $count = int($bitcount / 8) + ($bitcount % 8 ? 1 : 0);
8    my $data = $self->ReadBytes($count);
9    my $fullbits = unpack "B*", $data;
10    my $string = substr($fullbits, -$bitcount);
11    return $string;
12}
13
14sub _readBytesForBitStream {
15    my ($self, $count) = @_;
16    my $bitData = $self->ReadBits($count * 8);
17    my $data = pack "B*", $bitData;
18    return $data;
19}
20
21sub isBitStream { die "unimplemented" }
22sub ReadBytes { die "unimplemented" }
23sub ReadBits { die "unimplemented" }
24sub seek { die "unimplemented" }
25sub tell { die "unimplemented" }
26
27our %_streamTypes;
28
29sub _registerStreamType {
30    my ($class, $typeName) = @_;
31    $_streamTypes{$typeName} = $class;
32}
33
34sub CreateStreamReader {
35    my @params = @_;
36    if (@params == 0) {
37        die "CreateStreamReader: mush have a parameter";
38    }
39    if (@params == 1) {
40        my $source = $params[0];
41        if (not defined $source or not ref $source) {
42            # some value (string?). let's feed it to StringStreamWriter
43            return $_streamTypes{String}->new($source);
44        }
45        if (UNIVERSAL::isa($source, "Data::ParseBinary::Stream::Reader")) {
46            return $source;
47        }
48        die "Got unknown input to CreateStreamReader";
49    }
50
51    # @params > 1
52    my $source = pop @params;
53    while (@params) {
54		my $opts = undef;
55        my $type = pop @params;
56		if ( defined( ref $type ) and @params and ( $params[-1] eq ' Opts' ) ) {
57			$opts = $type;
58			$type = pop @params;
59		}
60        if (not exists $_streamTypes{$type}) {
61            die "CreateStreamReader: Unrecognized type: $type";
62        }
63        $source = $_streamTypes{$type}->new($source, $opts);
64    }
65    return $source;
66}
67
68sub DESTROY {
69    my $self = shift;
70    if ($self->can("disconnect")) {
71        $self->disconnect();
72    }
73}
74
75package Data::ParseBinary::Stream::Writer;
76
77sub WriteBytes { die "unimplemented" }
78sub WriteBits { die "unimplemented" }
79sub Flush { die "unimplemented" }
80sub isBitStream { die "unimplemented" }
81sub seek { die "unimplemented" }
82sub tell { die "unimplemented" }
83
84sub _writeBitsForByteStream {
85    my ($self, $bitdata) = @_;
86    my $data_len = length($bitdata);
87    my $zeros_to_add = (-$data_len) % 8;
88    my $binary = pack "B".($zeros_to_add + $data_len), ('0'x$zeros_to_add).$bitdata;
89    return $self->WriteBytes($binary);
90}
91
92sub _writeBytesForBitStream {
93    my ($self, $data) = @_;
94    my $bitdata = unpack "B*", $data;
95    return $self->WriteBits($bitdata);
96}
97
98our %_streamTypes;
99
100sub _registerStreamType {
101    my ($class, $typeName) = @_;
102    $_streamTypes{$typeName} = $class;
103}
104
105sub CreateStreamWriter {
106    my @params = @_;
107    if (@params == 0) {
108        return $_streamTypes{String}->new();
109    }
110    if (@params == 1) {
111        my $source = $params[0];
112        if (not defined $source or not ref $source) {
113            # some value (string?). let's feed it to StringStreamWriter
114            return $_streamTypes{String}->new($source);
115        }
116        if (UNIVERSAL::isa($source, "Data::ParseBinary::Stream::Writer")) {
117            return $source;
118        }
119        die "Got unknown input to CreateStreamWriter";
120    }
121
122    # @params > 1
123    my $source = pop @params;
124    while (@params) {
125        my $type = pop @params;
126        if (not exists $_streamTypes{$type}) {
127            die "CreateStreamWriter: Unrecognized type: $type";
128        }
129        $source = $_streamTypes{$type}->new($source);
130    }
131    return $source;
132}
133
134sub DESTROY {
135    my $self = shift;
136    $self->Flush();
137    if ($self->can("disconnect")) {
138        $self->disconnect();
139    }
140}
141
142package Data::ParseBinary::Stream::WrapperBase;
143# this is a nixin class for streams that will warp other streams
144
145sub _warping {
146    my ($self, $sub_stream) = @_;
147    if ($sub_stream->{is_warped}) {
148        die "Wrapping Stream " . ref($self) . ": substream is already wraped!";
149    }
150    $self->{ss} = $sub_stream;
151    $sub_stream->{is_wraped} = 1;
152}
153
154sub ss {
155    my $self = shift;
156    return $self->{ss};
157}
158
159sub disconnect {
160    my ($self) = @_;
161    $self->{ss}->{is_wraped} = 0;
162    $self->{ss} = undef;
163}
164
1651;