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