ext/Compress/Zlib/lib/IO/Uncompress/AnyUncompress.pm

   1 package IO::Uncompress::AnyUncompress ;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Compress::Zlib::Common qw(createSelfTiedObject);
   7
   8 #use IO::Uncompress::Base ;
   9 use IO::Uncompress::Gunzip ;
  10 use IO::Uncompress::Inflate ;
  11 use IO::Uncompress::RawInflate ;
  12 use IO::Uncompress::Unzip ;
  13
  14 BEGIN
  15 {
  16    eval { require UncompressPlugin::Bunzip2; import UncompressPlugin::Bunzip2 };
  17    eval { require UncompressPlugin::LZO;     import UncompressPlugin::LZO     };
  18    eval { require IO::Uncompress::Bunzip2;   import IO::Uncompress::Bunzip2 };
  19    eval { require IO::Uncompress::UnLzop;    import IO::Uncompress::UnLzop };
  20 }
  21
  22 require Exporter ;
  23
  24 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError);
  25
  26 $VERSION = '2.000_05';
  27 $AnyUncompressError = '';
  28
  29 @ISA = qw( Exporter IO::Uncompress::Base );
  30 @EXPORT_OK = qw( $AnyUncompressError anyuncompress ) ;
  31 %EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ;
  32 push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
  33 Exporter::export_ok_tags('all');
  34
  35 # TODO - allow the user to pick a set of the three formats to allow
  36 #        or just assume want to auto-detect any of the three formats.
  37
  38 sub new
  39 {
  40     my $class = shift ;
  41     my $obj = createSelfTiedObject($class, \$AnyUncompressError);
  42     $obj->_create(undef, 0, @_);
  43 }
  44
  45 sub anyuncompress
  46 {
  47     my $obj = createSelfTiedObject(undef, \$AnyUncompressError);
  48     return $obj->_inf(@_) ;
  49 }
  50
  51 sub getExtraParams
  52 {
  53     return ();
  54 }
  55
  56 sub ckParams
  57 {
  58     my $self = shift ;
  59     my $got = shift ;
  60
  61     # any always needs both crc32 and adler32
  62     $got->value('CRC32' => 1);
  63     $got->value('ADLER32' => 1);
  64
  65     return 1;
  66 }
  67
  68 sub mkUncomp
  69 {
  70     my $self = shift ;
  71     my $class = shift ;
  72     my $got = shift ;
  73
  74     # try zlib first
  75     my ($obj, $errstr, $errno) = UncompressPlugin::Inflate::mkUncompObject();
  76
  77     return $self->saveErrorString(undef, $errstr, $errno)
  78         if ! defined $obj;
  79
  80     *$self->{Uncomp} = $obj;
  81
  82      my $magic = $self->ckMagic( qw( RawInflate Inflate Gunzip Unzip ) );
  83
  84      if ($magic) {
  85         *$self->{Info} = $self->readHeader($magic)
  86             or return undef ;
  87
  88         return 1;
  89      }
  90
  91      #foreach my $type ( qw( Bunzip2 UnLzop ) ) {
  92      if (defined $IO::Uncompress::Bunzip2::VERSION and
  93          $magic = $self->ckMagic('Bunzip2')) {
  94         *$self->{Info} = $self->readHeader($magic)
  95             or return undef ;
  96
  97         my ($obj, $errstr, $errno) = UncompressPlugin::Bunzip2::mkUncompObject();
  98
  99         return $self->saveErrorString(undef, $errstr, $errno)
 100             if ! defined $obj;
 101
 102         *$self->{Uncomp} = $obj;
 103
 104          return 1;
 105      }
 106      elsif (defined $IO::Uncompress::UnLzop::VERSION and
 107             $magic = $self->ckMagic('UnLzop')) {
 108
 109         *$self->{Info} = $self->readHeader($magic)
 110             or return undef ;
 111
 112         my ($obj, $errstr, $errno) = UncompressPlugin::LZO::mkUncompObject();
 113
 114         return $self->saveErrorString(undef, $errstr, $errno)
 115             if ! defined $obj;
 116
 117         *$self->{Uncomp} = $obj;
 118
 119          return 1;
 120      }
 121
 122      return 0 ;
 123 }
 124
 125
 126
 127 sub ckMagic
 128 {
 129     my $self = shift;
 130     my @names = @_ ;
 131
 132     my $keep = ref $self ;
 133     for my $class ( map { "IO::Uncompress::$_" } @names)
 134     {
 135         bless $self => $class;
 136         my $magic = $self->ckMagic();
 137
 138         if ($magic)
 139         {
 140             #bless $self => $class;
 141             return $magic ;
 142         }
 143
 144         $self->pushBack(*$self->{HeaderPending})  ;
 145         *$self->{HeaderPending} = ''  ;
 146     }
 147
 148     bless $self => $keep;
 149     return undef;
 150 }
 151
 152 1 ;
 153
 154 __END__
 155
 156