"Fossies" - the Fresh Open Source Software Archive

Member "IO-Compress-2.093/lib/IO/Compress/Adapter/Deflate.pm" (7 Dec 2019, 3144 Bytes) of package /linux/privat/IO-Compress-2.093.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Deflate.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.092_vs_2.093.

    1 package IO::Compress::Adapter::Deflate ;
    2 
    3 use strict;
    4 use warnings;
    5 use bytes;
    6 
    7 use IO::Compress::Base::Common 2.093 qw(:Status);
    8 use Compress::Raw::Zlib  2.093 qw( !crc32 !adler32 ) ;
    9                                   
   10 require Exporter;                                     
   11 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS);
   12 
   13 $VERSION = '2.093';
   14 @ISA = qw(Exporter);
   15 @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS;
   16 %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS;
   17 @EXPORT = @EXPORT_OK;
   18 %DEFLATE_CONSTANTS = %EXPORT_TAGS ;
   19 
   20 sub mkCompObject
   21 {
   22     my $crc32    = shift ;
   23     my $adler32  = shift ;
   24     my $level    = shift ;
   25     my $strategy = shift ;
   26 
   27     my ($def, $status) = new Compress::Raw::Zlib::Deflate
   28                                 -AppendOutput   => 1,
   29                                 -CRC32          => $crc32,
   30                                 -ADLER32        => $adler32,
   31                                 -Level          => $level,
   32                                 -Strategy       => $strategy,
   33                                 -WindowBits     => - MAX_WBITS;
   34 
   35     return (undef, "Cannot create Deflate object: $status", $status) 
   36         if $status != Z_OK;    
   37 
   38     return bless {'Def'        => $def,
   39                   'Error'      => '',
   40                  } ;     
   41 }
   42 
   43 sub compr
   44 {
   45     my $self = shift ;
   46 
   47     my $def   = $self->{Def};
   48 
   49     my $status = $def->deflate($_[0], $_[1]) ;
   50     $self->{ErrorNo} = $status;
   51 
   52     if ($status != Z_OK)
   53     {
   54         $self->{Error} = "Deflate Error: $status"; 
   55         return STATUS_ERROR;
   56     }
   57 
   58     return STATUS_OK;    
   59 }
   60 
   61 sub flush
   62 {
   63     my $self = shift ;
   64 
   65     my $def   = $self->{Def};
   66 
   67     my $opt = $_[1] || Z_FINISH;
   68     my $status = $def->flush($_[0], $opt);
   69     $self->{ErrorNo} = $status;
   70 
   71     if ($status != Z_OK)
   72     {
   73         $self->{Error} = "Deflate Error: $status"; 
   74         return STATUS_ERROR;
   75     }
   76 
   77     return STATUS_OK;        
   78 }
   79 
   80 sub close
   81 {
   82     my $self = shift ;
   83 
   84     my $def   = $self->{Def};
   85 
   86     $def->flush($_[0], Z_FINISH)
   87         if defined $def ;
   88 }
   89 
   90 sub reset
   91 {
   92     my $self = shift ;
   93 
   94     my $def   = $self->{Def};
   95 
   96     my $status = $def->deflateReset() ;
   97     $self->{ErrorNo} = $status;
   98     if ($status != Z_OK)
   99     {
  100         $self->{Error} = "Deflate Error: $status"; 
  101         return STATUS_ERROR;
  102     }
  103 
  104     return STATUS_OK;    
  105 }
  106 
  107 sub deflateParams 
  108 {
  109     my $self = shift ;
  110 
  111     my $def   = $self->{Def};
  112 
  113     my $status = $def->deflateParams(@_);
  114     $self->{ErrorNo} = $status;
  115     if ($status != Z_OK)
  116     {
  117         $self->{Error} = "deflateParams Error: $status"; 
  118         return STATUS_ERROR;
  119     }
  120 
  121     return STATUS_OK;   
  122 }
  123 
  124 
  125 
  126 #sub total_out
  127 #{
  128 #    my $self = shift ;
  129 #    $self->{Def}->total_out();
  130 #}
  131 #
  132 #sub total_in
  133 #{
  134 #    my $self = shift ;
  135 #    $self->{Def}->total_in();
  136 #}
  137 
  138 sub compressedBytes
  139 {
  140     my $self = shift ;
  141 
  142     $self->{Def}->compressedBytes();
  143 }
  144 
  145 sub uncompressedBytes
  146 {
  147     my $self = shift ;
  148     $self->{Def}->uncompressedBytes();
  149 }
  150 
  151 
  152 
  153 
  154 sub crc32
  155 {
  156     my $self = shift ;
  157     $self->{Def}->crc32();
  158 }
  159 
  160 sub adler32
  161 {
  162     my $self = shift ;
  163     $self->{Def}->adler32();
  164 }
  165 
  166 
  167 1;
  168 
  169 __END__
  170