[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__