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;