[ Index ] |
PHP Cross Reference of Unnamed Project |
[Summary view] [Print] [Text view]
1 package IO::Compress::Zlib::Extra; 2 3 require 5.004 ; 4 5 use strict ; 6 use warnings; 7 use bytes; 8 9 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); 10 11 $VERSION = '2.008'; 12 13 use IO::Compress::Gzip::Constants 2.008 ; 14 15 sub ExtraFieldError 16 { 17 return $_[0]; 18 return "Error with ExtraField Parameter: $_[0]" ; 19 } 20 21 sub validateExtraFieldPair 22 { 23 my $pair = shift ; 24 my $strict = shift; 25 my $gzipMode = shift ; 26 27 return ExtraFieldError("Not an array ref") 28 unless ref $pair && ref $pair eq 'ARRAY'; 29 30 return ExtraFieldError("SubField must have two parts") 31 unless @$pair == 2 ; 32 33 return ExtraFieldError("SubField ID is a reference") 34 if ref $pair->[0] ; 35 36 return ExtraFieldError("SubField Data is a reference") 37 if ref $pair->[1] ; 38 39 # ID is exactly two chars 40 return ExtraFieldError("SubField ID not two chars long") 41 unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ; 42 43 # Check that the 2nd byte of the ID isn't 0 44 return ExtraFieldError("SubField ID 2nd byte is 0x00") 45 if $strict && $gzipMode && substr($pair->[0], 1, 1) eq "\x00" ; 46 47 return ExtraFieldError("SubField Data too long") 48 if length $pair->[1] > GZIP_FEXTRA_SUBFIELD_MAX_SIZE ; 49 50 51 return undef ; 52 } 53 54 sub parseRawExtra 55 { 56 my $data = shift ; 57 my $extraRef = shift; 58 my $strict = shift; 59 my $gzipMode = shift ; 60 61 #my $lax = shift ; 62 63 #return undef 64 # if $lax ; 65 66 my $XLEN = length $data ; 67 68 return ExtraFieldError("Too Large") 69 if $XLEN > GZIP_FEXTRA_MAX_SIZE; 70 71 my $offset = 0 ; 72 while ($offset < $XLEN) { 73 74 return ExtraFieldError("Truncated in FEXTRA Body Section") 75 if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; 76 77 my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); 78 $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; 79 80 my $subLen = unpack("v", substr($data, $offset, 81 GZIP_FEXTRA_SUBFIELD_LEN_SIZE)); 82 $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ; 83 84 return ExtraFieldError("Truncated in FEXTRA Body Section") 85 if $offset + $subLen > $XLEN ; 86 87 my $bad = validateExtraFieldPair( [$id, 88 substr($data, $offset, $subLen)], 89 $strict, $gzipMode ); 90 return $bad if $bad ; 91 push @$extraRef, [$id => substr($data, $offset, $subLen)] 92 if defined $extraRef;; 93 94 $offset += $subLen ; 95 } 96 97 98 return undef ; 99 } 100 101 102 sub mkSubField 103 { 104 my $id = shift ; 105 my $data = shift ; 106 107 return $id . pack("v", length $data) . $data ; 108 } 109 110 sub parseExtraField 111 { 112 my $dataRef = $_[0]; 113 my $strict = $_[1]; 114 my $gzipMode = $_[2]; 115 #my $lax = @_ == 2 ? $_[1] : 1; 116 117 118 # ExtraField can be any of 119 # 120 # -ExtraField => $data 121 # 122 # -ExtraField => [$id1, $data1, 123 # $id2, $data2] 124 # ... 125 # ] 126 # 127 # -ExtraField => [ [$id1 => $data1], 128 # [$id2 => $data2], 129 # ... 130 # ] 131 # 132 # -ExtraField => { $id1 => $data1, 133 # $id2 => $data2, 134 # ... 135 # } 136 137 if ( ! ref $dataRef ) { 138 139 return undef 140 if ! $strict; 141 142 return parseRawExtra($dataRef, undef, 1, $gzipMode); 143 } 144 145 #my $data = $$dataRef; 146 my $data = $dataRef; 147 my $out = '' ; 148 149 if (ref $data eq 'ARRAY') { 150 if (ref $data->[0]) { 151 152 foreach my $pair (@$data) { 153 return ExtraFieldError("Not list of lists") 154 unless ref $pair eq 'ARRAY' ; 155 156 my $bad = validateExtraFieldPair($pair, $strict, $gzipMode) ; 157 return $bad if $bad ; 158 159 $out .= mkSubField(@$pair); 160 } 161 } 162 else { 163 return ExtraFieldError("Not even number of elements") 164 unless @$data % 2 == 0; 165 166 for (my $ix = 0; $ix <= length(@$data) -1 ; $ix += 2) { 167 my $bad = validateExtraFieldPair([$data->[$ix], 168 $data->[$ix+1]], 169 $strict, $gzipMode) ; 170 return $bad if $bad ; 171 172 $out .= mkSubField($data->[$ix], $data->[$ix+1]); 173 } 174 } 175 } 176 elsif (ref $data eq 'HASH') { 177 while (my ($id, $info) = each %$data) { 178 my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode); 179 return $bad if $bad ; 180 181 $out .= mkSubField($id, $info); 182 } 183 } 184 else { 185 return ExtraFieldError("Not a scalar, array ref or hash ref") ; 186 } 187 188 return ExtraFieldError("Too Large") 189 if length $out > GZIP_FEXTRA_MAX_SIZE; 190 191 $_[0] = $out ; 192 193 return undef; 194 } 195 196 1; 197 198 __END__
title
Description
Body
title
Description
Body
title
Description
Body
title
Body
Generated: Tue Mar 17 22:47:18 2015 | Cross-referenced by PHPXref 0.7.1 |