├── .appveyor.yml ├── .cirrus.yml ├── .github └── workflows │ ├── linux.yml │ ├── macos.yml │ └── windows.yml ├── .gitignore ├── .travis.yml ├── Changes ├── MANIFEST ├── META.json ├── META.yml ├── Makefile.PL ├── README ├── bin ├── streamzip └── zipdetails ├── bugs └── 12826 │ ├── mf.pl │ └── mf.zip ├── examples ├── compress-zlib │ ├── filtdef │ ├── filtinf │ ├── gzcat │ ├── gzgrep │ └── gzstream └── io │ ├── anycat │ ├── bzip2 │ ├── bzcat │ ├── bzgrep │ └── bzstream │ └── gzip │ ├── gzappend │ ├── gzcat │ ├── gzgrep │ └── gzstream ├── lib ├── Compress │ └── Zlib.pm ├── File │ └── GlobMapper.pm └── IO │ ├── Compress.pm │ ├── Compress │ ├── Adapter │ │ ├── Bzip2.pm │ │ ├── Deflate.pm │ │ └── Identity.pm │ ├── Base.pm │ ├── Base │ │ └── Common.pm │ ├── Bzip2.pm │ ├── Deflate.pm │ ├── FAQ.pod │ ├── Gzip.pm │ ├── Gzip │ │ └── Constants.pm │ ├── RawDeflate.pm │ ├── Zip.pm │ ├── Zip │ │ ├── Constants.pm │ │ └── WeakDecrypt.pm │ └── Zlib │ │ ├── Constants.pm │ │ └── Extra.pm │ └── Uncompress │ ├── Adapter │ ├── Bunzip2.pm │ ├── Identity.pm │ ├── Inflate.pm │ └── WeakDecrypt.pm │ ├── AnyInflate.pm │ ├── AnyUncompress.pm │ ├── Base.pm │ ├── Bunzip2.pm │ ├── Gunzip.pm │ ├── Inflate.pm │ ├── RawInflate.pm │ └── Unzip.pm ├── private └── MakeUtil.pm └── t ├── 000prereq.t ├── 001bzip2.t ├── 001zlib-generic-deflate.t ├── 001zlib-generic-gzip.t ├── 001zlib-generic-rawdeflate.t ├── 001zlib-generic-zip.t ├── 002any-deflate.t ├── 002any-gzip.t ├── 002any-rawdeflate.t ├── 002any-transparent.t ├── 002any-zip.t ├── 004gziphdr.t ├── 005defhdr.t ├── 006zip.t ├── 010examples-bzip2.t ├── 010examples-zlib.t ├── 011-streamzip.t ├── 01misc.t ├── 020isize.t ├── 050interop-gzip.t ├── 100generic-bzip2.t ├── 100generic-deflate.t ├── 100generic-gzip.t ├── 100generic-rawdeflate.t ├── 100generic-zip.t ├── 101truncate-bzip2.t ├── 101truncate-deflate.t ├── 101truncate-gzip.t ├── 101truncate-rawdeflate.t ├── 101truncate-zip.t ├── 102tied-bzip2.t ├── 102tied-deflate.t ├── 102tied-gzip.t ├── 102tied-rawdeflate.t ├── 102tied-zip.t ├── 103newtied-bzip2.t ├── 103newtied-deflate.t ├── 103newtied-gzip.t ├── 103newtied-rawdeflate.t ├── 103newtied-zip.t ├── 104destroy-bzip2.t ├── 104destroy-deflate.t ├── 104destroy-gzip.t ├── 104destroy-rawdeflate.t ├── 104destroy-zip.t ├── 105oneshot-bzip2.t ├── 105oneshot-deflate.t ├── 105oneshot-gzip-only.t ├── 105oneshot-gzip.t ├── 105oneshot-rawdeflate.t ├── 105oneshot-zip-bzip2-only.t ├── 105oneshot-zip-only.t ├── 105oneshot-zip-store-only.t ├── 105oneshot-zip.t ├── 106prime-bzip2.t ├── 106prime-deflate.t ├── 106prime-gzip.t ├── 106prime-rawdeflate.t ├── 106prime-zip.t ├── 107multi-bzip2.t ├── 107multi-deflate.t ├── 107multi-gzip.t ├── 107multi-rawdeflate.t ├── 107multi-zip-only.t ├── 107multi-zip.t ├── 108anyunc-bzip2.t ├── 108anyunc-deflate.t ├── 108anyunc-gzip.t ├── 108anyunc-rawdeflate.t ├── 108anyunc-transparent.t ├── 108anyunc-zip.t ├── 109merge-deflate.t ├── 109merge-gzip.t ├── 109merge-rawdeflate.t ├── 109merge-zip.t ├── 110encode-bzip2.t ├── 110encode-deflate.t ├── 110encode-gzip.t ├── 110encode-rawdeflate.t ├── 110encode-zip.t ├── 111const-deflate.t ├── 112utf8-zip.t ├── 113issues.t ├── 999meta-json.t ├── 999meta-yml.t ├── 999pod.t ├── Test ├── Builder.pm ├── More.pm └── Simple.pm ├── compress ├── CompTestUtils.pm ├── any.pl ├── anyunc.pl ├── destroy.pl ├── encode.pl ├── generic.pl ├── merge.pl ├── multi.pl ├── newtied.pl ├── oneshot.pl ├── prime.pl ├── tied.pl ├── truncate.pl └── zlib-generic.pl ├── cz-01version.t ├── cz-03zlib-v1.t ├── cz-05examples.t ├── cz-06gzsetp.t ├── cz-08encoding.t ├── cz-14gzopen.t ├── files ├── bad-efs.zip ├── encrypt-aes.zip ├── encrypt-standard.zip ├── jar.zip ├── meta.xml ├── test.ods ├── testfile1.odt ├── time-UX.zip ├── time-dos.zip ├── time-ntfs.zip ├── time-ut.zip ├── valid-cp850.zip ├── valid-utf8-bom-efs.zip └── valid-utf8-efs.zip └── globmapper.t /.appveyor.yml: -------------------------------------------------------------------------------- 1 | # File sourced from http://blogs.perl.org/users/mauke/2017/10/automated-testing-on-windows-with-appveyor.html 2 | 3 | cache: 4 | - C:\strawberry 5 | 6 | install: 7 | - if not exist "C:\strawberry" choco install strawberryperl -y 8 | - set PATH=C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin;%PATH% 9 | - cd %APPVEYOR_BUILD_FOLDER% 10 | - cpanm --quiet --installdeps --with-develop --notest . 11 | 12 | build_script: 13 | - perl Makefile.PL 14 | - gmake 15 | 16 | test_script: 17 | - gmake test 18 | -------------------------------------------------------------------------------- /.cirrus.yml: -------------------------------------------------------------------------------- 1 | task: 2 | name: FreeBSD 3 | freebsd_instance: 4 | matrix: 5 | # image: freebsd-11-3-release-amd64 6 | image: freebsd-12-1-release-amd64 7 | # image: freebsd-13-0-release-amd64 8 | install_script: 9 | - pkg info 10 | - pkg install -y gcc 11 | - pkg install -y perl5 12 | - perl -V 13 | - echo|cpan App::cpanminus 14 | - cpanm --installdeps . 15 | build_script: 16 | - perl Makefile.PL 17 | test_script: 18 | - make test 19 | 20 | 21 | task: 22 | name: MacOS 23 | osx_instance: 24 | matrix: 25 | image: catalina-xcode-11.3.1 26 | image: catalina-xcode-11.4.1 27 | # image: catalina-xcode-11.5 28 | install_script: 29 | - perl -V 30 | - echo|sudo cpan App::cpanminus 31 | - sudo /Users/admin/perl5/bin/cpanm --installdeps . 32 | build_script: 33 | - sudo perl Makefile.PL 34 | test_script: 35 | - sudo make test 36 | -------------------------------------------------------------------------------- /.github/workflows/linux.yml: -------------------------------------------------------------------------------- 1 | name: Linux build 2 | 3 | on: 4 | workflow_dispatch: 5 | push: 6 | pull_request: 7 | schedule: 8 | - cron: '01 01 * * 6' # Run every Saturday 9 | 10 | jobs: 11 | build: 12 | 13 | runs-on: ubuntu-latest 14 | 15 | strategy: 16 | matrix: 17 | perl: 18 | # - 'develop' 19 | - '5.40' 20 | - '5.38' 21 | - '5.36' 22 | - '5.34' 23 | - '5.32' 24 | - '5.30' 25 | - '5.28' 26 | - '5.26' 27 | - '5.24' 28 | - '5.22' 29 | - '5.20' 30 | - '5.18' 31 | - '5.16' 32 | - '5.14' 33 | - '5.12' 34 | - '5.10' 35 | - '5.8' 36 | 37 | name: Perl ${{ matrix.perl }} 38 | steps: 39 | - uses: actions/checkout@v4 40 | - name: Setup perl 41 | uses: shogo82148/actions-setup-perl@v1 42 | with: 43 | perl-version: ${{ matrix.perl }} 44 | - name: Perl version 45 | run: perl -V 46 | - name: Install dependencies 47 | run: cpanm --quiet --installdeps --notest . 48 | - name: Build 49 | run: perl Makefile.PL && make 50 | - name: Test 51 | run: make test -------------------------------------------------------------------------------- /.github/workflows/macos.yml: -------------------------------------------------------------------------------- 1 | name: Macos build 2 | 3 | on: 4 | workflow_dispatch: 5 | push: 6 | pull_request: 7 | schedule: 8 | - cron: '01 01 * * 6' # Run every Saturday 9 | 10 | jobs: 11 | build: 12 | 13 | runs-on: macos-latest 14 | 15 | strategy: 16 | matrix: 17 | perl: 18 | # - 'develop' 19 | - '5.40' 20 | - '5.38' 21 | - '5.36' 22 | - '5.34' 23 | - '5.32' 24 | - '5.30' 25 | - '5.28' 26 | - '5.26' 27 | - '5.24' 28 | - '5.22' 29 | - '5.20' 30 | - '5.18' 31 | - '5.16' 32 | - '5.14' 33 | - '5.12' 34 | - '5.10' 35 | - '5.8' 36 | 37 | name: Perl ${{ matrix.perl }} 38 | steps: 39 | - uses: actions/checkout@v4 40 | - name: Setup perl 41 | uses: shogo82148/actions-setup-perl@v1 42 | with: 43 | perl-version: ${{ matrix.perl }} 44 | - name: Perl version 45 | run: perl -V 46 | - name: Install dependencies 47 | run: cpanm --quiet --installdeps --notest . 48 | - name: Build 49 | run: perl Makefile.PL && make 50 | - name: Test 51 | run: make test -------------------------------------------------------------------------------- /.github/workflows/windows.yml: -------------------------------------------------------------------------------- 1 | name: Windows build 2 | 3 | on: 4 | workflow_dispatch: 5 | push: 6 | pull_request: 7 | schedule: 8 | - cron: '01 01 * * 6' # Run every Saturday 9 | 10 | jobs: 11 | build: 12 | 13 | runs-on: windows-latest 14 | 15 | strategy: 16 | matrix: 17 | perl: 18 | # - 'develop' 19 | - '5.40' 20 | - '5.38' 21 | - '5.36' 22 | # - '5.34' 23 | # - '5.32' 24 | # - '5.30' 25 | # - '5.28' 26 | # - '5.26' 27 | # - '5.24' 28 | # - '5.22' 29 | # - '5.20' 30 | # - '5.18' 31 | # - '5.16' 32 | # - '5.14' 33 | # - '5.12' 34 | # - '5.10' 35 | # - '5.8' 36 | distribution: 37 | - 'default' 38 | - 'strawberry' 39 | 40 | name: Perl ${{ matrix.perl }} distribution:${{ matrix.distribution }} 41 | steps: 42 | - uses: actions/checkout@v4 43 | - name: Setup perl 44 | uses: shogo82148/actions-setup-perl@v1 45 | with: 46 | perl-version: ${{ matrix.perl }} 47 | distribution: ${{ matrix.distribution }} 48 | - name: Install packages 49 | run: choco install make 50 | - name: Perl version 51 | run: perl -V 52 | - name: Install dependencies 53 | run: cpanm --installdeps --notest . 54 | - name: Build 55 | run: perl Makefile.PL && make 56 | - name: Test 57 | run: make test 58 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | *~ 3 | .* 4 | *.bak 5 | *.o 6 | *.swp 7 | *.tar.gz 8 | *.tmp 9 | 10 | !.appveyor.yml 11 | !.cirrus.yml 12 | !.github 13 | !.gitignore 14 | !.perltidyrc 15 | !.travis.yml 16 | 17 | /IO-Compress-* 18 | /MYMETA.* 19 | /Makefile 20 | /Makefile.old 21 | /archive 22 | /blib 23 | /bugs 24 | /libraries 25 | /pm_to_blib 26 | /releases 27 | /scratch -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | 3 | os: 4 | - linux 5 | 6 | perl: 7 | - "5.6" 8 | - "5.8" 9 | - "5.10" 10 | - "5.12" 11 | - "5.14" 12 | - "5.16" 13 | - "5.18" 14 | - "5.20" 15 | - "5.22" 16 | - "5.24" 17 | - "5.26" 18 | - "5.28" 19 | - "5.30" 20 | - "5.32" 21 | - "blead" 22 | 23 | before_install: 24 | - eval $(curl https://travis-perl.github.io/init) --auto 25 | 26 | install: 27 | - perl -V 28 | - cpan-install --deps 29 | # Force latest version of these modules 30 | - cpan Scalar::Util 31 | - cpan Compress::Raw::Zlib 32 | - cpan Compress::Raw::Bzip2 33 | - cpan Getopt::Long 34 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | Changes 2 | bin/zipdetails perl 3 | bin/streamzip perl 4 | examples/io/anycat perl 5 | examples/io/bzip2/bzcat perl 6 | examples/io/bzip2/bzgrep perl 7 | examples/io/bzip2/bzstream perl 8 | examples/io/gzip/gzappend perl 9 | examples/io/gzip/gzcat perl 10 | examples/io/gzip/gzgrep perl 11 | examples/io/gzip/gzstream perl 12 | examples/compress-zlib/filtinf perl 13 | examples/compress-zlib/filtdef perl 14 | examples/compress-zlib/gzcat perl 15 | examples/compress-zlib/gzgrep perl 16 | examples/compress-zlib/gzstream perl 17 | lib/Compress/Zlib.pm 18 | lib/File/GlobMapper.pm 19 | lib/IO/Compress.pm 20 | lib/IO/Compress/FAQ.pod 21 | lib/IO/Compress/Adapter/Bzip2.pm 22 | lib/IO/Compress/Adapter/Deflate.pm 23 | lib/IO/Compress/Adapter/Identity.pm 24 | lib/IO/Compress/Base/Common.pm 25 | lib/IO/Compress/Base.pm 26 | lib/IO/Compress/Bzip2.pm 27 | lib/IO/Compress/Deflate.pm 28 | lib/IO/Compress/Gzip/Constants.pm 29 | lib/IO/Compress/Gzip.pm 30 | lib/IO/Compress/RawDeflate.pm 31 | lib/IO/Compress/Zip/Constants.pm 32 | lib/IO/Compress/Zip.pm 33 | lib/IO/Compress/Zlib/Constants.pm 34 | lib/IO/Compress/Zlib/Extra.pm 35 | lib/IO/Uncompress/Adapter/Bunzip2.pm 36 | lib/IO/Uncompress/Adapter/Identity.pm 37 | lib/IO/Uncompress/Adapter/Inflate.pm 38 | lib/IO/Uncompress/AnyInflate.pm 39 | lib/IO/Uncompress/AnyUncompress.pm 40 | lib/IO/Uncompress/Base.pm 41 | lib/IO/Uncompress/Bunzip2.pm 42 | lib/IO/Uncompress/Gunzip.pm 43 | lib/IO/Uncompress/Inflate.pm 44 | lib/IO/Uncompress/RawInflate.pm 45 | lib/IO/Uncompress/Unzip.pm 46 | Makefile.PL 47 | MANIFEST 48 | private/MakeUtil.pm 49 | README 50 | t/000prereq.t 51 | t/001bzip2.t 52 | t/001zlib-generic-deflate.t 53 | t/001zlib-generic-gzip.t 54 | t/001zlib-generic-rawdeflate.t 55 | t/001zlib-generic-zip.t 56 | t/002any-deflate.t 57 | t/002any-gzip.t 58 | t/002any-rawdeflate.t 59 | t/002any-transparent.t 60 | t/002any-zip.t 61 | t/004gziphdr.t 62 | t/005defhdr.t 63 | t/006zip.t 64 | t/010examples-bzip2.t 65 | t/010examples-zlib.t 66 | t/011-streamzip.t 67 | t/01misc.t 68 | t/020isize.t 69 | t/050interop-gzip.t 70 | t/100generic-bzip2.t 71 | t/100generic-deflate.t 72 | t/100generic-gzip.t 73 | t/100generic-rawdeflate.t 74 | t/100generic-zip.t 75 | t/101truncate-bzip2.t 76 | t/101truncate-deflate.t 77 | t/101truncate-gzip.t 78 | t/101truncate-rawdeflate.t 79 | t/101truncate-zip.t 80 | t/102tied-bzip2.t 81 | t/102tied-deflate.t 82 | t/102tied-gzip.t 83 | t/102tied-rawdeflate.t 84 | t/102tied-zip.t 85 | t/103newtied-bzip2.t 86 | t/103newtied-deflate.t 87 | t/103newtied-gzip.t 88 | t/103newtied-rawdeflate.t 89 | t/103newtied-zip.t 90 | t/104destroy-bzip2.t 91 | t/104destroy-deflate.t 92 | t/104destroy-gzip.t 93 | t/104destroy-rawdeflate.t 94 | t/104destroy-zip.t 95 | t/105oneshot-bzip2.t 96 | t/105oneshot-deflate.t 97 | t/105oneshot-gzip-only.t 98 | t/105oneshot-gzip.t 99 | t/105oneshot-rawdeflate.t 100 | t/105oneshot-zip-bzip2-only.t 101 | t/105oneshot-zip-only.t 102 | t/105oneshot-zip-store-only.t 103 | t/105oneshot-zip.t 104 | t/106prime-bzip2.t 105 | t/106prime-deflate.t 106 | t/106prime-gzip.t 107 | t/106prime-rawdeflate.t 108 | t/106prime-zip.t 109 | t/107multi-bzip2.t 110 | t/107multi-deflate.t 111 | t/107multi-gzip.t 112 | t/107multi-rawdeflate.t 113 | t/107multi-zip.t 114 | t/107multi-zip-only.t 115 | t/108anyunc-bzip2.t 116 | t/108anyunc-deflate.t 117 | t/108anyunc-gzip.t 118 | t/108anyunc-rawdeflate.t 119 | t/108anyunc-transparent.t 120 | t/108anyunc-zip.t 121 | t/109merge-deflate.t 122 | t/109merge-gzip.t 123 | t/109merge-rawdeflate.t 124 | t/109merge-zip.t 125 | t/110encode-bzip2.t 126 | t/110encode-deflate.t 127 | t/110encode-gzip.t 128 | t/110encode-rawdeflate.t 129 | t/110encode-zip.t 130 | t/111const-deflate.t 131 | t/112utf8-zip.t 132 | t/113issues.t 133 | t/999meta-json.t 134 | t/999meta-yml.t 135 | t/999pod.t 136 | t/cz-01version.t 137 | t/cz-03zlib-v1.t 138 | t/cz-05examples.t 139 | t/cz-06gzsetp.t 140 | t/cz-08encoding.t 141 | t/cz-14gzopen.t 142 | t/compress/any.pl 143 | t/compress/anyunc.pl 144 | t/compress/CompTestUtils.pm 145 | t/compress/destroy.pl 146 | t/compress/encode.pl 147 | t/compress/generic.pl 148 | t/compress/merge.pl 149 | t/compress/multi.pl 150 | t/compress/newtied.pl 151 | t/compress/oneshot.pl 152 | t/compress/prime.pl 153 | t/compress/tied.pl 154 | t/compress/truncate.pl 155 | t/compress/zlib-generic.pl 156 | t/files/bad-efs.zip 157 | t/files/meta.xml 158 | t/files/test.ods 159 | t/files/testfile1.odt 160 | t/files/encrypt-aes.zip 161 | t/files/encrypt-standard.zip 162 | t/files/jar.zip 163 | t/globmapper.t 164 | t/Test/Builder.pm 165 | t/Test/More.pm 166 | META.yml Module meta-data (added by MakeMaker) 167 | t/Test/Simple.pm 168 | META.json Module JSON meta-data (added by MakeMaker) 169 | -------------------------------------------------------------------------------- /META.json: -------------------------------------------------------------------------------- 1 | { 2 | "abstract" : "IO Interface to compressed data files/buffers", 3 | "author" : [ 4 | "Paul Marquess " 5 | ], 6 | "dynamic_config" : 1, 7 | "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", 8 | "license" : [ 9 | "perl_5" 10 | ], 11 | "meta-spec" : { 12 | "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", 13 | "version" : 2 14 | }, 15 | "name" : "IO-Compress", 16 | "no_index" : { 17 | "directory" : [ 18 | "t", 19 | "inc", 20 | "t", 21 | "private" 22 | ] 23 | }, 24 | "prereqs" : { 25 | "build" : { 26 | "requires" : { 27 | "ExtUtils::MakeMaker" : "0" 28 | } 29 | }, 30 | "configure" : { 31 | "requires" : { 32 | "ExtUtils::MakeMaker" : "0" 33 | } 34 | }, 35 | "runtime" : { 36 | "requires" : { 37 | "Compress::Raw::Bzip2" : "2.213", 38 | "Compress::Raw::Zlib" : "2.213", 39 | "Scalar::Util" : "0", 40 | "Encode" : "0", 41 | "Time::Local" : "0" 42 | } 43 | } 44 | }, 45 | "release_status" : "stable", 46 | "resources" : { 47 | "bugtracker" : { 48 | "web" : "https://github.com/pmqs/IO-Compress/issues" 49 | }, 50 | "homepage" : "https://github.com/pmqs/IO-Compress", 51 | "repository" : { 52 | "type" : "git", 53 | "url" : "git://github.com/pmqs/IO-Compress.git", 54 | "web" : "https://github.com/pmqs/IO-Compress" 55 | } 56 | }, 57 | "version" : "2.213", 58 | "x_serialization_backend" : "JSON::PP version 2.97001" 59 | } 60 | -------------------------------------------------------------------------------- /META.yml: -------------------------------------------------------------------------------- 1 | --- 2 | abstract: 'IO Interface to compressed data files/buffers' 3 | author: 4 | - 'Paul Marquess ' 5 | build_requires: 6 | ExtUtils::MakeMaker: '0' 7 | configure_requires: 8 | ExtUtils::MakeMaker: '0' 9 | dynamic_config: 1 10 | generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' 11 | license: perl 12 | meta-spec: 13 | url: http://module-build.sourceforge.net/META-spec-v1.4.html 14 | version: '1.4' 15 | name: IO-Compress 16 | no_index: 17 | directory: 18 | - t 19 | - inc 20 | - t 21 | - private 22 | requires: 23 | Compress::Raw::Bzip2: '2.213' 24 | Compress::Raw::Zlib: '2.213' 25 | Scalar::Util: '0' 26 | Encode: '0' 27 | Time::Local: '0' 28 | resources: 29 | bugtracker: https://github.com/pmqs/IO-Compress/issues 30 | homepage: https://github.com/pmqs/IO-Compress 31 | repository: git://github.com/pmqs/IO-Compress.git 32 | version: '2.213' 33 | x_serialization_backend: 'CPAN::Meta::YAML version 0.018' 34 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | #! perl -w 2 | 3 | use strict ; 4 | require 5.006 ; 5 | 6 | $::VERSION = '2.213' ; 7 | $::DEP_VERSION = '2.213'; 8 | 9 | use lib '.'; 10 | use private::MakeUtil; 11 | use ExtUtils::MakeMaker 5.16 ; 12 | 13 | UpDowngrade(getPerlFiles('MANIFEST')) 14 | unless $ENV{PERL_CORE}; 15 | 16 | WriteMakefile( 17 | NAME => 'IO::Compress', 18 | VERSION_FROM => 'lib/IO/Compress/Base.pm', 19 | 'dist' => { COMPRESS => 'gzip', 20 | TARFLAGS => '-chvf', 21 | SUFFIX => 'gz', 22 | DIST_DEFAULT => 'MyTrebleCheck tardist', 23 | }, 24 | 25 | ( 26 | $ENV{SKIP_FOR_CORE} 27 | ? () 28 | : (PREREQ_PM => { 'Compress::Raw::Bzip2' => $::DEP_VERSION, 29 | 'Compress::Raw::Zlib' => $::DEP_VERSION, 30 | 'Scalar::Util' => 0, 31 | 'Encode' => 0, 32 | 'Time::Local' => 0, 33 | $] >= 5.005 && $] < 5.006 34 | ? ('File::BSDGlob' => 0) 35 | : () } 36 | ) 37 | ), 38 | 39 | ( 40 | $] >= 5.005 41 | ? (ABSTRACT => 'IO Interface to compressed data files/buffers', 42 | AUTHOR => 'Paul Marquess ') 43 | : () 44 | ), 45 | 46 | INSTALLDIRS => ($] >= 5.009 && $] < 5.011 ? 'perl' : 'site'), 47 | 48 | EXE_FILES => ['bin/zipdetails', 'bin/streamzip'], 49 | 50 | ( 51 | $] >= 5.009 && $] <= 5.011001 && ! $ENV{PERL_CORE} 52 | ? (INSTALLPRIVLIB => '$(INSTALLARCHLIB)') 53 | : () 54 | ), 55 | 56 | ( eval { ExtUtils::MakeMaker->VERSION(6.46) } 57 | ? ( META_MERGE => { 58 | 59 | "meta-spec" => { version => 2 }, 60 | 61 | no_index => { 62 | directory => [ 't', 'private' ], 63 | }, 64 | 65 | resources => { 66 | 67 | bugtracker => { 68 | web => 'https://github.com/pmqs/IO-Compress/issues' 69 | }, 70 | 71 | homepage => 'https://github.com/pmqs/IO-Compress', 72 | 73 | repository => { 74 | type => 'git', 75 | url => 'git://github.com/pmqs/IO-Compress.git', 76 | web => 'https://github.com/pmqs/IO-Compress', 77 | }, 78 | }, 79 | } 80 | ) 81 | : () 82 | ), 83 | 84 | ((ExtUtils::MakeMaker->VERSION() gt '6.30') ? 85 | ('LICENSE' => 'perl') : ()), 86 | 87 | ) ; 88 | 89 | # end of file Makefile.PL 90 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | 2 | IO-Compress 3 | 4 | Version 2.213 5 | 6 | 28 August 2024 7 | 8 | Copyright (c) 1995-2024 Paul Marquess. All rights reserved. 9 | This program is free software; you can redistribute it 10 | and/or modify it under the same terms as Perl itself. 11 | 12 | DESCRIPTION 13 | ----------- 14 | 15 | This distribution provides a Perl interface to allow reading and writing of 16 | compressed data created with the zlib and bzip2. 17 | 18 | IO-Compress supports reading and writing of the following compressed data formats 19 | * bzip2 20 | * RFC 1950 21 | * RFC 1951 22 | * RFC 1952 (i.e. gzip) 23 | * zip 24 | 25 | There are a number of companion modules for IO-Compress that extend 26 | the suite of compression formats available. 27 | 28 | * IO-Compress-Zstd 29 | Adds support for zstd (Zstandard). 30 | * IO-Compress-Lzma 31 | Adds support for lzma, xz and lzip. 32 | * IO-Compress-Lzf 33 | Adds support for lzf. 34 | * IO-Compress-Lzop 35 | Adds support for lzop. 36 | 37 | Note that the following modules used to be distributed separately, but are now 38 | included with the IO-Compress distribution. 39 | 40 | Compress-Zlib 41 | IO-Compress-Zlib 42 | IO-Compress-Bzip2 43 | IO-Compress-Base 44 | 45 | PREREQUISITES 46 | ------------- 47 | 48 | Before you can build IO-Compress you need to have the following 49 | installed on your system: 50 | 51 | * Perl 5.006 or better. 52 | * Compress::Raw::Zlib 53 | * Compress::Raw::Bzip2 54 | 55 | BUILDING THE MODULE 56 | ------------------- 57 | 58 | Assuming you have met all the prerequisites, the module can now be built 59 | using this sequence of commands: 60 | 61 | perl Makefile.PL 62 | make 63 | make test 64 | 65 | INSTALLATION 66 | ------------ 67 | 68 | To install IO-Compress, run the command below: 69 | 70 | make install 71 | 72 | TROUBLESHOOTING 73 | --------------- 74 | 75 | SUPPORT 76 | ------- 77 | 78 | General feedback/questions/bug reports should be sent to 79 | https://github.com/pmqs/IO-Compress/issues 80 | 81 | FEEDBACK 82 | -------- 83 | 84 | How to report a problem with IO-Compress. 85 | 86 | To help me help you, I need all of the following information: 87 | 88 | 1. The Versions of everything relevant. 89 | This includes: 90 | 91 | a. The *complete* output from running this 92 | 93 | perl -V 94 | 95 | Do not edit the output in any way. 96 | Note, I want you to run "perl -V" and NOT "perl -v". 97 | 98 | If your perl does not understand the "-V" option it is too 99 | old. This module needs Perl version 5.004 or better. 100 | 101 | b. The version of IO-Compress you have. 102 | If you have successfully installed IO-Compress, this one-liner 103 | will tell you: 104 | 105 | perl -MIO::Compress::Gzip -e 'print qq[ver $IO::Compress::Gzip::VERSION\n]' 106 | 107 | If you are running windows use this 108 | 109 | perl -MIO::Compress::Gzip -e "print qq[ver $IO::Compress::Gzip::VERSION\n]" 110 | 111 | If you haven't installed IO-Compress then search IO::Compress::Gzip.pm 112 | for a line like this: 113 | 114 | $VERSION = "2.213" ; 115 | 116 | 2. If you are having problems building IO-Compress, send me a 117 | complete log of what happened. Start by unpacking the IO-Compress 118 | module into a fresh directory and keep a log of all the steps, including 119 | the setting of configuration environment variables (if applicable). 120 | 121 | [edit config.in or set environment varialbes, if necessary] 122 | perl Makefile.PL 123 | make 124 | make test TEST_VERBOSE=1 125 | 126 | Paul Marquess 127 | -------------------------------------------------------------------------------- /bugs/12826/mf.pl: -------------------------------------------------------------------------------- 1 | 2 | use warnings; 3 | use strict; 4 | 5 | use IO::Uncompress::Unzip qw($UnzipError); 6 | 7 | my $zipfile = "mf.zip"; 8 | 9 | my $transparent = 1; 10 | 11 | my $u = new IO::Uncompress::Unzip $zipfile, Transparent => $transparent 12 | or die "Cannot open $zipfile: $UnzipError"; 13 | 14 | my $status; 15 | for ($status = 1; $status > 0; $status = $u->nextStream()) 16 | { 17 | my $name = $u->getHeaderInfo()->{Name}; 18 | warn "Processing member $name\n" ; 19 | } 20 | 21 | die "Error processing $zipfile: $!\n" 22 | if $status < 0 ; 23 | 24 | -------------------------------------------------------------------------------- /bugs/12826/mf.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/bugs/12826/mf.zip -------------------------------------------------------------------------------- /examples/compress-zlib/filtdef: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | 6 | use Compress::Zlib ; 7 | 8 | binmode STDIN; 9 | binmode STDOUT; 10 | my $x = deflateInit() 11 | or die "Cannot create a deflation stream\n" ; 12 | 13 | my ($output, $status) ; 14 | while (<>) 15 | { 16 | ($output, $status) = $x->deflate($_) ; 17 | 18 | $status == Z_OK 19 | or die "deflation failed\n" ; 20 | 21 | print $output ; 22 | } 23 | 24 | ($output, $status) = $x->flush() ; 25 | 26 | $status == Z_OK 27 | or die "deflation failed\n" ; 28 | 29 | print $output ; 30 | -------------------------------------------------------------------------------- /examples/compress-zlib/filtinf: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | 6 | use Compress::Zlib ; 7 | 8 | my $x = inflateInit() 9 | or die "Cannot create a inflation stream\n" ; 10 | 11 | my $input = '' ; 12 | binmode STDIN; 13 | binmode STDOUT; 14 | 15 | my ($output, $status) ; 16 | while (read(STDIN, $input, 4096)) 17 | { 18 | ($output, $status) = $x->inflate(\$input) ; 19 | 20 | print $output 21 | if $status == Z_OK or $status == Z_STREAM_END ; 22 | 23 | last if $status != Z_OK ; 24 | } 25 | 26 | die "inflation failed\n" 27 | unless $status == Z_STREAM_END ; 28 | -------------------------------------------------------------------------------- /examples/compress-zlib/gzcat: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | 6 | use Compress::Zlib ; 7 | 8 | #die "Usage: gzcat file...\n" 9 | # unless @ARGV ; 10 | 11 | my $filename ; 12 | 13 | @ARGV = '-' unless @ARGV ; 14 | 15 | foreach my $filename (@ARGV) { 16 | my $buffer ; 17 | 18 | my $gz = gzopen($filename, "rb") 19 | or die "Cannot open $filename: $gzerrno\n" ; 20 | 21 | print $buffer while $gz->gzread($buffer) > 0 ; 22 | 23 | die "Error reading from $filename: $gzerrno" . ($gzerrno+0) . "\n" 24 | if $gzerrno != Z_STREAM_END ; 25 | 26 | $gz->gzclose() ; 27 | } 28 | -------------------------------------------------------------------------------- /examples/compress-zlib/gzgrep: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | 6 | use Compress::Zlib ; 7 | 8 | die "Usage: gzgrep pattern file...\n" 9 | unless @ARGV >= 2; 10 | 11 | my $pattern = shift ; 12 | 13 | my $file ; 14 | 15 | foreach $file (@ARGV) { 16 | my $gz = gzopen($file, "rb") 17 | or die "Cannot open $file: $gzerrno\n" ; 18 | 19 | while ($gz->gzreadline($_) > 0) { 20 | print if /$pattern/ ; 21 | } 22 | 23 | die "Error reading from $file: $gzerrno\n" 24 | if $gzerrno != Z_STREAM_END ; 25 | 26 | $gz->gzclose() ; 27 | } 28 | -------------------------------------------------------------------------------- /examples/compress-zlib/gzstream: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | 6 | use Compress::Zlib ; 7 | 8 | binmode STDOUT; # gzopen only sets it on the fd 9 | 10 | #my $gz = gzopen(\*STDOUT, "wb") 11 | my $gz = gzopen('-', "wb") 12 | or die "Cannot open stdout: $gzerrno\n" ; 13 | 14 | while (<>) { 15 | $gz->gzwrite($_) 16 | or die "error writing: $gzerrno\n" ; 17 | } 18 | 19 | $gz->gzclose ; 20 | -------------------------------------------------------------------------------- /examples/io/anycat: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | 6 | use IO::Uncompress::AnyUncompress qw( anyuncompress $AnyUncompressError ); 7 | 8 | @ARGV = '-' unless @ARGV ; 9 | 10 | foreach my $file (@ARGV) { 11 | 12 | anyuncompress $file => '-', 13 | Transparent => 1, 14 | Strict => 0, 15 | or die "Cannot uncompress '$file': $AnyUncompressError\n" ; 16 | 17 | } 18 | -------------------------------------------------------------------------------- /examples/io/bzip2/bzcat: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use IO::Uncompress::Bunzip2 qw( $Bunzip2Error ); 4 | use strict ; 5 | use warnings ; 6 | 7 | #die "Usage: gzcat file...\n" 8 | # unless @ARGV ; 9 | 10 | my $file ; 11 | my $buffer ; 12 | my $s; 13 | 14 | @ARGV = '-' unless @ARGV ; 15 | 16 | foreach $file (@ARGV) { 17 | 18 | my $gz = new IO::Uncompress::Bunzip2 $file 19 | or die "Cannot open $file: $Bunzip2Error\n" ; 20 | 21 | print $buffer 22 | while ($s = $gz->read($buffer)) > 0 ; 23 | 24 | die "Error reading from $file: $Bunzip2Error\n" 25 | if $s < 0 ; 26 | 27 | $gz->close() ; 28 | } 29 | -------------------------------------------------------------------------------- /examples/io/bzip2/bzgrep: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error); 6 | 7 | die "Usage: gzgrep pattern [file...]\n" 8 | unless @ARGV >= 1; 9 | 10 | my $pattern = shift ; 11 | my $file ; 12 | 13 | @ARGV = '-' unless @ARGV ; 14 | 15 | foreach $file (@ARGV) { 16 | my $gz = new IO::Uncompress::Bunzip2 $file 17 | or die "Cannot uncompress $file: $Bunzip2Error\n" ; 18 | 19 | while (<$gz>) { 20 | print if /$pattern/ ; 21 | } 22 | 23 | die "Error reading from $file: $Bunzip2Error\n" 24 | if $Bunzip2Error ; 25 | } 26 | -------------------------------------------------------------------------------- /examples/io/bzip2/bzstream: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | use IO::Compress::Bzip2 qw(:all); 6 | 7 | bzip2 '-' => '-' 8 | or die "bzstream: $Bzip2Error\n" ; 9 | 10 | -------------------------------------------------------------------------------- /examples/io/gzip/gzappend: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use IO::Compress::Gzip qw( $GzipError ); 4 | use strict ; 5 | use warnings ; 6 | 7 | die "Usage: gzappend gz-file file...\n" 8 | unless @ARGV ; 9 | 10 | 11 | my $output = shift @ARGV ; 12 | 13 | @ARGV = '-' unless @ARGV ; 14 | 15 | my $gz = new IO::Compress::Gzip $output, Merge => 1 16 | or die "Cannot open $output: $GzipError\n" ; 17 | 18 | $gz->write( [@ARGV] ) 19 | or die "Cannot open $output: $GzipError\n" ; 20 | 21 | $gz->close; 22 | -------------------------------------------------------------------------------- /examples/io/gzip/gzcat: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use IO::Uncompress::Gunzip qw( $GunzipError ); 4 | use strict ; 5 | use warnings ; 6 | 7 | #die "Usage: gzcat file...\n" 8 | # unless @ARGV ; 9 | 10 | my $file ; 11 | my $buffer ; 12 | my $s; 13 | 14 | @ARGV = '-' unless @ARGV ; 15 | 16 | foreach $file (@ARGV) { 17 | 18 | my $gz = new IO::Uncompress::Gunzip $file 19 | or die "Cannot open $file: $GunzipError\n" ; 20 | 21 | print $buffer 22 | while ($s = $gz->read($buffer)) > 0 ; 23 | 24 | die "Error reading from $file: $GunzipError\n" 25 | if $s < 0 ; 26 | 27 | $gz->close() ; 28 | } 29 | -------------------------------------------------------------------------------- /examples/io/gzip/gzgrep: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | use IO::Uncompress::Gunzip qw($GunzipError); 6 | 7 | die "Usage: gzgrep pattern [file...]\n" 8 | unless @ARGV >= 1; 9 | 10 | my $pattern = shift ; 11 | my $file ; 12 | 13 | @ARGV = '-' unless @ARGV ; 14 | 15 | foreach $file (@ARGV) { 16 | my $gz = new IO::Uncompress::Gunzip $file 17 | or die "Cannot uncompress $file: $GunzipError\n" ; 18 | 19 | while (<$gz>) { 20 | print if /$pattern/ ; 21 | } 22 | 23 | die "Error reading from $file: $GunzipError\n" 24 | if $GunzipError ; 25 | } 26 | 27 | __END__ 28 | foreach $file (@ARGV) { 29 | my $gz = gzopen($file, "rb") 30 | or die "Cannot open $file: $gzerrno\n" ; 31 | 32 | while ($gz->gzreadline($_) > 0) { 33 | print if /$pattern/ ; 34 | } 35 | 36 | die "Error reading from $file: $gzerrno\n" 37 | if $gzerrno != Z_STREAM_END ; 38 | 39 | $gz->gzclose() ; 40 | } 41 | -------------------------------------------------------------------------------- /examples/io/gzip/gzstream: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/perl 2 | 3 | use strict ; 4 | use warnings ; 5 | use IO::Compress::Gzip qw(gzip $GzipError); 6 | 7 | gzip '-' => '-', Minimal => 1 8 | or die "gzstream: $GzipError\n" ; 9 | 10 | #exit 0; 11 | 12 | __END__ 13 | 14 | #my $gz = new IO::Compress::Gzip *STDOUT 15 | my $gz = new IO::Compress::Gzip '-' 16 | or die "gzstream: Cannot open stdout as gzip stream: $GzipError\n" ; 17 | 18 | while (<>) { 19 | $gz->write($_) 20 | or die "gzstream: Error writing gzip output stream: $GzipError\n" ; 21 | } 22 | 23 | $gz->close 24 | or die "gzstream: Error closing gzip output stream: $GzipError\n" ; 25 | -------------------------------------------------------------------------------- /lib/IO/Compress.pm: -------------------------------------------------------------------------------- 1 | package IO::Compress; 2 | 3 | our $VERSION = '2.213' ; 4 | 5 | =head1 NAME 6 | 7 | IO::Compress - read/write compressed data in multiple formats 8 | 9 | =head1 DESCRIPTION 10 | 11 | This is a stub module. It contains no code. 12 | 13 | =head1 AUTHOR 14 | 15 | Paul Marquess F. 16 | 17 | =head1 COPYRIGHT 18 | 19 | Copyright (c) 2011-2024 Paul Marquess. All rights reserved. 20 | 21 | This program is free software; you can redistribute it and/or modify it 22 | under the same terms as Perl itself. 23 | 24 | =cut 25 | 26 | 27 | 1; -------------------------------------------------------------------------------- /lib/IO/Compress/Adapter/Bzip2.pm: -------------------------------------------------------------------------------- 1 | package IO::Compress::Adapter::Bzip2 ; 2 | 3 | use strict; 4 | use warnings; 5 | use bytes; 6 | 7 | use IO::Compress::Base::Common 2.213 qw(:Status); 8 | 9 | use Compress::Raw::Bzip2 2.213 ; 10 | 11 | our ($VERSION); 12 | $VERSION = '2.213'; 13 | 14 | sub mkCompObject 15 | { 16 | my $BlockSize100K = shift ; 17 | my $WorkFactor = shift ; 18 | my $Verbosity = shift ; 19 | 20 | $BlockSize100K = 1 if ! defined $BlockSize100K ; 21 | $WorkFactor = 0 if ! defined $WorkFactor ; 22 | $Verbosity = 0 if ! defined $Verbosity ; 23 | 24 | my ($def, $status) = Compress::Raw::Bzip2->new(1, $BlockSize100K, 25 | $WorkFactor, $Verbosity); 26 | 27 | return (undef, "Could not create Deflate object: $status", $status) 28 | if $status != BZ_OK ; 29 | 30 | return bless {'Def' => $def, 31 | 'Error' => '', 32 | 'ErrorNo' => 0, 33 | } ; 34 | } 35 | 36 | sub compr 37 | { 38 | my $self = shift ; 39 | 40 | my $def = $self->{Def}; 41 | 42 | my $status = $def->bzdeflate($_[0], $_[1]) ; 43 | $self->{ErrorNo} = $status; 44 | 45 | if ($status != BZ_RUN_OK) 46 | { 47 | $self->{Error} = "Deflate Error: $status"; 48 | return STATUS_ERROR; 49 | } 50 | 51 | return STATUS_OK; 52 | } 53 | 54 | sub flush 55 | { 56 | my $self = shift ; 57 | 58 | my $def = $self->{Def}; 59 | 60 | my $status = $def->bzflush($_[0]); 61 | $self->{ErrorNo} = $status; 62 | 63 | if ($status != BZ_RUN_OK) 64 | { 65 | $self->{Error} = "Deflate Error: $status"; 66 | return STATUS_ERROR; 67 | } 68 | 69 | return STATUS_OK; 70 | 71 | } 72 | 73 | sub close 74 | { 75 | my $self = shift ; 76 | 77 | my $def = $self->{Def}; 78 | 79 | my $status = $def->bzclose($_[0]); 80 | $self->{ErrorNo} = $status; 81 | 82 | if ($status != BZ_STREAM_END) 83 | { 84 | $self->{Error} = "Deflate Error: $status"; 85 | return STATUS_ERROR; 86 | } 87 | 88 | return STATUS_OK; 89 | 90 | } 91 | 92 | 93 | sub reset 94 | { 95 | my $self = shift ; 96 | 97 | my $outer = $self->{Outer}; 98 | 99 | my ($def, $status) = Compress::Raw::Bzip2->new(); 100 | $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; 101 | 102 | if ($status != BZ_OK) 103 | { 104 | $self->{Error} = "Cannot create Deflate object: $status"; 105 | return STATUS_ERROR; 106 | } 107 | 108 | $self->{Def} = $def; 109 | 110 | return STATUS_OK; 111 | } 112 | 113 | sub compressedBytes 114 | { 115 | my $self = shift ; 116 | $self->{Def}->compressedBytes(); 117 | } 118 | 119 | sub uncompressedBytes 120 | { 121 | my $self = shift ; 122 | $self->{Def}->uncompressedBytes(); 123 | } 124 | 125 | #sub total_out 126 | #{ 127 | # my $self = shift ; 128 | # 0; 129 | #} 130 | # 131 | 132 | #sub total_in 133 | #{ 134 | # my $self = shift ; 135 | # $self->{Def}->total_in(); 136 | #} 137 | # 138 | #sub crc32 139 | #{ 140 | # my $self = shift ; 141 | # $self->{Def}->crc32(); 142 | #} 143 | # 144 | #sub adler32 145 | #{ 146 | # my $self = shift ; 147 | # $self->{Def}->adler32(); 148 | #} 149 | 150 | 151 | 1; 152 | 153 | __END__ 154 | -------------------------------------------------------------------------------- /lib/IO/Compress/Adapter/Deflate.pm: -------------------------------------------------------------------------------- 1 | package IO::Compress::Adapter::Deflate ; 2 | 3 | use strict; 4 | use warnings; 5 | use bytes; 6 | 7 | use IO::Compress::Base::Common 2.213 qw(:Status); 8 | use Compress::Raw::Zlib 2.213 qw( !crc32 !adler32 ) ; 9 | 10 | require Exporter; 11 | our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS); 12 | 13 | $VERSION = '2.213'; 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) = Compress::Raw::Zlib::Deflate->new( 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 mkCompObject1 44 | { 45 | my $crc32 = shift ; 46 | my $adler32 = shift ; 47 | my $level = shift ; 48 | my $strategy = shift ; 49 | 50 | my ($def, $status) = Compress::Raw::Zlib::Deflate->new( 51 | -AppendOutput => 1, 52 | -CRC32 => $crc32, 53 | -ADLER32 => $adler32, 54 | -Level => $level, 55 | -Strategy => $strategy, 56 | -WindowBits => MAX_WBITS); 57 | 58 | return (undef, "Cannot create Deflate object: $status", $status) 59 | if $status != Z_OK; 60 | 61 | return bless {'Def' => $def, 62 | 'Error' => '', 63 | } ; 64 | } 65 | 66 | sub compr 67 | { 68 | my $self = shift ; 69 | 70 | my $def = $self->{Def}; 71 | 72 | my $status = $def->deflate($_[0], $_[1]) ; 73 | $self->{ErrorNo} = $status; 74 | 75 | if ($status != Z_OK) 76 | { 77 | $self->{Error} = "Deflate Error: $status"; 78 | return STATUS_ERROR; 79 | } 80 | 81 | return STATUS_OK; 82 | } 83 | 84 | sub flush 85 | { 86 | my $self = shift ; 87 | 88 | my $def = $self->{Def}; 89 | 90 | my $opt = $_[1] || Z_FINISH; 91 | my $status = $def->flush($_[0], $opt); 92 | $self->{ErrorNo} = $status; 93 | 94 | if ($status != Z_OK) 95 | { 96 | $self->{Error} = "Deflate Error: $status"; 97 | return STATUS_ERROR; 98 | } 99 | 100 | return STATUS_OK; 101 | } 102 | 103 | sub close 104 | { 105 | my $self = shift ; 106 | 107 | my $def = $self->{Def}; 108 | 109 | $def->flush($_[0], Z_FINISH) 110 | if defined $def ; 111 | } 112 | 113 | sub reset 114 | { 115 | my $self = shift ; 116 | 117 | my $def = $self->{Def}; 118 | 119 | my $status = $def->deflateReset() ; 120 | $self->{ErrorNo} = $status; 121 | if ($status != Z_OK) 122 | { 123 | $self->{Error} = "Deflate Error: $status"; 124 | return STATUS_ERROR; 125 | } 126 | 127 | return STATUS_OK; 128 | } 129 | 130 | sub deflateParams 131 | { 132 | my $self = shift ; 133 | 134 | my $def = $self->{Def}; 135 | 136 | my $status = $def->deflateParams(@_); 137 | $self->{ErrorNo} = $status; 138 | if ($status != Z_OK) 139 | { 140 | $self->{Error} = "deflateParams Error: $status"; 141 | return STATUS_ERROR; 142 | } 143 | 144 | return STATUS_OK; 145 | } 146 | 147 | 148 | 149 | #sub total_out 150 | #{ 151 | # my $self = shift ; 152 | # $self->{Def}->total_out(); 153 | #} 154 | # 155 | #sub total_in 156 | #{ 157 | # my $self = shift ; 158 | # $self->{Def}->total_in(); 159 | #} 160 | 161 | sub compressedBytes 162 | { 163 | my $self = shift ; 164 | 165 | $self->{Def}->compressedBytes(); 166 | } 167 | 168 | sub uncompressedBytes 169 | { 170 | my $self = shift ; 171 | $self->{Def}->uncompressedBytes(); 172 | } 173 | 174 | 175 | 176 | 177 | sub crc32 178 | { 179 | my $self = shift ; 180 | $self->{Def}->crc32(); 181 | } 182 | 183 | sub adler32 184 | { 185 | my $self = shift ; 186 | $self->{Def}->adler32(); 187 | } 188 | 189 | 190 | 1; 191 | 192 | __END__ 193 | -------------------------------------------------------------------------------- /lib/IO/Compress/Adapter/Identity.pm: -------------------------------------------------------------------------------- 1 | package IO::Compress::Adapter::Identity ; 2 | 3 | use strict; 4 | use warnings; 5 | use bytes; 6 | 7 | use IO::Compress::Base::Common 2.213 qw(:Status); 8 | our ($VERSION); 9 | 10 | $VERSION = '2.213'; 11 | 12 | sub mkCompObject 13 | { 14 | my $level = shift ; 15 | my $strategy = shift ; 16 | 17 | return bless { 18 | 'CompSize' => 0, 19 | 'UnCompSize' => 0, 20 | 'Error' => '', 21 | 'ErrorNo' => 0, 22 | } ; 23 | } 24 | 25 | sub compr 26 | { 27 | my $self = shift ; 28 | 29 | if (defined ${ $_[0] } && length ${ $_[0] }) { 30 | $self->{CompSize} += length ${ $_[0] } ; 31 | $self->{UnCompSize} = $self->{CompSize} ; 32 | 33 | if ( ref $_[1] ) 34 | { ${ $_[1] } .= ${ $_[0] } } 35 | else 36 | { $_[1] .= ${ $_[0] } } 37 | } 38 | 39 | return STATUS_OK ; 40 | } 41 | 42 | sub flush 43 | { 44 | my $self = shift ; 45 | 46 | return STATUS_OK; 47 | } 48 | 49 | sub close 50 | { 51 | my $self = shift ; 52 | 53 | return STATUS_OK; 54 | } 55 | 56 | sub reset 57 | { 58 | my $self = shift ; 59 | 60 | $self->{CompSize} = 0; 61 | $self->{UnCompSize} = 0; 62 | 63 | return STATUS_OK; 64 | } 65 | 66 | sub deflateParams 67 | { 68 | my $self = shift ; 69 | 70 | return STATUS_OK; 71 | } 72 | 73 | #sub total_out 74 | #{ 75 | # my $self = shift ; 76 | # return $self->{UnCompSize} ; 77 | #} 78 | # 79 | #sub total_in 80 | #{ 81 | # my $self = shift ; 82 | # return $self->{UnCompSize} ; 83 | #} 84 | 85 | sub compressedBytes 86 | { 87 | my $self = shift ; 88 | return $self->{UnCompSize} ; 89 | } 90 | 91 | sub uncompressedBytes 92 | { 93 | my $self = shift ; 94 | return $self->{UnCompSize} ; 95 | } 96 | 97 | 1; 98 | 99 | 100 | __END__ 101 | -------------------------------------------------------------------------------- /lib/IO/Compress/Gzip/Constants.pm: -------------------------------------------------------------------------------- 1 | package IO::Compress::Gzip::Constants; 2 | 3 | use strict ; 4 | use warnings; 5 | use bytes; 6 | 7 | require Exporter; 8 | 9 | our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); 10 | our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE); 11 | 12 | $VERSION = '2.213'; 13 | 14 | @ISA = qw(Exporter); 15 | 16 | @EXPORT= qw( 17 | 18 | GZIP_ID_SIZE 19 | GZIP_ID1 20 | GZIP_ID2 21 | 22 | GZIP_FLG_DEFAULT 23 | GZIP_FLG_FTEXT 24 | GZIP_FLG_FHCRC 25 | GZIP_FLG_FEXTRA 26 | GZIP_FLG_FNAME 27 | GZIP_FLG_FCOMMENT 28 | GZIP_FLG_RESERVED 29 | 30 | GZIP_CM_DEFLATED 31 | 32 | GZIP_MIN_HEADER_SIZE 33 | GZIP_TRAILER_SIZE 34 | 35 | GZIP_MTIME_DEFAULT 36 | GZIP_XFL_DEFAULT 37 | GZIP_FEXTRA_HEADER_SIZE 38 | GZIP_FEXTRA_MAX_SIZE 39 | GZIP_FEXTRA_SUBFIELD_HEADER_SIZE 40 | GZIP_FEXTRA_SUBFIELD_ID_SIZE 41 | GZIP_FEXTRA_SUBFIELD_LEN_SIZE 42 | GZIP_FEXTRA_SUBFIELD_MAX_SIZE 43 | 44 | $GZIP_FNAME_INVALID_CHAR_RE 45 | $GZIP_FCOMMENT_INVALID_CHAR_RE 46 | 47 | GZIP_FHCRC_SIZE 48 | 49 | GZIP_ISIZE_MAX 50 | GZIP_ISIZE_MOD_VALUE 51 | 52 | 53 | GZIP_NULL_BYTE 54 | 55 | GZIP_OS_DEFAULT 56 | 57 | %GZIP_OS_Names 58 | 59 | GZIP_MINIMUM_HEADER 60 | 61 | ); 62 | 63 | # Constant names derived from RFC 1952 64 | 65 | use constant GZIP_ID_SIZE => 2 ; 66 | use constant GZIP_ID1 => 0x1F; 67 | use constant GZIP_ID2 => 0x8B; 68 | 69 | use constant GZIP_MIN_HEADER_SIZE => 10 ;# minimum gzip header size 70 | use constant GZIP_TRAILER_SIZE => 8 ; 71 | 72 | 73 | use constant GZIP_FLG_DEFAULT => 0x00 ; 74 | use constant GZIP_FLG_FTEXT => 0x01 ; 75 | use constant GZIP_FLG_FHCRC => 0x02 ; # called CONTINUATION in gzip 76 | use constant GZIP_FLG_FEXTRA => 0x04 ; 77 | use constant GZIP_FLG_FNAME => 0x08 ; 78 | use constant GZIP_FLG_FCOMMENT => 0x10 ; 79 | #use constant GZIP_FLG_ENCRYPTED => 0x20 ; # documented in gzip sources 80 | use constant GZIP_FLG_RESERVED => (0x20 | 0x40 | 0x80) ; 81 | 82 | use constant GZIP_XFL_DEFAULT => 0x00 ; 83 | 84 | use constant GZIP_MTIME_DEFAULT => 0x00 ; 85 | 86 | use constant GZIP_FEXTRA_HEADER_SIZE => 2 ; 87 | use constant GZIP_FEXTRA_MAX_SIZE => 0xFFFF ; 88 | use constant GZIP_FEXTRA_SUBFIELD_ID_SIZE => 2 ; 89 | use constant GZIP_FEXTRA_SUBFIELD_LEN_SIZE => 2 ; 90 | use constant GZIP_FEXTRA_SUBFIELD_HEADER_SIZE => GZIP_FEXTRA_SUBFIELD_ID_SIZE + 91 | GZIP_FEXTRA_SUBFIELD_LEN_SIZE; 92 | use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => GZIP_FEXTRA_MAX_SIZE - 93 | GZIP_FEXTRA_SUBFIELD_HEADER_SIZE ; 94 | 95 | 96 | if (ord('A') == 193) 97 | { 98 | # EBCDIC 99 | $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x3f\xff]'; 100 | $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x0a\x11-\x14\x16-\x3f\xff]'; 101 | 102 | } 103 | else 104 | { 105 | $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x1F\x7F-\x9F]'; 106 | $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x09\x11-\x1F\x7F-\x9F]'; 107 | } 108 | 109 | use constant GZIP_FHCRC_SIZE => 2 ; # aka CONTINUATION in gzip 110 | 111 | use constant GZIP_CM_DEFLATED => 8 ; 112 | 113 | use constant GZIP_NULL_BYTE => "\x00"; 114 | use constant GZIP_ISIZE_MAX => 0xFFFFFFFF ; 115 | use constant GZIP_ISIZE_MOD_VALUE => GZIP_ISIZE_MAX + 1 ; 116 | 117 | # OS Names sourced from http://www.gzip.org/format.txt 118 | 119 | use constant GZIP_OS_DEFAULT=> 0xFF ; 120 | %GZIP_OS_Names = ( 121 | 0 => 'MS-DOS', 122 | 1 => 'Amiga', 123 | 2 => 'VMS', 124 | 3 => 'Unix', 125 | 4 => 'VM/CMS', 126 | 5 => 'Atari TOS', 127 | 6 => 'HPFS (OS/2, NT)', 128 | 7 => 'Macintosh', 129 | 8 => 'Z-System', 130 | 9 => 'CP/M', 131 | 10 => 'TOPS-20', 132 | 11 => 'NTFS (NT)', 133 | 12 => 'SMS QDOS', 134 | 13 => 'Acorn RISCOS', 135 | 14 => 'VFAT file system (Win95, NT)', 136 | 15 => 'MVS', 137 | 16 => 'BeOS', 138 | 17 => 'Tandem/NSK', 139 | 18 => 'THEOS', 140 | GZIP_OS_DEFAULT() => 'Unknown', 141 | ) ; 142 | 143 | use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", 144 | GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT, 145 | GZIP_MTIME_DEFAULT, GZIP_XFL_DEFAULT, GZIP_OS_DEFAULT) ; 146 | 147 | 148 | 1; 149 | -------------------------------------------------------------------------------- /lib/IO/Compress/Zip/Constants.pm: -------------------------------------------------------------------------------- 1 | package IO::Compress::Zip::Constants; 2 | 3 | use strict ; 4 | use warnings; 5 | 6 | require Exporter; 7 | 8 | our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS); 9 | 10 | $VERSION = '2.213'; 11 | 12 | @ISA = qw(Exporter); 13 | 14 | @EXPORT= qw( 15 | 16 | ZIP_CM_STORE 17 | ZIP_CM_DEFLATE 18 | ZIP_CM_BZIP2 19 | ZIP_CM_LZMA 20 | ZIP_CM_PPMD 21 | ZIP_CM_XZ 22 | ZIP_CM_ZSTD 23 | ZIP_CM_AES 24 | 25 | ZIP_LOCAL_HDR_SIG 26 | ZIP_DATA_HDR_SIG 27 | ZIP_CENTRAL_HDR_SIG 28 | ZIP_END_CENTRAL_HDR_SIG 29 | ZIP64_END_CENTRAL_REC_HDR_SIG 30 | ZIP64_END_CENTRAL_LOC_HDR_SIG 31 | ZIP64_ARCHIVE_EXTRA_SIG 32 | ZIP64_DIGITAL_SIGNATURE_SIG 33 | 34 | ZIP_GP_FLAG_ENCRYPTED_MASK 35 | ZIP_GP_FLAG_STREAMING_MASK 36 | ZIP_GP_FLAG_PATCHED_MASK 37 | ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK 38 | ZIP_GP_FLAG_LZMA_EOS_PRESENT 39 | ZIP_GP_FLAG_LANGUAGE_ENCODING 40 | 41 | ZIP_EXTRA_ID_ZIP64 42 | ZIP_EXTRA_ID_EXT_TIMESTAMP 43 | ZIP_EXTRA_ID_INFO_ZIP_UNIX2 44 | ZIP_EXTRA_ID_INFO_ZIP_UNIXN 45 | ZIP_EXTRA_ID_INFO_ZIP_Upath 46 | ZIP_EXTRA_ID_INFO_ZIP_Ucom 47 | ZIP_EXTRA_ID_JAVA_EXE 48 | 49 | ZIP_OS_CODE_UNIX 50 | ZIP_OS_CODE_DEFAULT 51 | 52 | ZIP_IFA_TEXT_MASK 53 | 54 | %ZIP_CM_MIN_VERSIONS 55 | ZIP64_MIN_VERSION 56 | 57 | ZIP_A_RONLY 58 | ZIP_A_HIDDEN 59 | ZIP_A_SYSTEM 60 | ZIP_A_LABEL 61 | ZIP_A_DIR 62 | ZIP_A_ARCHIVE 63 | ); 64 | 65 | # Compression types supported 66 | use constant ZIP_CM_STORE => 0 ; 67 | use constant ZIP_CM_DEFLATE => 8 ; 68 | use constant ZIP_CM_BZIP2 => 12 ; 69 | use constant ZIP_CM_LZMA => 14 ; 70 | use constant ZIP_CM_ZSTD => 93 ; 71 | use constant ZIP_CM_XZ => 95 ; 72 | use constant ZIP_CM_PPMD => 98 ; # Not Supported yet 73 | use constant ZIP_CM_AES => 99 ; 74 | 75 | # General Purpose Flag 76 | use constant ZIP_GP_FLAG_ENCRYPTED_MASK => (1 << 0) ; 77 | use constant ZIP_GP_FLAG_STREAMING_MASK => (1 << 3) ; 78 | use constant ZIP_GP_FLAG_PATCHED_MASK => (1 << 5) ; 79 | use constant ZIP_GP_FLAG_STRONG_ENCRYPTED_MASK => (1 << 6) ; 80 | use constant ZIP_GP_FLAG_LZMA_EOS_PRESENT => (1 << 1) ; 81 | use constant ZIP_GP_FLAG_LANGUAGE_ENCODING => (1 << 11) ; 82 | 83 | # Internal File Attributes 84 | use constant ZIP_IFA_TEXT_MASK => 1; 85 | 86 | # Signatures for each of the headers 87 | use constant ZIP_LOCAL_HDR_SIG => 0x04034b50; 88 | use constant ZIP_DATA_HDR_SIG => 0x08074b50; 89 | use constant packed_ZIP_DATA_HDR_SIG => pack "V", ZIP_DATA_HDR_SIG; 90 | use constant ZIP_CENTRAL_HDR_SIG => 0x02014b50; 91 | use constant ZIP_END_CENTRAL_HDR_SIG => 0x06054b50; 92 | use constant ZIP64_END_CENTRAL_REC_HDR_SIG => 0x06064b50; 93 | use constant ZIP64_END_CENTRAL_LOC_HDR_SIG => 0x07064b50; 94 | use constant ZIP64_ARCHIVE_EXTRA_SIG => 0x08064b50; 95 | use constant ZIP64_DIGITAL_SIGNATURE_SIG => 0x05054b50; 96 | 97 | use constant ZIP_OS_CODE_UNIX => 3; 98 | use constant ZIP_OS_CODE_DEFAULT => 3; 99 | 100 | # Extra Field ID's 101 | use constant ZIP_EXTRA_ID_ZIP64 => pack "v", 1; 102 | use constant ZIP_EXTRA_ID_EXT_TIMESTAMP => "UT"; 103 | use constant ZIP_EXTRA_ID_INFO_ZIP_UNIX2 => "Ux"; 104 | use constant ZIP_EXTRA_ID_INFO_ZIP_UNIXN => "ux"; 105 | use constant ZIP_EXTRA_ID_INFO_ZIP_Upath => "up"; 106 | use constant ZIP_EXTRA_ID_INFO_ZIP_Ucom => "uc"; 107 | use constant ZIP_EXTRA_ID_JAVA_EXE => pack "v", 0xCAFE; 108 | 109 | # DOS Attributes 110 | use constant ZIP_A_RONLY => 0x01; 111 | use constant ZIP_A_HIDDEN => 0x02; 112 | use constant ZIP_A_SYSTEM => 0x04; 113 | use constant ZIP_A_LABEL => 0x08; 114 | use constant ZIP_A_DIR => 0x10; 115 | use constant ZIP_A_ARCHIVE => 0x20; 116 | 117 | use constant ZIP64_MIN_VERSION => 45; 118 | 119 | %ZIP_CM_MIN_VERSIONS = ( 120 | ZIP_CM_STORE() => 20, 121 | ZIP_CM_DEFLATE() => 20, 122 | ZIP_CM_BZIP2() => 46, 123 | ZIP_CM_LZMA() => 63, 124 | ZIP_CM_PPMD() => 63, 125 | ZIP_CM_ZSTD() => 20, # Winzip needs these to be 20 126 | ZIP_CM_XZ() => 20, 127 | ); 128 | 129 | 130 | 1; 131 | 132 | __END__ 133 | -------------------------------------------------------------------------------- /lib/IO/Compress/Zip/WeakDecrypt.pm: -------------------------------------------------------------------------------- 1 | package IO::Compress::Zip::WeakDecrypt ; 2 | 3 | # This code is derived from ... 4 | # Below is the 5 | # ############################################################################## 6 | # 7 | # Decrypt section 8 | # 9 | # H.Merijn Brand (Tux) 2011-06-28 10 | # 11 | # ############################################################################## 12 | 13 | # This code is derived from the crypt source of unzip-6.0 dated 05 Jan 2007 14 | # Its license states: 15 | # 16 | # --8<--- 17 | # Copyright (c) 1990-2007 Info-ZIP. All rights reserved. 18 | 19 | # See the accompanying file LICENSE, version 2005-Feb-10 or later 20 | # (the contents of which are also included in (un)zip.h) for terms of use. 21 | # If, for some reason, all these files are missing, the Info-ZIP license 22 | # also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html 23 | # 24 | # crypt.c (full version) by Info-ZIP. Last revised: [see crypt.h] 25 | 26 | # The main encryption/decryption source code for Info-Zip software was 27 | # originally written in Europe. To the best of our knowledge, it can 28 | # be freely distributed in both source and object forms from any country, 29 | # including the USA under License Exception TSU of the U.S. Export 30 | # Administration Regulations (section 740.13(e)) of 6 June 2002. 31 | 32 | # NOTE on copyright history: 33 | # Previous versions of this source package (up to version 2.8) were 34 | # not copyrighted and put in the public domain. If you cannot comply 35 | # with the Info-Zip LICENSE, you may want to look for one of those 36 | # public domain versions. 37 | # 38 | # This encryption code is a direct transcription of the algorithm from 39 | # Roger Schlafly, described by Phil Katz in the file appnote.txt. This 40 | # file (appnote.txt) is distributed with the PKZIP program (even in the 41 | # version without encryption capabilities). 42 | # -->8--- 43 | 44 | # As of January 2000, US export regulations were amended to allow export 45 | # of free encryption source code from the US. As of June 2002, these 46 | # regulations were further relaxed to allow export of encryption binaries 47 | # associated with free encryption source code. The Zip 2.31, UnZip 5.52 48 | # and Wiz 5.02 archives now include full crypto source code. As of the 49 | # Zip 2.31 release, all official binaries include encryption support; the 50 | # former "zcr" archives ceased to exist. 51 | # (Note that restrictions may still exist in other countries, of course.) 52 | 53 | use Data::Peek; 54 | 55 | my @keys; 56 | my @crct = do { 57 | my $xor = 0xedb88320; 58 | my @crc = (0) x 1024; 59 | 60 | # generate a crc for every 8-bit value 61 | foreach my $n (0 .. 255) { 62 | my $c = $n; 63 | $c = $c & 1 ? $xor ^ ($c >> 1) : $c >> 1 for 1 .. 8; 64 | $crc[$n] = _revbe($c); 65 | } 66 | 67 | # generate crc for each value followed by one, two, and three zeros */ 68 | foreach my $n (0 .. 255) { 69 | my $c = ($crc[($crc[$n] >> 24) ^ 0] ^ ($crc[$n] << 8)) & 0xffffffff; 70 | $crc[$_ * 256 + $n] = $c for 1 .. 3; 71 | } 72 | map { _revbe($crc[$_]) } 0 .. 1023; 73 | }; 74 | 75 | sub new 76 | { 77 | my $self = shift; 78 | my $password = shift; 79 | my $crc32 = shift; 80 | my $lastModFileDateTime = shift; 81 | my $streaming = shift; 82 | 83 | @keys = (0x12345678, 0x23456789, 0x34567890); 84 | _update_keys($_) 85 | for unpack "C*", $password; 86 | 87 | my %object = ( 88 | password => $password, 89 | pending => "", 90 | headerDecoded => 0, 91 | error => "", 92 | errorNo => 0, 93 | 94 | # data needed for the encryption header 95 | crc32 => $crc32, 96 | lastModFileDateTime => $lastModFileDateTime, 97 | streaming => $streaming, 98 | ); 99 | 100 | return bless \%object, $self; 101 | } 102 | 103 | sub decode 104 | { 105 | my $self = shift; 106 | my $buff = shift; 107 | my $offset = shift ; 108 | 109 | # return "" 110 | # if $offset >= length($$buff); 111 | 112 | # warn "decode : \n" ; DHexDump $$buff; 113 | 114 | if (! $self->{headerDecoded}) 115 | { 116 | $self->{pending} .= substr($$buff, $offset); 117 | # $self->{pending} .= $$buff ; 118 | # warn "PENDING: " . length($self->{pending}) . "\n" ; DHexDump($self->{pending}); 119 | 120 | # if (length($buff) + length($self->{pending}) < 12) 121 | if (length{pending} < 12) 122 | { 123 | return ""; 124 | } 125 | 126 | # DDumper { uk => [ @keys ] }; 127 | 128 | my $head = substr $self->{pending}, 0, 12, ""; 129 | # warn "HEAD: " . length($head) . "\n" ; DHexDump($head); 130 | 131 | # DHexDump $head; 132 | my @head = map { _zdecode($_) } unpack "C*", $head; 133 | my $x = $self->{streaming} 134 | ? ($self->{lastModFileDateTime} >> 8) & 0xff 135 | : $self->{crc32} >> 24; 136 | $x = $self->{crc32} >> 24; 137 | $x = ($self->{lastModFileDateTime} >> 8) & 0xff ; 138 | # DHexDump $x; 139 | 140 | $head[-1] == $x 141 | or return $self->_error("Password Invalid"); 142 | 143 | # warn "Password OK\n"; 144 | # # Worth checking ... 145 | # $self->{crc32c} = (unpack LOCAL_FILE_HEADER_FORMAT, pack "C*", @head)[3]; 146 | 147 | substr($$buff, $offset) = $self->{pending} ; 148 | # $$buff = $self->{pending} ; 149 | $self->{pending} = ''; 150 | $self->{headerDecoded} = 1; 151 | } 152 | 153 | # print "BEFORE: " . DHexDump ($$buff); 154 | my $undecoded = pack "C*" => map { _zdecode($_) } unpack "C*" => $$buff; 155 | # print "AFTER: " . DHexDump ($undecoded); 156 | 157 | # DHexDump ($buff); 158 | return $undecoded; 159 | } 160 | 161 | sub getError 162 | { 163 | my $self = shift; 164 | return $self->{error}; 165 | } 166 | 167 | sub getErrorNo 168 | { 169 | my $self = shift; 170 | return $self->{errorNo}; 171 | } 172 | 173 | #### Private 174 | 175 | sub _error 176 | { 177 | my $self = shift; 178 | 179 | $self->{error} = shift; 180 | $self->{errorNo} = -1; 181 | return undef 182 | } 183 | 184 | 185 | 186 | sub _crc32 187 | { 188 | my ($c, $b) = @_; 189 | 190 | return ($crct[($c ^ $b) & 0xff] ^ ($c >> 8)); 191 | } # _crc32 192 | 193 | sub _revbe 194 | { 195 | my $w = shift; 196 | 197 | return (($w >> 24) + 198 | (($w >> 8) & 0xff00) + 199 | (($w & 0xff00) << 8) + 200 | (($w & 0xff) << 24)); 201 | } # _revbe 202 | 203 | sub _update_keys 204 | { 205 | use integer; 206 | my $c = shift; # signed int 207 | 208 | $keys[0] = _crc32($keys[0], $c); 209 | $keys[1] = (($keys[1] + ($keys[0] & 0xff)) * 0x08088405 + 1) & 0xffffffff; 210 | my $keyshift = $keys[1] >> 24; 211 | $keys[2] = _crc32($keys[2], $keyshift); 212 | } # _update_keys 213 | 214 | sub _zdecode ($) 215 | { 216 | my $c = shift; 217 | 218 | my $t = ($keys[2] & 0xffff) | 2; 219 | _update_keys($c ^= ((($t * ($t ^ 1)) >> 8) & 0xff)); 220 | return $c; 221 | } 222 | 223 | 224 | 225 | 1; 226 | -------------------------------------------------------------------------------- /lib/IO/Compress/Zlib/Constants.pm: -------------------------------------------------------------------------------- 1 | 2 | package IO::Compress::Zlib::Constants ; 3 | 4 | use strict ; 5 | use warnings; 6 | use bytes; 7 | 8 | require Exporter; 9 | 10 | our ($VERSION, @ISA, @EXPORT); 11 | 12 | $VERSION = '2.213'; 13 | 14 | @ISA = qw(Exporter); 15 | 16 | @EXPORT= qw( 17 | 18 | ZLIB_HEADER_SIZE 19 | ZLIB_TRAILER_SIZE 20 | 21 | ZLIB_CMF_CM_OFFSET 22 | ZLIB_CMF_CM_BITS 23 | ZLIB_CMF_CM_DEFLATED 24 | 25 | ZLIB_CMF_CINFO_OFFSET 26 | ZLIB_CMF_CINFO_BITS 27 | ZLIB_CMF_CINFO_MAX 28 | 29 | ZLIB_FLG_FCHECK_OFFSET 30 | ZLIB_FLG_FCHECK_BITS 31 | 32 | ZLIB_FLG_FDICT_OFFSET 33 | ZLIB_FLG_FDICT_BITS 34 | 35 | ZLIB_FLG_LEVEL_OFFSET 36 | ZLIB_FLG_LEVEL_BITS 37 | 38 | ZLIB_FLG_LEVEL_FASTEST 39 | ZLIB_FLG_LEVEL_FAST 40 | ZLIB_FLG_LEVEL_DEFAULT 41 | ZLIB_FLG_LEVEL_SLOWEST 42 | 43 | ZLIB_FDICT_SIZE 44 | 45 | ); 46 | 47 | # Constant names derived from RFC1950 48 | 49 | use constant ZLIB_HEADER_SIZE => 2; 50 | use constant ZLIB_TRAILER_SIZE => 4; 51 | 52 | use constant ZLIB_CMF_CM_OFFSET => 0; 53 | use constant ZLIB_CMF_CM_BITS => 0xF ; # 0b1111 54 | use constant ZLIB_CMF_CM_DEFLATED => 8; 55 | 56 | use constant ZLIB_CMF_CINFO_OFFSET => 4; 57 | use constant ZLIB_CMF_CINFO_BITS => 0xF ; # 0b1111; 58 | use constant ZLIB_CMF_CINFO_MAX => 7; 59 | 60 | use constant ZLIB_FLG_FCHECK_OFFSET => 0; 61 | use constant ZLIB_FLG_FCHECK_BITS => 0x1F ; # 0b11111; 62 | 63 | use constant ZLIB_FLG_FDICT_OFFSET => 5; 64 | use constant ZLIB_FLG_FDICT_BITS => 0x1 ; # 0b1; 65 | 66 | use constant ZLIB_FLG_LEVEL_OFFSET => 6; 67 | use constant ZLIB_FLG_LEVEL_BITS => 0x3 ; # 0b11; 68 | 69 | use constant ZLIB_FLG_LEVEL_FASTEST => 0; 70 | use constant ZLIB_FLG_LEVEL_FAST => 1; 71 | use constant ZLIB_FLG_LEVEL_DEFAULT => 2; 72 | use constant ZLIB_FLG_LEVEL_SLOWEST => 3; 73 | 74 | use constant ZLIB_FDICT_SIZE => 4; 75 | 76 | 77 | 1; 78 | -------------------------------------------------------------------------------- /lib/IO/Compress/Zlib/Extra.pm: -------------------------------------------------------------------------------- 1 | package IO::Compress::Zlib::Extra; 2 | 3 | require 5.006 ; 4 | 5 | use strict ; 6 | use warnings; 7 | use bytes; 8 | 9 | our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); 10 | 11 | $VERSION = '2.213'; 12 | 13 | use IO::Compress::Gzip::Constants 2.213 ; 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 | sub findID 102 | { 103 | my $id_want = shift ; 104 | my $data = shift; 105 | 106 | my $XLEN = length $data ; 107 | 108 | my $offset = 0 ; 109 | while ($offset < $XLEN) { 110 | 111 | return undef 112 | if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; 113 | 114 | my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); 115 | $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; 116 | 117 | my $subLen = unpack("v", substr($data, $offset, 118 | GZIP_FEXTRA_SUBFIELD_LEN_SIZE)); 119 | $offset += GZIP_FEXTRA_SUBFIELD_LEN_SIZE ; 120 | 121 | return undef 122 | if $offset + $subLen > $XLEN ; 123 | 124 | return substr($data, $offset, $subLen) 125 | if $id eq $id_want ; 126 | 127 | $offset += $subLen ; 128 | } 129 | 130 | return undef ; 131 | } 132 | 133 | 134 | sub mkSubField 135 | { 136 | my $id = shift ; 137 | my $data = shift ; 138 | 139 | return $id . pack("v", length $data) . $data ; 140 | } 141 | 142 | sub parseExtraField 143 | { 144 | my $dataRef = $_[0]; 145 | my $strict = $_[1]; 146 | my $gzipMode = $_[2]; 147 | #my $lax = @_ == 2 ? $_[1] : 1; 148 | 149 | 150 | # ExtraField can be any of 151 | # 152 | # -ExtraField => $data 153 | # 154 | # -ExtraField => [$id1, $data1, 155 | # $id2, $data2] 156 | # ... 157 | # ] 158 | # 159 | # -ExtraField => [ [$id1 => $data1], 160 | # [$id2 => $data2], 161 | # ... 162 | # ] 163 | # 164 | # -ExtraField => { $id1 => $data1, 165 | # $id2 => $data2, 166 | # ... 167 | # } 168 | 169 | if ( ! ref $dataRef ) { 170 | 171 | return undef 172 | if ! $strict; 173 | 174 | return parseRawExtra($dataRef, undef, 1, $gzipMode); 175 | } 176 | 177 | my $data = $dataRef; 178 | my $out = '' ; 179 | 180 | if (ref $data eq 'ARRAY') { 181 | if (ref $data->[0]) { 182 | 183 | foreach my $pair (@$data) { 184 | return ExtraFieldError("Not list of lists") 185 | unless ref $pair eq 'ARRAY' ; 186 | 187 | my $bad = validateExtraFieldPair($pair, $strict, $gzipMode) ; 188 | return $bad if $bad ; 189 | 190 | $out .= mkSubField(@$pair); 191 | } 192 | } 193 | else { 194 | return ExtraFieldError("Not even number of elements") 195 | unless @$data % 2 == 0; 196 | 197 | for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) { 198 | my $bad = validateExtraFieldPair([$data->[$ix], 199 | $data->[$ix+1]], 200 | $strict, $gzipMode) ; 201 | return $bad if $bad ; 202 | 203 | $out .= mkSubField($data->[$ix], $data->[$ix+1]); 204 | } 205 | } 206 | } 207 | elsif (ref $data eq 'HASH') { 208 | while (my ($id, $info) = each %$data) { 209 | my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode); 210 | return $bad if $bad ; 211 | 212 | $out .= mkSubField($id, $info); 213 | } 214 | } 215 | else { 216 | return ExtraFieldError("Not a scalar, array ref or hash ref") ; 217 | } 218 | 219 | return ExtraFieldError("Too Large") 220 | if length $out > GZIP_FEXTRA_MAX_SIZE; 221 | 222 | $_[0] = $out ; 223 | 224 | return undef; 225 | } 226 | 227 | 1; 228 | 229 | __END__ 230 | -------------------------------------------------------------------------------- /lib/IO/Uncompress/Adapter/Bunzip2.pm: -------------------------------------------------------------------------------- 1 | package IO::Uncompress::Adapter::Bunzip2; 2 | 3 | use strict; 4 | use warnings; 5 | use bytes; 6 | 7 | use IO::Compress::Base::Common 2.213 qw(:Status); 8 | 9 | use Compress::Raw::Bzip2 2.213 ; 10 | 11 | our ($VERSION, @ISA); 12 | $VERSION = '2.213'; 13 | 14 | sub mkUncompObject 15 | { 16 | my $small = shift || 0; 17 | my $verbosity = shift || 0; 18 | 19 | my ($inflate, $status) = Compress::Raw::Bunzip2->new(1, 1, $small, $verbosity, 1); 20 | 21 | return (undef, "Could not create Inflation object: $status", $status) 22 | if $status != BZ_OK ; 23 | 24 | return bless {'Inf' => $inflate, 25 | 'CompSize' => 0, 26 | 'UnCompSize' => 0, 27 | 'Error' => '', 28 | 'ConsumesInput' => 1, 29 | } ; 30 | 31 | } 32 | 33 | sub uncompr 34 | { 35 | my $self = shift ; 36 | my $from = shift ; 37 | my $to = shift ; 38 | my $eof = shift ; 39 | 40 | my $inf = $self->{Inf}; 41 | 42 | my $status = $inf->bzinflate($from, $to); 43 | $self->{ErrorNo} = $status; 44 | 45 | if ($status != BZ_OK && $status != BZ_STREAM_END ) 46 | { 47 | $self->{Error} = "Inflation Error: $status"; 48 | return STATUS_ERROR; 49 | } 50 | 51 | 52 | return STATUS_OK if $status == BZ_OK ; 53 | return STATUS_ENDSTREAM if $status == BZ_STREAM_END ; 54 | return STATUS_ERROR ; 55 | } 56 | 57 | 58 | sub reset 59 | { 60 | my $self = shift ; 61 | 62 | my ($inf, $status) = Compress::Raw::Bunzip2->new(); 63 | $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; 64 | 65 | if ($status != BZ_OK) 66 | { 67 | $self->{Error} = "Cannot create Inflate object: $status"; 68 | return STATUS_ERROR; 69 | } 70 | 71 | $self->{Inf} = $inf; 72 | 73 | return STATUS_OK ; 74 | } 75 | 76 | sub compressedBytes 77 | { 78 | my $self = shift ; 79 | $self->{Inf}->compressedBytes(); 80 | } 81 | 82 | sub uncompressedBytes 83 | { 84 | my $self = shift ; 85 | $self->{Inf}->uncompressedBytes(); 86 | } 87 | 88 | sub crc32 89 | { 90 | my $self = shift ; 91 | #$self->{Inf}->crc32(); 92 | } 93 | 94 | sub adler32 95 | { 96 | my $self = shift ; 97 | #$self->{Inf}->adler32(); 98 | } 99 | 100 | sub sync 101 | { 102 | my $self = shift ; 103 | #( $self->{Inf}->inflateSync(@_) == BZ_OK) 104 | # ? STATUS_OK 105 | # : STATUS_ERROR ; 106 | } 107 | 108 | 109 | 1; 110 | 111 | __END__ 112 | -------------------------------------------------------------------------------- /lib/IO/Uncompress/Adapter/Identity.pm: -------------------------------------------------------------------------------- 1 | package IO::Uncompress::Adapter::Identity; 2 | 3 | use warnings; 4 | use strict; 5 | use bytes; 6 | 7 | use IO::Compress::Base::Common 2.213 qw(:Status); 8 | use IO::Compress::Zip::Constants ; 9 | 10 | our ($VERSION); 11 | 12 | $VERSION = '2.213'; 13 | 14 | use Compress::Raw::Zlib 2.213 (); 15 | 16 | sub mkUncompObject 17 | { 18 | my $streaming = shift; 19 | my $zip64 = shift; 20 | 21 | my $crc32 = 1; #shift ; 22 | my $adler32 = shift; 23 | 24 | bless { 'CompSize' => U64->new(), # 0, 25 | 'UnCompSize' => 0, 26 | 'wantCRC32' => $crc32, 27 | 'CRC32' => Compress::Raw::Zlib::crc32(''), 28 | 'wantADLER32'=> $adler32, 29 | 'ADLER32' => Compress::Raw::Zlib::adler32(''), 30 | 'ConsumesInput' => 1, 31 | 'Streaming' => $streaming, 32 | 'Zip64' => $zip64, 33 | 'DataHdrSize' => $zip64 ? 24 : 16, 34 | 'Pending' => '', 35 | 36 | } ; 37 | } 38 | 39 | 40 | sub uncompr 41 | { 42 | my $self = shift; 43 | my $in = $_[0]; 44 | my $eof = $_[2]; 45 | 46 | my $len = length $$in; 47 | my $remainder = ''; 48 | 49 | if (defined $$in && $len) { 50 | 51 | if ($self->{Streaming}) { 52 | 53 | if (length $self->{Pending}) { 54 | $$in = $self->{Pending} . $$in ; 55 | $len = length $$in; 56 | $self->{Pending} = ''; 57 | } 58 | 59 | my $ind = index($$in, "\x50\x4b\x07\x08"); 60 | 61 | if ($ind < 0) { 62 | $len = length $$in; 63 | if ($len >= 3 && substr($$in, -3) eq "\x50\x4b\x07") { 64 | $ind = $len - 3 ; 65 | } 66 | elsif ($len >= 2 && substr($$in, -2) eq "\x50\x4b") { 67 | $ind = $len - 2 ; 68 | } 69 | elsif ($len >= 1 && substr($$in, -1) eq "\x50") { 70 | $ind = $len - 1 ; 71 | } 72 | } 73 | 74 | if ($ind >= 0) { 75 | $remainder = substr($$in, $ind) ; 76 | substr($$in, $ind) = '' ; 77 | } 78 | } 79 | 80 | if (length $remainder && length $remainder < $self->{DataHdrSize}) { 81 | $self->{Pending} = $remainder ; 82 | $remainder = ''; 83 | } 84 | elsif (length $remainder >= $self->{DataHdrSize}) { 85 | my $crc = unpack "V", substr($remainder, 4); 86 | if ($crc == Compress::Raw::Zlib::crc32($$in, $self->{CRC32})) { 87 | my ($l1, $l2) ; 88 | 89 | if ($self->{Zip64}) { 90 | $l1 = U64::newUnpack_V64(substr($remainder, 8)); 91 | $l2 = U64::newUnpack_V64(substr($remainder, 16)); 92 | } 93 | else { 94 | $l1 = U64::newUnpack_V32(substr($remainder, 8)); 95 | $l2 = U64::newUnpack_V32(substr($remainder, 12)); 96 | } 97 | 98 | my $newLen = $self->{CompSize}->clone(); 99 | $newLen->add(length $$in); 100 | if ($l1->equal($l2) && $l1->equal($newLen) ) { 101 | $eof = 1; 102 | } 103 | else { 104 | $$in .= substr($remainder, 0, 4) ; 105 | $remainder = substr($remainder, 4); 106 | #$self->{Pending} = substr($remainder, 4); 107 | #$remainder = ''; 108 | $eof = 0; 109 | } 110 | } 111 | else { 112 | $$in .= substr($remainder, 0, 4) ; 113 | $remainder = substr($remainder, 4); 114 | #$self->{Pending} = substr($remainder, 4); 115 | #$remainder = ''; 116 | $eof = 0; 117 | } 118 | } 119 | 120 | if (length $$in) { 121 | $self->{CompSize}->add(length $$in) ; 122 | 123 | $self->{CRC32} = Compress::Raw::Zlib::crc32($$in, $self->{CRC32}) 124 | if $self->{wantCRC32}; 125 | 126 | $self->{ADLER32} = Compress::Zlib::adler32($$in, $self->{ADLER32}) 127 | if $self->{wantADLER32}; 128 | } 129 | 130 | ${ $_[1] } .= $$in; 131 | $$in = $remainder; 132 | } 133 | 134 | return STATUS_ENDSTREAM if $eof; 135 | return STATUS_OK ; 136 | } 137 | 138 | sub reset 139 | { 140 | my $self = shift; 141 | 142 | $self->{CompSize}->reset(); 143 | $self->{UnCompSize} = 0; 144 | $self->{CRC32} = Compress::Raw::Zlib::crc32(''); 145 | $self->{ADLER32} = Compress::Raw::Zlib::adler32(''); 146 | 147 | return STATUS_OK ; 148 | } 149 | 150 | #sub count 151 | #{ 152 | # my $self = shift ; 153 | # return $self->{UnCompSize} ; 154 | #} 155 | 156 | sub compressedBytes 157 | { 158 | my $self = shift ; 159 | return $self->{CompSize} ; 160 | } 161 | 162 | sub uncompressedBytes 163 | { 164 | my $self = shift ; 165 | return $self->{CompSize} ; 166 | } 167 | 168 | sub sync 169 | { 170 | return STATUS_OK ; 171 | } 172 | 173 | sub crc32 174 | { 175 | my $self = shift ; 176 | return $self->{CRC32}; 177 | } 178 | 179 | sub adler32 180 | { 181 | my $self = shift ; 182 | return $self->{ADLER32}; 183 | } 184 | 185 | 186 | 1; 187 | 188 | __END__ 189 | -------------------------------------------------------------------------------- /lib/IO/Uncompress/Adapter/Inflate.pm: -------------------------------------------------------------------------------- 1 | package IO::Uncompress::Adapter::Inflate; 2 | 3 | use strict; 4 | use warnings; 5 | use bytes; 6 | 7 | use IO::Compress::Base::Common 2.213 qw(:Status); 8 | use Compress::Raw::Zlib 2.213 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); 9 | 10 | our ($VERSION); 11 | $VERSION = '2.213'; 12 | 13 | 14 | 15 | sub mkUncompObject 16 | { 17 | my $crc32 = shift || 1; 18 | my $adler32 = shift || 1; 19 | my $scan = shift || 0; 20 | 21 | my $inflate ; 22 | my $status ; 23 | 24 | if ($scan) 25 | { 26 | ($inflate, $status) = Compress::Raw::Zlib::InflateScan->new( 27 | #LimitOutput => 1, 28 | CRC32 => $crc32, 29 | ADLER32 => $adler32, 30 | WindowBits => - MAX_WBITS ); 31 | } 32 | else 33 | { 34 | ($inflate, $status) = Compress::Raw::Zlib::Inflate->new( 35 | AppendOutput => 1, 36 | LimitOutput => 1, 37 | CRC32 => $crc32, 38 | ADLER32 => $adler32, 39 | WindowBits => - MAX_WBITS ); 40 | } 41 | 42 | return (undef, "Could not create Inflation object: $status", $status) 43 | if $status != Z_OK ; 44 | 45 | return bless {'Inf' => $inflate, 46 | 'CompSize' => 0, 47 | 'UnCompSize' => 0, 48 | 'Error' => '', 49 | 'ConsumesInput' => 1, 50 | } ; 51 | 52 | } 53 | 54 | sub uncompr 55 | { 56 | my $self = shift ; 57 | my $from = shift ; 58 | my $to = shift ; 59 | my $eof = shift ; 60 | 61 | my $inf = $self->{Inf}; 62 | 63 | my $status = $inf->inflate($from, $to, $eof); 64 | $self->{ErrorNo} = $status; 65 | if ($status != Z_OK && $status != Z_STREAM_END && $status != Z_BUF_ERROR) 66 | { 67 | $self->{Error} = "Inflation Error: $status"; 68 | return STATUS_ERROR; 69 | } 70 | 71 | return STATUS_OK if $status == Z_BUF_ERROR ; # ??? 72 | return STATUS_OK if $status == Z_OK ; 73 | return STATUS_ENDSTREAM if $status == Z_STREAM_END ; 74 | return STATUS_ERROR ; 75 | } 76 | 77 | sub reset 78 | { 79 | my $self = shift ; 80 | $self->{Inf}->inflateReset(); 81 | 82 | return STATUS_OK ; 83 | } 84 | 85 | #sub count 86 | #{ 87 | # my $self = shift ; 88 | # $self->{Inf}->inflateCount(); 89 | #} 90 | 91 | sub crc32 92 | { 93 | my $self = shift ; 94 | $self->{Inf}->crc32(); 95 | } 96 | 97 | sub compressedBytes 98 | { 99 | my $self = shift ; 100 | $self->{Inf}->compressedBytes(); 101 | } 102 | 103 | sub uncompressedBytes 104 | { 105 | my $self = shift ; 106 | $self->{Inf}->uncompressedBytes(); 107 | } 108 | 109 | sub adler32 110 | { 111 | my $self = shift ; 112 | $self->{Inf}->adler32(); 113 | } 114 | 115 | sub sync 116 | { 117 | my $self = shift ; 118 | ( $self->{Inf}->inflateSync(@_) == Z_OK) 119 | ? STATUS_OK 120 | : STATUS_ERROR ; 121 | } 122 | 123 | 124 | sub getLastBlockOffset 125 | { 126 | my $self = shift ; 127 | $self->{Inf}->getLastBlockOffset(); 128 | } 129 | 130 | sub getEndOffset 131 | { 132 | my $self = shift ; 133 | $self->{Inf}->getEndOffset(); 134 | } 135 | 136 | sub resetLastBlockByte 137 | { 138 | my $self = shift ; 139 | $self->{Inf}->resetLastBlockByte(@_); 140 | } 141 | 142 | sub createDeflateStream 143 | { 144 | my $self = shift ; 145 | my $deflate = $self->{Inf}->createDeflateStream(@_); 146 | return bless {'Def' => $deflate, 147 | 'CompSize' => 0, 148 | 'UnCompSize' => 0, 149 | 'Error' => '', 150 | }, 'IO::Compress::Adapter::Deflate'; 151 | } 152 | 153 | 1; 154 | 155 | 156 | __END__ 157 | -------------------------------------------------------------------------------- /lib/IO/Uncompress/Adapter/WeakDecrypt.pm: -------------------------------------------------------------------------------- 1 | package IO::Uncompress::Adapter::WeakDecrypt; 2 | 3 | use warnings; 4 | use strict; 5 | use bytes; 6 | 7 | 8 | use IO::Compress::Base::Common 2.213 qw(:Status); 9 | use IO::Compress::Zip::Constants ; 10 | 11 | our ($VERSION); 12 | 13 | $VERSION = '2.213'; 14 | 15 | sub mkDecryptObject 16 | { 17 | my $inner = shift; 18 | my $decrypt = shift; 19 | 20 | my $crc32 = 1; #shift ; 21 | my $adler32 = shift; 22 | 23 | bless { #'CompSize' => U64->new(), # 0, 24 | #'UnCompSize' => 0, 25 | #'wantCRC32' => $crc32, 26 | # 'CRC32' => Compress::Raw::Zlib::crc32(''), 27 | #'wantADLER32'=> $adler32, 28 | # 'ADLER32' => Compress::Raw::Zlib::adler32(''), 29 | #'ConsumesInput' => 1, 30 | # 'Streaming' => $streaming, 31 | # 'Zip64' => $zip64, 32 | # 'DataHdrSize' => $zip64 ? 24 : 16, 33 | # 'Pending' => '', 34 | 35 | 'Inner' => $inner, 36 | 'Decrypt' => $decrypt, 37 | 38 | } ; 39 | } 40 | 41 | 42 | sub uncompr 43 | { 44 | my $self = shift ; 45 | my $from = shift ; 46 | my $to = shift ; 47 | my $eof = shift ; 48 | 49 | my $encrypted ; 50 | use Data::Peek; 51 | # DHexDump ($$from); 52 | # warn "\n\nINNER compressed \n"; DHexDump ($$from); 53 | 54 | my $status = $self->{Inner}->uncompr($from, $to, $eof); 55 | # warn "OUTER uncompressed \n"; DHexDump ($$to); 56 | 57 | # use Compress::Raw::Zlib 2.213 qw(Z_OK Z_BUF_ERROR Z_STREAM_END ); 58 | 59 | # TODO - need to understand status from other compressors like bzip2, identiry etc 60 | return $status 61 | # unless $status == STATUS_OK || $status == STATUS_ENDSTREAM ; 62 | unless $status == STATUS_OK ; 63 | 64 | # $$from = ''; 65 | 66 | if (length $$to) 67 | { 68 | $$to = $self->{Decrypt}->decode($to, 0) ; 69 | # warn "decrypted :" . $self->{Decrypt}->getError() . "\n" ; DHexDump ($$to); 70 | 71 | $self->{Error} = $self->{Decrypt}->getError(); 72 | $self->{ErrorNo} = $self->{Decrypt}->getErrorNo() ; 73 | } 74 | else 75 | { 76 | die "EMPTY" 77 | } 78 | 79 | # if (length $$in) { 80 | # $self->{CompSize}->add(length $$in) ; 81 | 82 | # $self->{CRC32} = Compress::Raw::Zlib::crc32($$in, $self->{CRC32}) 83 | # if $self->{wantCRC32}; 84 | 85 | # $self->{ADLER32} = Compress::Zlib::adler32($$in, $self->{ADLER32}) 86 | # if $self->{wantADLER32}; 87 | # } 88 | 89 | # ${ $_[1] } .= $$in; 90 | # $$in = $remainder; 91 | 92 | # warn "stXXXXX Status " unless defined $$to; 93 | 94 | 95 | # return STATUS_ERROR unless defined $$to; 96 | return $status; 97 | # return STATUS_ENDSTREAM if $eof; 98 | # return STATUS_OK ; 99 | } 100 | 101 | sub reset 102 | { 103 | my $self = shift; 104 | 105 | $self->{Inner}->reset(); 106 | 107 | return STATUS_OK ; 108 | } 109 | 110 | #sub count 111 | #{ 112 | # my $self = shift ; 113 | # return $self->{UnCompSize} ; 114 | #} 115 | 116 | sub compressedBytes 117 | { 118 | my $self = shift ; 119 | return $self->{Inner}->{CompSize} ; 120 | } 121 | 122 | sub uncompressedBytes 123 | { 124 | my $self = shift ; 125 | return $self->{Inner}->{CompSize} ; 126 | } 127 | 128 | sub sync 129 | { 130 | return STATUS_OK ; 131 | } 132 | 133 | sub crc32 134 | { 135 | my $self = shift ; 136 | return $self->{Inner}->{CRC32}; 137 | } 138 | 139 | sub adler32 140 | { 141 | my $self = shift ; 142 | return $self->{Inner}->{ADLER32}; 143 | } 144 | 145 | 146 | 1; 147 | 148 | __END__ 149 | -------------------------------------------------------------------------------- /t/000prereq.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict ; 10 | use warnings ; 11 | 12 | use Test::More ; 13 | 14 | sub gotScalarUtilXS 15 | { 16 | eval ' use Scalar::Util "dualvar" '; 17 | return $@ ? 0 : 1 ; 18 | } 19 | 20 | BEGIN 21 | { 22 | # use Test::NoWarnings, if available 23 | my $extra = 0 ; 24 | $extra = 1 25 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 26 | 27 | 28 | my $VERSION = '2.213'; 29 | my @NAMES = qw( 30 | Compress::Raw::Bzip2 31 | Compress::Raw::Zlib 32 | 33 | Compress::Zlib 34 | 35 | IO::Compress::Adapter::Bzip2 36 | IO::Compress::Adapter::Deflate 37 | IO::Compress::Adapter::Identity 38 | IO::Compress::Base::Common 39 | IO::Compress::Base 40 | IO::Compress::Bzip2 41 | IO::Compress::Deflate 42 | IO::Compress::Gzip::Constants 43 | IO::Compress::Gzip 44 | IO::Compress::RawDeflate 45 | IO::Compress::Zip::Constants 46 | IO::Compress::Zip 47 | IO::Compress::Zlib::Constants 48 | IO::Compress::Zlib::Extra 49 | IO::Uncompress::Adapter::Bunzip2 50 | IO::Uncompress::Adapter::Identity 51 | IO::Uncompress::Adapter::Inflate 52 | IO::Uncompress::AnyInflate 53 | IO::Uncompress::AnyUncompress 54 | IO::Uncompress::Base 55 | IO::Uncompress::Bunzip2 56 | IO::Uncompress::Gunzip 57 | IO::Uncompress::Inflate 58 | IO::Uncompress::RawInflate 59 | IO::Uncompress::Unzip 60 | 61 | ); 62 | 63 | my @OPT = qw( 64 | ); 65 | 66 | plan tests => 1 + 2 + @NAMES + @OPT + $extra ; 67 | 68 | foreach my $name (@NAMES) 69 | { 70 | use_ok($name, $VERSION); 71 | } 72 | 73 | 74 | foreach my $name (@OPT) 75 | { 76 | eval " require $name " ; 77 | if ($@) 78 | { 79 | ok 1, "$name not available" 80 | } 81 | else 82 | { 83 | my $ver = eval("\$${name}::VERSION"); 84 | is $ver, $VERSION, "$name version should be $VERSION" 85 | or diag "$name version is $ver, need $VERSION" ; 86 | } 87 | } 88 | 89 | # need zlib 1.2.0 or better or zlib-ng 90 | 91 | ok Compress::Raw::Zlib::is_zlibng() || Compress::Raw::Zlib::ZLIB_VERNUM() >= 0x1200 92 | or diag "IO::Compress needs zlib 1.2.0 or better, you have " . Compress::Raw::Zlib::zlib_version(); 93 | 94 | use_ok('Scalar::Util') ; 95 | 96 | } 97 | 98 | ok gotScalarUtilXS(), "Got XS Version of Scalar::Util" 99 | or diag <import; 1 }; 23 | 24 | plan tests => 841 + $extra ; 25 | }; 26 | 27 | 28 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 29 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 30 | 31 | 32 | my $CompressClass = 'IO::Compress::Bzip2'; 33 | my $UncompressClass = getInverse($CompressClass); 34 | my $Error = getErrorRef($CompressClass); 35 | my $UnError = getErrorRef($UncompressClass); 36 | 37 | sub myBZreadFile 38 | { 39 | my $filename = shift ; 40 | my $init = shift ; 41 | 42 | 43 | my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, 44 | -Strict => 1, 45 | -Append => 1 46 | ); 47 | 48 | my $data = ''; 49 | $data = $init if defined $init ; 50 | 1 while $fil->read($data) > 0; 51 | 52 | $fil->close ; 53 | return $data ; 54 | } 55 | 56 | 57 | { 58 | 59 | title "Testing $CompressClass Errors"; 60 | 61 | my $buffer ; 62 | 63 | for my $value (undef, -1, 'fred') 64 | { 65 | my $stringValue = defined $value ? $value : 'undef'; 66 | title "BlockSize100K => $stringValue"; 67 | my $err = "Parameter 'BlockSize100K' must be an unsigned int, got '$stringValue'"; 68 | my $bz ; 69 | eval { $bz = IO::Compress::Bzip2->new(\$buffer, BlockSize100K => $value) }; 70 | like $@, mkErr("IO::Compress::Bzip2: $err"), 71 | " value $stringValue is bad"; 72 | is $Bzip2Error, "IO::Compress::Bzip2: $err", 73 | " value $stringValue is bad"; 74 | ok ! $bz, " no bz object"; 75 | } 76 | 77 | for my $value (0, 10, 99999) 78 | { 79 | my $stringValue = defined $value ? $value : 'undef'; 80 | title "BlockSize100K => $stringValue"; 81 | my $err = "Parameter 'BlockSize100K' not between 1 and 9, got $stringValue"; 82 | my $bz ; 83 | eval { $bz = IO::Compress::Bzip2->new(\$buffer, BlockSize100K => $value) }; 84 | like $@, mkErr("IO::Compress::Bzip2: $err"), 85 | " value $stringValue is bad"; 86 | is $Bzip2Error, "IO::Compress::Bzip2: $err", 87 | " value $stringValue is bad"; 88 | ok ! $bz, " no bz object"; 89 | } 90 | 91 | for my $value (undef, -1, 'fred') 92 | { 93 | my $stringValue = defined $value ? $value : 'undef'; 94 | title "WorkFactor => $stringValue"; 95 | my $err = "Parameter 'WorkFactor' must be an unsigned int, got '$stringValue'"; 96 | my $bz ; 97 | eval { $bz = IO::Compress::Bzip2->new(\$buffer, WorkFactor => $value) }; 98 | like $@, mkErr("IO::Compress::Bzip2: $err"), 99 | " value $stringValue is bad"; 100 | is $Bzip2Error, "IO::Compress::Bzip2: $err", 101 | " value $stringValue is bad"; 102 | ok ! $bz, " no bz object"; 103 | } 104 | 105 | for my $value (251, 99999) 106 | { 107 | my $stringValue = defined $value ? $value : 'undef'; 108 | title "WorkFactor => $stringValue"; 109 | my $err = "Parameter 'WorkFactor' not between 0 and 250, got $stringValue"; 110 | my $bz ; 111 | eval { $bz = IO::Compress::Bzip2->new(\$buffer, WorkFactor => $value) }; 112 | like $@, mkErr("IO::Compress::Bzip2: $err"), 113 | " value $stringValue is bad"; 114 | is $Bzip2Error, "IO::Compress::Bzip2: $err", 115 | " value $stringValue is bad"; 116 | ok ! $bz, " no bz object"; 117 | } 118 | 119 | } 120 | 121 | 122 | { 123 | title "Testing $UncompressClass Errors"; 124 | 125 | my $buffer ; 126 | 127 | for my $value (-1, 'fred') 128 | { 129 | my $stringValue = defined $value ? $value : 'undef'; 130 | title "Small => $stringValue"; 131 | my $err = "Parameter 'Small' must be an int, got '$stringValue'"; 132 | my $bz ; 133 | eval { $bz = IO::Uncompress::Bunzip2->new(\$buffer, Small => $value) }; 134 | like $@, mkErr("IO::Uncompress::Bunzip2: $err"), 135 | " value $stringValue is bad"; 136 | is $Bunzip2Error, "IO::Uncompress::Bunzip2: $err", 137 | " value $stringValue is bad"; 138 | ok ! $bz, " no bz object"; 139 | } 140 | 141 | } 142 | 143 | { 144 | title "Testing $CompressClass and $UncompressClass"; 145 | 146 | my $hello = < $value"; 154 | my $lex = LexFile->new( my $name ); 155 | my $bz ; 156 | $bz = IO::Compress::Bzip2->new($name, BlockSize100K => $value) 157 | or diag $IO::Compress::Bzip2::Bzip2Error ; 158 | ok $bz, " bz object ok"; 159 | $bz->write($hello); 160 | $bz->close($hello); 161 | 162 | is myBZreadFile($name), $hello, " got expected content"; 163 | } 164 | 165 | for my $value ( 0 .. 250 ) 166 | { 167 | title "$CompressClass - WorkFactor => $value"; 168 | my $lex = LexFile->new( my $name ); 169 | my $bz ; 170 | $bz = IO::Compress::Bzip2->new($name, WorkFactor => $value); 171 | ok $bz, " bz object ok"; 172 | $bz->write($hello); 173 | $bz->close($hello); 174 | 175 | is myBZreadFile($name), $hello, " got expected content"; 176 | } 177 | 178 | for my $value ( 0 .. 1 ) 179 | { 180 | title "$UncompressClass - Small => $value"; 181 | my $lex = LexFile->new( my $name ); 182 | my $bz ; 183 | $bz = IO::Compress::Bzip2->new($name); 184 | ok $bz, " bz object ok"; 185 | $bz->write($hello); 186 | $bz->close($hello); 187 | 188 | my $fil = $UncompressClass->can('new')->( $UncompressClass, $name, 189 | Append => 1, 190 | Small => $value ); 191 | 192 | my $data = ''; 193 | 1 while $fil->read($data) > 0; 194 | 195 | $fil->close ; 196 | 197 | is $data, $hello, " got expected"; 198 | } 199 | } 200 | 201 | 202 | 1; 203 | -------------------------------------------------------------------------------- /t/001zlib-generic-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "zlib-generic.pl" ; 21 | -------------------------------------------------------------------------------- /t/001zlib-generic-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "zlib-generic.pl" ; 21 | -------------------------------------------------------------------------------- /t/001zlib-generic-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "zlib-generic.pl" ; 21 | -------------------------------------------------------------------------------- /t/001zlib-generic-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "zlib-generic.pl" ; 21 | -------------------------------------------------------------------------------- /t/002any-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | 13 | use IO::Uncompress::AnyInflate qw($AnyInflateError) ; 14 | 15 | use IO::Compress::Deflate qw($DeflateError) ; 16 | use IO::Uncompress::Inflate qw($InflateError) ; 17 | 18 | sub getClass 19 | { 20 | 'AnyInflate'; 21 | } 22 | 23 | sub identify 24 | { 25 | 'IO::Compress::Deflate'; 26 | } 27 | 28 | require "any.pl" ; 29 | run(); 30 | -------------------------------------------------------------------------------- /t/002any-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Uncompress::AnyInflate qw($AnyInflateError) ; 13 | 14 | use IO::Compress::Gzip qw($GzipError) ; 15 | use IO::Uncompress::Gunzip qw($GunzipError) ; 16 | 17 | sub getClass 18 | { 19 | 'AnyInflate'; 20 | } 21 | 22 | 23 | sub identify 24 | { 25 | 'IO::Compress::Gzip'; 26 | } 27 | 28 | require "any.pl" ; 29 | run(); 30 | -------------------------------------------------------------------------------- /t/002any-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Uncompress::AnyInflate qw($AnyInflateError) ; 13 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 14 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 15 | 16 | sub getClass 17 | { 18 | 'AnyInflate'; 19 | } 20 | 21 | 22 | sub identify 23 | { 24 | 'IO::Compress::RawDeflate'; 25 | } 26 | 27 | require "any.pl" ; 28 | run(); 29 | -------------------------------------------------------------------------------- /t/002any-transparent.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | 10 | use strict; 11 | use warnings; 12 | use bytes; 13 | 14 | use Test::More ; 15 | use CompTestUtils; 16 | 17 | BEGIN { 18 | # use Test::NoWarnings, if available 19 | my $extra = 0 ; 20 | $extra = 1 21 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 22 | 23 | plan tests => 15 + $extra ; 24 | 25 | use_ok('IO::Uncompress::AnyInflate', qw($AnyInflateError)) ; 26 | 27 | } 28 | 29 | { 30 | 31 | my $string = <new( my $output ); 42 | my $input ; 43 | 44 | if ($file) { 45 | writeFile($output, $buffer); 46 | $input = $output; 47 | } 48 | else { 49 | $input = \$buffer; 50 | } 51 | 52 | 53 | my $unc ; 54 | my $keep = $buffer ; 55 | $unc = IO::Uncompress::AnyInflate->new( $input, -Transparent => 0 ); 56 | ok ! $unc," no AnyInflate object when -Transparent => 0" ; 57 | is $buffer, $keep ; 58 | 59 | $buffer = $keep ; 60 | $unc = IO::Uncompress::AnyInflate->new( \$buffer, -Transparent => 1 ); 61 | ok $unc, " AnyInflate object when -Transparent => 1" ; 62 | 63 | my $uncomp ; 64 | ok $unc->read($uncomp) > 0 ; 65 | ok $unc->eof() ; 66 | #ok $unc->type eq $Type; 67 | 68 | is $uncomp, $string ; 69 | } 70 | } 71 | 72 | 1; 73 | -------------------------------------------------------------------------------- /t/002any-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Uncompress::AnyInflate qw($AnyInflateError) ; 13 | 14 | use IO::Compress::Zip qw($ZipError) ; 15 | use IO::Uncompress::Unzip qw($UnzipError) ; 16 | 17 | sub getClass 18 | { 19 | 'AnyInflate'; 20 | } 21 | 22 | 23 | sub identify 24 | { 25 | 'IO::Compress::Zip'; 26 | } 27 | 28 | require "any.pl" ; 29 | run(); 30 | -------------------------------------------------------------------------------- /t/010examples-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | 10 | use strict; 11 | use warnings; 12 | use bytes; 13 | 14 | use Test::More ; 15 | use CompTestUtils; 16 | use IO::Compress::Bzip2 'bzip2' ; 17 | 18 | BEGIN 19 | { 20 | plan(skip_all => "Examples needs Perl 5.005 or better - you have Perl $]" ) 21 | if $] < 5.005 ; 22 | 23 | # use Test::NoWarnings, if available 24 | my $extra = 0 ; 25 | $extra = 1 26 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 27 | 28 | plan tests => 19 + $extra ; 29 | } 30 | 31 | 32 | my $Inc = join " ", map qq["-I$_"] => @INC; 33 | $Inc = '"-MExtUtils::testlib"' 34 | if ! $ENV{PERL_CORE} && eval " require ExtUtils::testlib; " ; 35 | 36 | my $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; 37 | $Perl = qq["$Perl"] if $^O eq 'MSWin32' ; 38 | 39 | $Perl = "$Perl $Inc -w" ; 40 | #$Perl .= " -Mblib " ; 41 | my $examples = $ENV{PERL_CORE} ? "../ext/IO-Compress/examples/io/bzip2" 42 | : "./examples/io/bzip2"; 43 | 44 | my $hello1 = < $file1 ; 73 | bzip2 \$hello2 => $file2 ; 74 | 75 | sub check 76 | { 77 | my $command = shift ; 78 | my $expected = shift ; 79 | 80 | my $lex = new LexFile my $stderr ; 81 | 82 | my $cmd = "$command 2>$stderr"; 83 | my $stdout = `$cmd` ; 84 | 85 | my $aok = 1 ; 86 | 87 | $aok &= is $?, 0, " exit status is 0" ; 88 | 89 | $aok &= is readFile($stderr), '', " no stderr" ; 90 | 91 | $aok &= is $stdout, $expected, " expected content is ok" 92 | if defined $expected ; 93 | 94 | if (! $aok) { 95 | diag "Command line: $cmd"; 96 | my ($file, $line) = (caller)[1,2]; 97 | diag "Test called from $file, line $line"; 98 | } 99 | 100 | 1 while unlink $stderr; 101 | } 102 | 103 | # bzcat 104 | # ##### 105 | 106 | title "bzcat - command line" ; 107 | check "$Perl ${examples}/bzcat $file1 $file2", $hello1 . $hello2; 108 | 109 | title "bzcat - stdin" ; 110 | check "$Perl ${examples}/bzcat <$file1 ", $hello1; 111 | 112 | 113 | # bzgrep 114 | # ###### 115 | 116 | title "bzgrep"; 117 | check "$Perl ${examples}/bzgrep the $file1 $file2", 118 | join('', grep(/the/, @hello1, @hello2)); 119 | 120 | for ($file1, $file2, $stderr) { 1 while unlink $_ } ; 121 | 122 | 123 | 124 | # bzstream 125 | # ######## 126 | 127 | { 128 | title "bzstream" ; 129 | writeFile($file1, $hello1) ; 130 | check "$Perl ${examples}/bzstream <$file1 >$file2"; 131 | 132 | title "bzcat" ; 133 | check "$Perl ${examples}/bzcat $file2", $hello1 ; 134 | } 135 | -------------------------------------------------------------------------------- /t/010examples-zlib.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | 10 | use strict; 11 | use warnings; 12 | use bytes; 13 | 14 | use Test::More ; 15 | use CompTestUtils; 16 | use IO::Compress::Gzip 'gzip' ; 17 | 18 | BEGIN 19 | { 20 | plan(skip_all => "Examples needs Perl 5.005 or better - you have Perl $]" ) 21 | if $] < 5.005 ; 22 | 23 | # use Test::NoWarnings, if available 24 | my $extra = 0 ; 25 | $extra = 1 26 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 27 | 28 | plan tests => 19 + $extra ; 29 | } 30 | 31 | 32 | my $Inc = join " ", map qq["-I$_"] => @INC; 33 | $Inc = '"-MExtUtils::testlib"' 34 | if ! $ENV{PERL_CORE} && eval " require ExtUtils::testlib; " ; 35 | 36 | my $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; 37 | $Perl = qq["$Perl"] if $^O eq 'MSWin32' ; 38 | 39 | $Perl = "$Perl $Inc -w" ; 40 | #$Perl .= " -Mblib " ; 41 | my $examples = $ENV{PERL_CORE} ? "../ext/IO-Compress/examples/io/gzip" 42 | : "./examples/io/gzip"; 43 | 44 | my $hello1 = < $file1 ; 73 | gzip \$hello2 => $file2 ; 74 | 75 | sub check 76 | { 77 | my $command = shift ; 78 | my $expected = shift ; 79 | 80 | my $lex = new LexFile my $stderr ; 81 | 82 | 83 | my $cmd = "$command 2>$stderr"; 84 | my $stdout = `$cmd` ; 85 | 86 | my $aok = 1 ; 87 | 88 | $aok &= is $?, 0, " exit status is 0" ; 89 | 90 | $aok &= is readFile($stderr), '', " no stderr" ; 91 | 92 | $aok &= is $stdout, $expected, " expected content is ok" 93 | if defined $expected ; 94 | 95 | if (! $aok) { 96 | diag "Command line: $cmd"; 97 | my ($file, $line) = (caller)[1,2]; 98 | diag "Test called from $file, line $line"; 99 | } 100 | 101 | 1 while unlink $stderr; 102 | } 103 | 104 | # gzcat 105 | # ##### 106 | 107 | title "gzcat - command line" ; 108 | check "$Perl ${examples}/gzcat $file1 $file2", $hello1 . $hello2; 109 | 110 | title "gzcat - stdin" ; 111 | check "$Perl ${examples}/gzcat <$file1 ", $hello1; 112 | 113 | 114 | # gzgrep 115 | # ###### 116 | 117 | title "gzgrep"; 118 | check "$Perl ${examples}/gzgrep the $file1 $file2", 119 | join('', grep(/the/, @hello1, @hello2)); 120 | 121 | for ($file1, $file2, $stderr) { 1 while unlink $_ } ; 122 | 123 | 124 | 125 | # gzstream 126 | # ######## 127 | 128 | { 129 | title "gzstream" ; 130 | writeFile($file1, $hello1) ; 131 | check "$Perl ${examples}/gzstream <$file1 >$file2"; 132 | 133 | title "gzcat" ; 134 | check "$Perl ${examples}/gzcat $file2", $hello1 ; 135 | } 136 | -------------------------------------------------------------------------------- /t/011-streamzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | 10 | use strict; 11 | use warnings; 12 | use bytes; 13 | 14 | use Test::More ; 15 | use CompTestUtils; 16 | use IO::Uncompress::Unzip 'unzip' ; 17 | 18 | BEGIN 19 | { 20 | plan(skip_all => "Needs Perl 5.005 or better - you have Perl $]" ) 21 | if $] < 5.005 ; 22 | 23 | # use Test::NoWarnings, if available 24 | my $extra = 0 ; 25 | $extra = 1 26 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 27 | 28 | plan tests => 136 + $extra ; 29 | } 30 | 31 | 32 | my $Inc = join " ", map qq["-I$_"] => @INC; 33 | $Inc = '"-MExtUtils::testlib"' 34 | if ! $ENV{PERL_CORE} && eval " require ExtUtils::testlib; " ; 35 | 36 | my $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; 37 | $Perl = qq["$Perl"] if $^O eq 'MSWin32' ; 38 | 39 | $Perl = "$Perl $Inc -w" ; 40 | #$Perl .= " -Mblib " ; 41 | my $binDir = $ENV{PERL_CORE} ? "../ext/IO-Compress/bin/" 42 | : "./bin/"; 43 | 44 | my $hello1 = <new( my $stderr ); 58 | 59 | 60 | sub check 61 | { 62 | my $command = shift ; 63 | my $expected = shift ; 64 | 65 | my $lex = LexFile->new( my $stderr ); 66 | 67 | my $cmd = "$command 2>$stderr"; 68 | my $stdout = `$cmd` ; 69 | 70 | my $aok = 1 ; 71 | 72 | $aok &= is $?, 0, " exit status is 0" ; 73 | 74 | $aok &= is readFile($stderr), '', " no stderr" ; 75 | 76 | $aok &= is $stdout, $expected, " expected content is ok" 77 | if defined $expected ; 78 | 79 | if (! $aok) { 80 | diag "Command line: $cmd"; 81 | my ($file, $line) = (caller)[1,2]; 82 | diag "Test called from $file, line $line"; 83 | } 84 | 85 | 1 while unlink $stderr; 86 | } 87 | 88 | 89 | # streamzip 90 | # ######### 91 | 92 | { 93 | title "streamzip" ; 94 | 95 | my ($infile, $outfile); 96 | my $lex = LexFile->new( $infile, $outfile ); 97 | 98 | writeFile($infile, $hello1) ; 99 | check "$Perl ${binDir}/streamzip <$infile >$outfile"; 100 | 101 | my $uncompressed ; 102 | unzip $outfile => \$uncompressed; 103 | is $uncompressed, $hello1; 104 | } 105 | 106 | { 107 | title "streamzip - zipfile option" ; 108 | 109 | my ($infile, $outfile); 110 | my $lex = LexFile->new( $infile, $outfile ); 111 | 112 | writeFile($infile, $hello1) ; 113 | check "$Perl ${binDir}/streamzip -zipfile $outfile <$infile"; 114 | 115 | my $uncompressed ; 116 | unzip $outfile => \$uncompressed; 117 | is $uncompressed, $hello1; 118 | } 119 | 120 | for my $method (qw(store deflate bzip2 lzma xz zstd)) 121 | { 122 | SKIP: 123 | { 124 | if ($method eq 'lzma') 125 | { 126 | no warnings; 127 | eval { require IO::Compress::Lzma && defined &{ 'IO::Compress::Adapter::Bzip2::mkRawZipCompObject' } } ; 128 | skip "Method 'lzma' needs IO::Compress::Lzma\n", 8 129 | if $@; 130 | } 131 | 132 | if ($method eq 'zstd') 133 | { 134 | no warnings; 135 | eval { require IO::Compress::Zstd && defined &{ 'IO::Compress::Adapter::Zstd::mkRawZipCompObject' }} ; 136 | skip "Method 'zstd' needs IO::Compress::Zstd\n", 8 137 | if $@; 138 | } 139 | 140 | if ($method eq 'xz') 141 | { 142 | no warnings; 143 | eval { require IO::Compress::Xz && defined &{ 'IO::Compress::Adapter::Xz::mkRawZipCompObject' }} ; 144 | skip "Method 'xz' needs IO::Compress::Xz\n", 8 145 | if $@; 146 | } 147 | 148 | { 149 | title "streamzip method $method" ; 150 | 151 | skip "streaming unzip not supported with zstd\n", 7 152 | if $method eq 'zstd' ; 153 | 154 | my ($infile, $outfile); 155 | my $lex = LexFile->new( $infile, $outfile ); 156 | 157 | writeFile($infile, $hello1) ; 158 | check "$Perl ${binDir}/streamzip -method $method <$infile >$outfile"; 159 | 160 | my $uncompressed ; 161 | unzip $outfile => \$uncompressed; 162 | is $uncompressed, $hello1; 163 | } 164 | 165 | { 166 | title "streamzip $method- zipfile option" ; 167 | 168 | my ($infile, $outfile); 169 | my $lex = LexFile->new( $infile, $outfile ); 170 | 171 | writeFile($infile, $hello1) ; 172 | check "$Perl ${binDir}/streamzip -zipfile $outfile -method $method <$infile"; 173 | 174 | my $uncompressed ; 175 | unzip $outfile => \$uncompressed; 176 | is $uncompressed, $hello1; 177 | } 178 | } 179 | } 180 | 181 | for my $level (0 ..9) 182 | { 183 | { 184 | title "streamzip level $level" ; 185 | 186 | my ($infile, $outfile); 187 | my $lex = LexFile->new( $infile, $outfile ); 188 | 189 | writeFile($infile, $hello1) ; 190 | check "$Perl ${binDir}/streamzip -$level <$infile >$outfile"; 191 | 192 | my $uncompressed ; 193 | unzip $outfile => \$uncompressed; 194 | is $uncompressed, $hello1; 195 | } 196 | 197 | { 198 | title "streamzip level $level- zipfile option" ; 199 | 200 | my ($infile, $outfile); 201 | my $lex = LexFile->new( $infile, $outfile ); 202 | 203 | writeFile($infile, $hello1) ; 204 | check "$Perl ${binDir}/streamzip -zipfile $outfile -$level <$infile"; 205 | 206 | my $uncompressed ; 207 | unzip $outfile => \$uncompressed; 208 | is $uncompressed, $hello1; 209 | } 210 | 211 | } 212 | -------------------------------------------------------------------------------- /t/020isize.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict ; 10 | use warnings; 11 | use bytes; 12 | 13 | use Test::More ; 14 | use CompTestUtils; 15 | 16 | BEGIN 17 | { 18 | plan skip_all => "Lengthy Tests Disabled\n" . 19 | "set COMPRESS_ZLIB_RUN_ALL to run this test suite" 20 | unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} ; 21 | 22 | # use Test::NoWarnings, if available 23 | my $extra = 0 ; 24 | $extra = 1 25 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 26 | 27 | plan tests => 76 + $extra ; 28 | 29 | 30 | use_ok('Compress::Zlib', 2) ; 31 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; 32 | use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ; 33 | use_ok('IO::Compress::Gzip::Constants'); 34 | } 35 | 36 | my $compressed ; 37 | my $expected_crc ; 38 | 39 | for my $wrap (0 .. 2) 40 | { 41 | for my $offset ( -1 .. 1 ) 42 | { 43 | next if $wrap == 0 && $offset < 0 ; 44 | 45 | title "Wrap $wrap, Offset $offset" ; 46 | 47 | my $size = (GZIP_ISIZE_MAX * $wrap) + $offset ; 48 | 49 | my $expected_isize ; 50 | if ($wrap == 0) { 51 | $expected_isize = $offset ; 52 | } 53 | elsif ($wrap == 1 && $offset <= 0) { 54 | $expected_isize = GZIP_ISIZE_MAX + $offset ; 55 | } 56 | elsif ($wrap > 1) { 57 | $expected_isize = GZIP_ISIZE_MAX + $offset - 1; 58 | } 59 | else { 60 | $expected_isize = $offset - 1; 61 | } 62 | 63 | sub gzipClosure 64 | { 65 | my $gzip = shift ; 66 | my $max = shift ; 67 | 68 | my $index = 0 ; 69 | my $inc = 1024 * 5000 ; 70 | my $buff = 'x' x $inc ; 71 | my $left = $max ; 72 | 73 | return 74 | sub { 75 | 76 | if ($max == 0 && $index == 0) { 77 | $expected_crc = crc32('') ; 78 | ok $gzip->close(), ' IO::Compress::Gzip::close ok X' ; 79 | ++ $index ; 80 | $_[0] .= $compressed; 81 | return length $compressed ; 82 | } 83 | 84 | return 0 if $index >= $max ; 85 | 86 | while ( ! length $compressed ) 87 | { 88 | $index += $inc ; 89 | 90 | if ($index <= $max) { 91 | $gzip->write($buff) ; 92 | #print "Write " . length($buff) . "\n" ; 93 | #print "# LEN Compressed " . length($compressed) . "\n" ; 94 | $expected_crc = crc32($buff, $expected_crc) ; 95 | $left -= $inc ; 96 | } 97 | else { 98 | #print "Write $left\n" ; 99 | $gzip->write('x' x $left) ; 100 | #print "# LEN Compressed " . length($compressed) . "\n" ; 101 | $expected_crc = crc32('x' x $left, $expected_crc) ; 102 | ok $gzip->close(), ' IO::Compress::Gzip::close ok ' ; 103 | last ; 104 | } 105 | } 106 | 107 | my $len = length $compressed ; 108 | $_[0] .= $compressed ; 109 | $compressed = ''; 110 | #print "# LEN $len\n" if $len <=0 ; 111 | 112 | return $len ; 113 | }; 114 | } 115 | 116 | my $gzip = IO::Compress::Gzip->new( \$compressed, 117 | -Append => 0, 118 | -HeaderCRC => 1 ); 119 | 120 | ok $gzip, " Created IO::Compress::Gzip object"; 121 | 122 | my $gunzip = IO::Uncompress::Gunzip->new( gzipClosure($gzip, $size), 123 | -BlockSize => 1024 * 500 , 124 | -Append => 0, 125 | -Strict => 1 ); 126 | 127 | ok $gunzip, " Created IO::Uncompress::Gunzip object"; 128 | 129 | my $inflate = *$gunzip->{Inflate} ; 130 | my $deflate = *$gzip->{Deflate} ; 131 | 132 | my $status ; 133 | my $uncompressed; 134 | my $actual = 0 ; 135 | while (($status = $gunzip->read($uncompressed)) > 0) { 136 | #print "# READ $status\n" ; 137 | $actual += $status ; 138 | } 139 | 140 | is $status, 0, ' IO::Uncompress::Gunzip::read returned 0' 141 | or diag "error status is $status, error is $GunzipError" ; 142 | 143 | ok $gunzip->close(), " IO::Uncompress::Gunzip Closed ok" ; 144 | 145 | is $actual, $size, " Length of Gunzipped data is $size" 146 | or diag "Expected $size, got $actual"; 147 | 148 | my $gunzip_hdr = $gunzip->getHeaderInfo(); 149 | 150 | is $gunzip_hdr->{ISIZE}, $expected_isize, 151 | sprintf(" ISIZE is $expected_isize [0x%X]", $expected_isize); 152 | is $gunzip_hdr->{CRC32}, $expected_crc, 153 | sprintf(" CRC32 is $expected_crc [0x%X]", $expected_crc); 154 | 155 | $expected_crc = 0 ; 156 | } 157 | } 158 | -------------------------------------------------------------------------------- /t/050interop-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | use bytes; 12 | 13 | use File::Spec ; 14 | use Test::More ; 15 | use CompTestUtils; 16 | 17 | my $GZIP ; 18 | 19 | 20 | sub ExternalGzipWorks 21 | { 22 | my $lex = LexFile->new( my $outfile ); 23 | my $content = qq { 24 | Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id 25 | dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia 26 | est. Quintus cenum parat. 27 | }; 28 | 29 | writeWithGzip($outfile, $content) 30 | or return 0; 31 | 32 | my $got ; 33 | readWithGzip($outfile, $got) 34 | or return 0; 35 | 36 | if ($content ne $got) 37 | { 38 | diag "Uncompressed content is wrong"; 39 | return 0 ; 40 | } 41 | 42 | return 1 ; 43 | } 44 | 45 | sub readWithGzip 46 | { 47 | my $file = shift ; 48 | 49 | my $lex = LexFile->new( my $outfile ); 50 | 51 | my $comp = "$GZIP -d -c" ; 52 | 53 | if ( system("$comp $file >$outfile") == 0 ) 54 | { 55 | $_[0] = readFile($outfile); 56 | return 1 57 | } 58 | 59 | diag "'$comp' failed: \$?=$? \$!=$!"; 60 | return 0 ; 61 | } 62 | 63 | sub getGzipInfo 64 | { 65 | my $file = shift ; 66 | } 67 | 68 | sub writeWithGzip 69 | { 70 | my $file = shift ; 71 | my $content = shift ; 72 | my $options = shift || ''; 73 | 74 | my $lex = LexFile->new( my $infile ); 75 | writeFile($infile, $content); 76 | 77 | unlink $file ; 78 | my $comp = "$GZIP -c $options $infile >$file" ; 79 | 80 | return 1 81 | if system($comp) == 0 ; 82 | 83 | diag "'$comp' failed: \$?=$? \$!=$!"; 84 | return 0 ; 85 | } 86 | 87 | BEGIN { 88 | 89 | # Check external gzip is available 90 | my $name = $^O =~ /mswin/i ? 'gzip.exe' : 'gzip'; 91 | my $split = $^O =~ /mswin/i ? ";" : ":"; 92 | 93 | for my $dir (reverse split $split, $ENV{PATH}) 94 | { 95 | $GZIP = File::Spec->catfile($dir,$name) 96 | if -x File::Spec->catfile($dir,$name) 97 | } 98 | 99 | # Handle spaces in path to gzip 100 | $GZIP = "\"$GZIP\"" if defined $GZIP && $GZIP =~ /\s/; 101 | 102 | plan(skip_all => "Cannot find $name") 103 | if ! $GZIP ; 104 | 105 | plan(skip_all => "$name doesn't work as expected") 106 | if ! ExternalGzipWorks(); 107 | 108 | 109 | # use Test::NoWarnings, if available 110 | my $extra = 0 ; 111 | $extra = 1 112 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 113 | 114 | plan tests => 7 + $extra ; 115 | 116 | use_ok('IO::Compress::Gzip', ':all') ; 117 | use_ok('IO::Uncompress::Gunzip', ':all') ; 118 | 119 | } 120 | 121 | 122 | { 123 | title "Test interop with $GZIP" ; 124 | 125 | my $file; 126 | my $file1; 127 | my $lex = LexFile->new( $file, $file1 ); 128 | my $content = qq { 129 | Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id 130 | dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia 131 | est. Quintus cenum parat. 132 | }; 133 | my $got; 134 | 135 | ok writeWithGzip($file, $content), "writeWithGzip ok"; 136 | 137 | gunzip $file => \$got ; 138 | is $got, $content, "got content"; 139 | 140 | 141 | gzip \$content => $file1; 142 | $got = ''; 143 | ok readWithGzip($file1, $got), "readWithGzip ok"; 144 | is $got, $content, "got content"; 145 | } 146 | -------------------------------------------------------------------------------- /t/100generic-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 13 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Bzip2'; 18 | } 19 | 20 | require "generic.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/100generic-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | use bytes; 12 | 13 | use IO::Compress::Deflate qw($DeflateError) ; 14 | use IO::Uncompress::Inflate qw($InflateError) ; 15 | 16 | sub identify 17 | { 18 | 'IO::Compress::Deflate'; 19 | } 20 | 21 | require "generic.pl" ; 22 | run(); 23 | -------------------------------------------------------------------------------- /t/100generic-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | return 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "generic.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/100generic-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "generic.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/100generic-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "generic.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/101truncate-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use Test::More ; 13 | 14 | BEGIN { 15 | plan skip_all => "Lengthy Tests Disabled\n" . 16 | "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" 17 | unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; 18 | 19 | # use Test::NoWarnings, if available 20 | my $extra = 0 ; 21 | $extra = 1 22 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 23 | 24 | plan tests => 3308 + $extra; 25 | 26 | }; 27 | 28 | 29 | #use Test::More skip_all => "not implemented yet"; 30 | 31 | 32 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 33 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 34 | 35 | sub identify 36 | { 37 | 'IO::Compress::Bzip2'; 38 | } 39 | 40 | require "truncate.pl" ; 41 | run(); 42 | -------------------------------------------------------------------------------- /t/101truncate-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use Test::More ; 13 | 14 | BEGIN { 15 | plan skip_all => "Lengthy Tests Disabled\n" . 16 | "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" 17 | unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; 18 | 19 | # use Test::NoWarnings, if available 20 | my $extra = 0 ; 21 | $extra = 1 22 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 23 | 24 | plan tests => 2552 + $extra; 25 | 26 | }; 27 | 28 | 29 | #use Test::More skip_all => "not implemented yet"; 30 | 31 | 32 | use IO::Compress::Deflate qw($DeflateError) ; 33 | use IO::Uncompress::Inflate qw($InflateError) ; 34 | 35 | sub identify 36 | { 37 | 'IO::Compress::Deflate'; 38 | } 39 | 40 | require "truncate.pl" ; 41 | run(); 42 | -------------------------------------------------------------------------------- /t/101truncate-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | #use Test::More skip_all => "not implemented yet"; 13 | use Test::More ; 14 | 15 | BEGIN { 16 | plan skip_all => "Lengthy Tests Disabled\n" . 17 | "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" 18 | unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; 19 | 20 | # use Test::NoWarnings, if available 21 | my $extra = 0 ; 22 | $extra = 1 23 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 24 | 25 | plan tests => 3040 + $extra; 26 | 27 | }; 28 | 29 | 30 | 31 | use IO::Compress::Gzip qw($GzipError) ; 32 | use IO::Uncompress::Gunzip qw($GunzipError) ; 33 | 34 | sub identify 35 | { 36 | return 'IO::Compress::Gzip'; 37 | } 38 | 39 | require "truncate.pl" ; 40 | run(); 41 | -------------------------------------------------------------------------------- /t/101truncate-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use Test::More ; 13 | 14 | use Compress::Raw::Zlib; 15 | 16 | BEGIN { 17 | plan skip_all => "Lengthy Tests Disabled\n" . 18 | "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" 19 | unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; 20 | 21 | # use Test::NoWarnings, if available 22 | my $extra = 0 ; 23 | $extra = 1 24 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 25 | 26 | my $tests = Compress::Raw::Zlib::is_zlibng() ? 615 : 625; 27 | plan tests => $tests + $extra; 28 | }; 29 | 30 | 31 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 32 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 33 | 34 | #sub identify 35 | #{ 36 | # 'IO::Compress::RawDeflate'; 37 | #} 38 | # 39 | #require "truncate.pl" ; 40 | #run(); 41 | 42 | use CompTestUtils; 43 | 44 | my $hello = <new( \$compressed ) ); 61 | ok $x->write($hello) ; 62 | ok $x->close ; 63 | 64 | 65 | my $cc = $compressed ; 66 | 67 | my $gz ; 68 | ok($gz = $UncompressClass->can('new')->( $UncompressClass, \$cc, 69 | -Transparent => 0)) 70 | or diag "$$Error\n"; 71 | my $un; 72 | is $gz->read($un, length($hello)), length($hello); 73 | ok $gz->close(); 74 | is $un, $hello ; 75 | 76 | for my $trans (0 .. 1) 77 | { 78 | title "Testing $CompressClass, Transparent = $trans"; 79 | 80 | my $info = $gz->getHeaderInfo() ; 81 | my $header_size = $info->{HeaderLength}; 82 | my $trailer_size = $info->{TrailerLength}; 83 | ok 1, "Compressed size is " . length($compressed) ; 84 | ok 1, "Header size is $header_size" ; 85 | ok 1, "Trailer size is $trailer_size" ; 86 | 87 | 88 | title "Compressed Data Truncation"; 89 | foreach my $i (0 .. $blocksize) 90 | { 91 | 92 | my $lex = LexFile->new( my $name ); 93 | 94 | ok 1, "Length $i" ; 95 | my $part = substr($compressed, 0, $i); 96 | writeFile($name, $part); 97 | my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, 98 | -BlockSize => $blocksize, 99 | -Transparent => $trans ); 100 | if ($trans) { 101 | ok $gz; 102 | ok ! $gz->error() ; 103 | my $buff = ''; 104 | is $gz->read($buff, length $part), length $part ; 105 | is $buff, $part ; 106 | ok $gz->eof() ; 107 | $gz->close(); 108 | } 109 | else { 110 | ok !$gz; 111 | } 112 | } 113 | 114 | foreach my $i ($blocksize+1 .. length($compressed)-1) 115 | { 116 | 117 | my $lex = LexFile->new( my $name ); 118 | 119 | ok 1, "Length $i" ; 120 | my $part = substr($compressed, 0, $i); 121 | writeFile($name, $part); 122 | ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, 123 | -BlockSize => $blocksize, 124 | -Transparent => $trans ); 125 | my $un ; 126 | my $status = 1 ; 127 | $status = $gz->read($un) while $status > 0 ; 128 | ok $status < 0 ; 129 | ok $gz->eof() ; 130 | ok $gz->error() ; 131 | $gz->close(); 132 | } 133 | } 134 | 135 | } 136 | -------------------------------------------------------------------------------- /t/101truncate-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | #use Test::More skip_all => "not implemented yet"; 13 | use Test::More ; 14 | 15 | BEGIN { 16 | plan skip_all => "Lengthy Tests Disabled\n" . 17 | "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" 18 | unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; 19 | 20 | # use Test::NoWarnings, if available 21 | my $extra = 0 ; 22 | $extra = 1 23 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 24 | 25 | plan tests => 7732 + $extra; 26 | 27 | }; 28 | 29 | 30 | 31 | 32 | 33 | use IO::Compress::Zip qw($ZipError) ; 34 | use IO::Uncompress::Unzip qw($UnzipError) ; 35 | 36 | sub identify 37 | { 38 | 'IO::Compress::Zip'; 39 | } 40 | 41 | require "truncate.pl" ; 42 | run(); 43 | -------------------------------------------------------------------------------- /t/102tied-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 13 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Bzip2'; 18 | } 19 | 20 | require "tied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/102tied-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "tied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/102tied-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "tied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/102tied-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "tied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/102tied-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "tied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/103newtied-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 13 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Bzip2'; 18 | } 19 | 20 | require "newtied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/103newtied-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "newtied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/103newtied-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "newtied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/103newtied-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "newtied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/103newtied-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "newtied.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/104destroy-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 13 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Bzip2'; 18 | } 19 | 20 | require "destroy.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/104destroy-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "destroy.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/104destroy-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "destroy.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/104destroy-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "destroy.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/104destroy-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "destroy.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/105oneshot-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 13 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Bzip2'; 18 | } 19 | 20 | require "oneshot.pl" ; 21 | 22 | run(); 23 | -------------------------------------------------------------------------------- /t/105oneshot-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "oneshot.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/105oneshot-gzip-only.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | use bytes; 12 | 13 | use Test::More ; 14 | use CompTestUtils; 15 | 16 | BEGIN { 17 | plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" ) 18 | if $] < 5.005 ; 19 | 20 | 21 | # use Test::NoWarnings, if available 22 | my $extra = 0 ; 23 | $extra = 1 24 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 25 | 26 | plan tests => 70 + $extra ; 27 | 28 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; 29 | use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ; 30 | 31 | 32 | } 33 | 34 | 35 | sub gzipGetHeader 36 | { 37 | my $in = shift; 38 | my $content = shift ; 39 | my %opts = @_ ; 40 | 41 | my $out ; 42 | my $got ; 43 | 44 | ok IO::Compress::Gzip::gzip($in, \$out, %opts), " gzip ok" ; 45 | ok IO::Uncompress::Gunzip::gunzip(\$out, \$got), " gunzip ok" 46 | or diag $GunzipError ; 47 | is $got, $content, " got expected content" ; 48 | 49 | my $gunz = IO::Uncompress::Gunzip->new( \$out, Strict => 0 ) 50 | or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; 51 | ok $gunz, " Created IO::Uncompress::Gunzip object"; 52 | my $hdr = $gunz->getHeaderInfo(); 53 | ok $hdr, " got Header info"; 54 | my $uncomp ; 55 | ok $gunz->read($uncomp), " read ok" ; 56 | is $uncomp, $content, " got expected content"; 57 | ok $gunz->close, " closed ok" ; 58 | 59 | return $hdr ; 60 | 61 | } 62 | 63 | { 64 | title "Check gzip header default NAME & MTIME settings" ; 65 | 66 | my $lex = LexFile->new( my $file1 ); 67 | 68 | my $content = "hello "; 69 | my $hdr ; 70 | my $mtime ; 71 | 72 | writeFile($file1, $content); 73 | $mtime = (stat($file1))[9]; 74 | # make sure that the gzip file isn't created in the same 75 | # second as the input file 76 | sleep 3 ; 77 | $hdr = gzipGetHeader($file1, $content); 78 | 79 | is $hdr->{Name}, $file1, " Name is '$file1'"; 80 | is $hdr->{Time}, $mtime, " Time is ok"; 81 | 82 | title "Override Name" ; 83 | 84 | writeFile($file1, $content); 85 | $mtime = (stat($file1))[9]; 86 | sleep 3 ; 87 | $hdr = gzipGetHeader($file1, $content, Name => "abcde"); 88 | 89 | is $hdr->{Name}, "abcde", " Name is 'abcde'" ; 90 | is $hdr->{Time}, $mtime, " Time is ok"; 91 | 92 | title "Override Time" ; 93 | 94 | writeFile($file1, $content); 95 | $hdr = gzipGetHeader($file1, $content, Time => 1234); 96 | 97 | is $hdr->{Name}, $file1, " Name is '$file1'" ; 98 | is $hdr->{Time}, 1234, " Time is 1234"; 99 | 100 | title "Override Name and Time" ; 101 | 102 | writeFile($file1, $content); 103 | $hdr = gzipGetHeader($file1, $content, Time => 4321, Name => "abcde"); 104 | 105 | is $hdr->{Name}, "abcde", " Name is 'abcde'" ; 106 | is $hdr->{Time}, 4321, " Time is 4321"; 107 | 108 | title "Filehandle doesn't have default Name or Time" ; 109 | my $fh = IO::File->new( "< $file1" ) 110 | or diag "Cannot open '$file1': $!\n" ; 111 | sleep 3 ; 112 | my $before = time ; 113 | $hdr = gzipGetHeader($fh, $content); 114 | my $after = time ; 115 | 116 | ok ! defined $hdr->{Name}, " Name is undef"; 117 | cmp_ok $hdr->{Time}, '>=', $before, " Time is ok"; 118 | cmp_ok $hdr->{Time}, '<=', $after, " Time is ok"; 119 | 120 | $fh->close; 121 | 122 | title "Buffer doesn't have default Name or Time" ; 123 | my $buffer = $content; 124 | $before = time ; 125 | $hdr = gzipGetHeader(\$buffer, $content); 126 | $after = time ; 127 | 128 | ok ! defined $hdr->{Name}, " Name is undef"; 129 | cmp_ok $hdr->{Time}, '>=', $before, " Time is ok"; 130 | cmp_ok $hdr->{Time}, '<=', $after, " Time is ok"; 131 | } 132 | 133 | # TODO add more error cases 134 | -------------------------------------------------------------------------------- /t/105oneshot-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "oneshot.pl" ; 21 | 22 | run(); 23 | -------------------------------------------------------------------------------- /t/105oneshot-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "oneshot.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/105oneshot-zip-bzip2-only.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | use bytes; 12 | 13 | use Test::More ; 14 | use CompTestUtils; 15 | 16 | BEGIN { 17 | plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" ) 18 | if $] < 5.005 ; 19 | 20 | plan(skip_all => "IO::Compress::Bzip2 not available" ) 21 | unless eval { require IO::Compress::Bzip2; 22 | require IO::Uncompress::Bunzip2; 23 | 1 24 | } ; 25 | 26 | # use Test::NoWarnings, if available 27 | my $extra = 0 ; 28 | $extra = 1 29 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 30 | 31 | plan tests => 248 + $extra ; 32 | 33 | #use_ok('IO::Compress::Zip', qw(zip $ZipError :zip_method)) ; 34 | use_ok('IO::Compress::Zip', qw(:all)) ; 35 | use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ; 36 | 37 | 38 | } 39 | 40 | 41 | sub zipGetHeader 42 | { 43 | my $in = shift; 44 | my $content = shift ; 45 | my %opts = @_ ; 46 | 47 | my $out ; 48 | my $got ; 49 | 50 | ok zip($in, \$out, %opts), " zip ok" ; 51 | ok unzip(\$out, \$got), " unzip ok" 52 | or diag $UnzipError ; 53 | is $got, $content, " got expected content" ; 54 | 55 | my $gunz = IO::Uncompress::Unzip->new( \$out, Strict => 0 ) 56 | or diag "UnzipError is $IO::Uncompress::Unzip::UnzipError" ; 57 | ok $gunz, " Created IO::Uncompress::Unzip object"; 58 | my $hdr = $gunz->getHeaderInfo(); 59 | ok $hdr, " got Header info"; 60 | my $uncomp ; 61 | ok $gunz->read($uncomp), " read ok" ; 62 | is $uncomp, $content, " got expected content"; 63 | ok $gunz->close, " closed ok" ; 64 | 65 | return $hdr ; 66 | 67 | } 68 | 69 | 70 | for my $input (0, 1) 71 | { 72 | for my $stream (0, 1) 73 | { 74 | for my $zip64 (0, 1) 75 | { 76 | #next if $zip64 && ! $stream; 77 | 78 | for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2) 79 | { 80 | title "Input $input, Stream $stream, Zip64 $zip64, Method $method"; 81 | 82 | my $lex1 = LexFile->new( my $file1 ); 83 | my $lex2 = LexFile->new( my $file2 ); 84 | my $content = "hello "; 85 | my $in ; 86 | 87 | if ($input) 88 | { 89 | writeFile($file2, $content); 90 | $in = $file2; 91 | } 92 | else 93 | { 94 | $in = \$content; 95 | } 96 | 97 | 98 | ok zip($in => $file1 , Method => $method, 99 | Zip64 => $zip64, 100 | Stream => $stream), " zip ok" 101 | or diag $ZipError ; 102 | 103 | my $got ; 104 | ok unzip($file1 => \$got), " unzip ok" 105 | or diag $UnzipError ; 106 | 107 | is $got, $content, " content ok"; 108 | 109 | my $u = IO::Uncompress::Unzip->new( $file1 ) 110 | or diag $ZipError ; 111 | 112 | my $hdr = $u->getHeaderInfo(); 113 | ok $hdr, " got header"; 114 | 115 | is $hdr->{Stream}, $stream, " stream is $stream" ; 116 | is $hdr->{MethodID}, $method, " MethodID is $method" ; 117 | is $hdr->{Zip64}, $zip64, " Zip64 is $zip64" ; 118 | } 119 | } 120 | } 121 | } 122 | 123 | for my $stream (0, 1) 124 | { 125 | for my $zip64 (0, 1) 126 | { 127 | next if $zip64 && ! $stream; 128 | 129 | for my $method (ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2) 130 | { 131 | title "Stream $stream, Zip64 $zip64, Method $method"; 132 | 133 | my $file1; 134 | my $file2; 135 | my $zipfile; 136 | my $lex = LexFile->new( $file1, $file2, $zipfile ); 137 | 138 | my $content1 = "hello "; 139 | writeFile($file1, $content1); 140 | 141 | my $content2 = "goodbye "; 142 | writeFile($file2, $content2); 143 | 144 | my %content = ( $file1 => $content1, 145 | $file2 => $content2, 146 | ); 147 | 148 | ok zip([$file1, $file2] => $zipfile , Method => $method, 149 | Zip64 => $zip64, 150 | Stream => $stream), " zip ok" 151 | or diag $ZipError ; 152 | 153 | for my $file ($file1, $file2) 154 | { 155 | my $got ; 156 | ok unzip($zipfile => \$got, Name => $file), " unzip $file ok" 157 | or diag $UnzipError ; 158 | 159 | is $got, $content{$file}, " content ok"; 160 | } 161 | } 162 | } 163 | } 164 | 165 | # TODO add more error cases 166 | -------------------------------------------------------------------------------- /t/105oneshot-zip-store-only.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | use bytes; 12 | 13 | use Test::More ; 14 | use CompTestUtils; 15 | 16 | BEGIN { 17 | plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" ) 18 | if $] < 5.005 ; 19 | 20 | plan skip_all => "Lengthy Tests Disabled\n" . 21 | "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" 22 | unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; 23 | 24 | plan(skip_all => "IO::Compress::Bzip2 not available" ) 25 | unless eval { require IO::Compress::Bzip2; 26 | require IO::Uncompress::Bunzip2; 27 | 1 28 | } ; 29 | 30 | # use Test::NoWarnings, if available 31 | my $extra = 0 ; 32 | $extra = 1 33 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 34 | 35 | plan tests => 1058 + $extra ; 36 | 37 | use_ok('IO::Compress::Zip', qw(:all)) ; 38 | use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ; 39 | } 40 | 41 | my @contents; 42 | my $content = "x" x 1025; 43 | $content .= "\x50" ; 44 | 45 | push @contents, $content ; 46 | 47 | $content .= "y" x 321 ; 48 | $content .= "\x50\x4b" ; 49 | push @contents, $content ; 50 | 51 | $content .= "z" x 21 ; 52 | $content .= "\x50\x4b\x07" . "a" x 73 ; 53 | push @contents, $content ; 54 | 55 | $content .= "a" x 73 ; 56 | $content .= "\x50\x4b\x07\x08" ; 57 | push @contents, $content ; 58 | 59 | $content .= "b" x 102 ; 60 | $content .= "\x50\x4b\x07\x08" . "\x50\x4b\x07\x08" ; 61 | push @contents, $content ; 62 | 63 | $content .= "c" x 102 ; 64 | push @contents, $content ; 65 | 66 | 67 | my $index = 0; 68 | for $content (@contents) 69 | { 70 | ++ $index ; 71 | my $contentLen = length $content ; 72 | 73 | 74 | for my $stream (0, 1) 75 | { 76 | for my $zip64 (0, 1) 77 | { 78 | for my $blockSize (1 .. 7, $contentLen, $contentLen-1, $contentLen +1, 16*1024) 79 | { 80 | title "Index $index, Stream $stream, Zip64 $zip64, BlockSize $blockSize"; 81 | 82 | my $crc = Compress::Raw::Zlib::crc32($content); 83 | $content .= "\x50\x4b\x07\x08" . pack("V", $crc) . "b" x 53 ; 84 | 85 | my $zipped ; 86 | 87 | ok zip(\$content => \$zipped , Method => ZIP_CM_STORE, 88 | Zip64 => $zip64, 89 | Stream => $stream), " zip ok" 90 | or diag $ZipError ; 91 | 92 | my $got ; 93 | ok unzip(\$zipped => \$got, BlockSize => $blockSize), " unzip ok" 94 | or diag $UnzipError ; 95 | 96 | is $got, $content, " content ok"; 97 | 98 | } 99 | } 100 | } 101 | } 102 | -------------------------------------------------------------------------------- /t/105oneshot-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "oneshot.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/106prime-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 13 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Bzip2'; 18 | } 19 | 20 | require "prime.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/106prime-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "prime.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/106prime-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "prime.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/106prime-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "prime.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/106prime-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "prime.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/107multi-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 13 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Bzip2'; 18 | } 19 | 20 | require "multi.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/107multi-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "multi.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/107multi-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "multi.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/107multi-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "multi.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/107multi-zip-only.t: -------------------------------------------------------------------------------- 1 | 2 | use strict; 3 | use warnings; 4 | 5 | BEGIN { 6 | if ($ENV{PERL_CORE}) { 7 | chdir 't' if -d 't'; 8 | @INC = ("../lib", "lib/compress"); 9 | } 10 | } 11 | 12 | use lib qw(t t/compress); 13 | 14 | 15 | use Test::More ; 16 | use CompTestUtils; 17 | 18 | BEGIN { 19 | # use Test::NoWarnings, if available 20 | my $extra = 0 ; 21 | $extra = 1 22 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 23 | 24 | plan tests => 21 + $extra ; 25 | 26 | use_ok('IO::Compress::Zip', qw(zip $ZipError)) ; 27 | 28 | use_ok('IO::Uncompress::Unzip', qw($UnzipError)) ; 29 | use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ; 30 | 31 | } 32 | 33 | my @buffers ; 34 | push @buffers, <new( my $zipfile ); 53 | 54 | my $x = IO::Compress::Zip->new($zipfile, Name => $name++, AutoClose => 1); 55 | isa_ok $x, 'IO::Compress::Zip', ' $x' ; 56 | 57 | 58 | foreach my $buffer (@buffers) { 59 | ok $x->write($buffer), " Write OK" ; 60 | # this will add an extra "empty" stream 61 | ok $x->newStream(Name => $name ++), " newStream OK" ; 62 | } 63 | ok $x->close, " Close ok" ; 64 | 65 | push @buffers, undef; 66 | 67 | { 68 | open F, ">>$zipfile"; 69 | print F "trailing"; 70 | close F; 71 | } 72 | 73 | my $u = IO::Uncompress::Unzip->new( $zipfile, Transparent => 1, MultiStream => 0 ) 74 | or die "Cannot open $zipfile: $UnzipError"; 75 | 76 | my @names ; 77 | my $status; 78 | my $expname = "n1"; 79 | my $ix = 0; 80 | 81 | for my $ix (1 .. 4) 82 | { 83 | local $/ ; 84 | 85 | my $n = $u->getHeaderInfo()->{Name}; 86 | is $n, $expname , "name is $expname"; 87 | is <$u>, $buffers[$ix-1], "payload ok"; 88 | ++ $expname; 89 | 90 | $status = $u->nextStream() 91 | } 92 | 93 | { 94 | local $/ ; 95 | 96 | my $n = $u->getHeaderInfo()->{Name}; 97 | is $n, undef , "name is undef"; 98 | is <$u>, "trailing", "payload ok"; 99 | } 100 | 101 | die "Error processing $zipfile: $!\n" 102 | if $status < 0 ; -------------------------------------------------------------------------------- /t/107multi-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "multi.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/108anyunc-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Uncompress::AnyUncompress qw($AnyUncompressError) ; 13 | 14 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 15 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 16 | 17 | sub getClass 18 | { 19 | 'AnyUncompress'; 20 | } 21 | 22 | 23 | sub identify 24 | { 25 | 'IO::Compress::Bzip2'; 26 | } 27 | 28 | require "any.pl" ; 29 | run(); 30 | -------------------------------------------------------------------------------- /t/108anyunc-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Uncompress::AnyUncompress qw($AnyUncompressError) ; 13 | 14 | use IO::Compress::Deflate qw($DeflateError) ; 15 | use IO::Uncompress::Inflate qw($InflateError) ; 16 | 17 | sub getClass 18 | { 19 | 'AnyUncompress'; 20 | } 21 | 22 | 23 | sub identify 24 | { 25 | 'IO::Compress::Deflate'; 26 | } 27 | 28 | require "any.pl" ; 29 | run(); 30 | -------------------------------------------------------------------------------- /t/108anyunc-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Uncompress::AnyUncompress qw($AnyUncompressError) ; 13 | 14 | use IO::Compress::Gzip qw($GzipError) ; 15 | use IO::Uncompress::Gunzip qw($GunzipError) ; 16 | 17 | sub getClass 18 | { 19 | 'AnyUncompress'; 20 | } 21 | 22 | 23 | sub identify 24 | { 25 | 'IO::Compress::Gzip'; 26 | } 27 | 28 | require "any.pl" ; 29 | run(); 30 | -------------------------------------------------------------------------------- /t/108anyunc-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Uncompress::AnyUncompress qw($AnyUncompressError) ; 13 | 14 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 15 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 16 | 17 | sub getClass 18 | { 19 | 'AnyUncompress'; 20 | } 21 | 22 | 23 | sub identify 24 | { 25 | 'IO::Compress::RawDeflate'; 26 | } 27 | 28 | require "any.pl" ; 29 | run(); 30 | -------------------------------------------------------------------------------- /t/108anyunc-transparent.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | 10 | use strict; 11 | use warnings; 12 | use bytes; 13 | 14 | use Test::More ; 15 | use CompTestUtils; 16 | 17 | BEGIN { 18 | # use Test::NoWarnings, if available 19 | my $extra = 0 ; 20 | $extra = 1 21 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 22 | 23 | plan tests => 15 + $extra ; 24 | 25 | use_ok('IO::Uncompress::AnyUncompress', qw($AnyUncompressError)) ; 26 | 27 | } 28 | 29 | { 30 | 31 | my $string = <new( my $output ); 42 | my $input ; 43 | 44 | if ($file) { 45 | writeFile($output, $buffer); 46 | $input = $output; 47 | } 48 | else { 49 | $input = \$buffer; 50 | } 51 | 52 | 53 | my $unc ; 54 | my $keep = $buffer ; 55 | $unc = IO::Uncompress::AnyUncompress->new( $input, -Transparent => 0 ); 56 | ok ! $unc," no AnyUncompress object when -Transparent => 0" ; 57 | is $buffer, $keep ; 58 | 59 | $buffer = $keep ; 60 | $unc = IO::Uncompress::AnyUncompress->new( \$buffer, -Transparent => 1 ); 61 | ok $unc, " AnyUncompress object when -Transparent => 1" ; 62 | 63 | my $uncomp ; 64 | ok $unc->read($uncomp) > 0 ; 65 | ok $unc->eof() ; 66 | #ok $unc->type eq $Type; 67 | 68 | is $uncomp, $string ; 69 | } 70 | } 71 | 72 | 1; 73 | -------------------------------------------------------------------------------- /t/108anyunc-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib 't/compress'; 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Uncompress::AnyUncompress qw($AnyUncompressError) ; 13 | 14 | use IO::Compress::Zip qw($ZipError) ; 15 | use IO::Uncompress::Unzip qw($UnzipError) ; 16 | 17 | sub getClass 18 | { 19 | 'AnyUncompress'; 20 | } 21 | 22 | 23 | sub identify 24 | { 25 | 'IO::Compress::Zip'; 26 | } 27 | 28 | require "any.pl" ; 29 | run(); 30 | -------------------------------------------------------------------------------- /t/109merge-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "merge.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/109merge-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "merge.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/109merge-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "merge.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/109merge-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use Test::More skip_all => "not implemented yet"; 13 | 14 | 15 | use IO::Compress::Zip qw($ZipError) ; 16 | use IO::Uncompress::Unzip qw($UnzipError) ; 17 | 18 | sub identify 19 | { 20 | 'IO::Compress::Zip'; 21 | } 22 | 23 | require "merge.pl" ; 24 | run(); 25 | -------------------------------------------------------------------------------- /t/110encode-bzip2.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Bzip2 qw($Bzip2Error) ; 13 | use IO::Uncompress::Bunzip2 qw($Bunzip2Error) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Bzip2'; 18 | } 19 | 20 | require "encode.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/110encode-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Deflate qw($DeflateError) ; 13 | use IO::Uncompress::Inflate qw($InflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Deflate'; 18 | } 19 | 20 | require "encode.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/110encode-gzip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Gzip qw($GzipError) ; 13 | use IO::Uncompress::Gunzip qw($GunzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Gzip'; 18 | } 19 | 20 | require "encode.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/110encode-rawdeflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::RawDeflate qw($RawDeflateError) ; 13 | use IO::Uncompress::RawInflate qw($RawInflateError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::RawDeflate'; 18 | } 19 | 20 | require "encode.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/110encode-zip.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | 12 | use IO::Compress::Zip qw($ZipError) ; 13 | use IO::Uncompress::Unzip qw($UnzipError) ; 14 | 15 | sub identify 16 | { 17 | 'IO::Compress::Zip'; 18 | } 19 | 20 | require "encode.pl" ; 21 | run(); 22 | -------------------------------------------------------------------------------- /t/111const-deflate.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | use bytes; 12 | 13 | use Test::More ; 14 | use CompTestUtils; 15 | 16 | 17 | BEGIN { 18 | # use Test::NoWarnings, if available 19 | my $extra = 0 ; 20 | $extra = 1 21 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 22 | 23 | plan tests => 390 + $extra ; 24 | } 25 | 26 | 27 | { 28 | use Compress::Raw::Zlib ; 29 | 30 | my %all; 31 | for my $symbol (@Compress::Raw::Zlib::DEFLATE_CONSTANTS) 32 | { 33 | eval "defined Compress::Raw::Zlib::$symbol" ; 34 | $all{$symbol} = ! $@ ; 35 | } 36 | 37 | my $pkg = 1; 38 | 39 | for my $module ( qw( Adapter::Deflate RawDeflate Deflate Gzip Zip )) 40 | { 41 | ++ $pkg ; 42 | eval < "Encode is not available" 22 | if $] < 5.006 ; 23 | 24 | eval { require Encode; Encode->import(); }; 25 | 26 | plan skip_all => "Encode is not available" 27 | if $@ ; 28 | 29 | plan skip_all => "Encode not working in perl $]" 30 | if $] >= 5.008 && $] < 5.008004 ; 31 | 32 | # use Test::NoWarnings, if available 33 | my $extra = 0 ; 34 | $extra = 1 35 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 36 | 37 | plan tests => 3 + $extra; 38 | } 39 | 40 | { 41 | title "github-34: Calling nextStream on an IO::Uncompress::Zip object in Transparent mode dies when input is uncompressed"; 42 | # https://github.com/pmqs/IO-Compress/issues/34 43 | 44 | my $lex = LexFile->new( my $file1 ); 45 | 46 | writeFile($file1, "1234\n5678\n"); 47 | 48 | my $in = IO::Uncompress::Unzip->new( $file1, 49 | AutoClose => 1, 50 | Transparent => 1 51 | ) or 52 | die( "foo.txt: $UnzipError\n" ); 53 | 54 | my $data; 55 | my $status; 56 | 57 | # read first stream 58 | $data .= $_ 59 | while <$in> ; 60 | 61 | is $data, "1234\n5678\n" ; 62 | 63 | # This line triggers the error below without a fix 64 | # Can't call method "reset" on an undefined value 65 | is $in->nextStream, 0 ; 66 | } 67 | -------------------------------------------------------------------------------- /t/999meta-json.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use Test::More; 10 | eval "use Test::CPAN::Meta::JSON"; 11 | plan skip_all => "Test::CPAN::Meta::JSON required for testing META.json" if $@; 12 | meta_json_ok(); -------------------------------------------------------------------------------- /t/999meta-yml.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use Test::More; 10 | eval "use Test::CPAN::Meta"; 11 | plan skip_all => "Test::CPAN::Meta required for testing META.yml" if $@; 12 | meta_yaml_ok(); -------------------------------------------------------------------------------- /t/999pod.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use Test::More; 10 | 11 | eval "use Test::Pod 1.00"; 12 | 13 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 14 | 15 | all_pod_files_ok(); 16 | 17 | -------------------------------------------------------------------------------- /t/compress/any.pl: -------------------------------------------------------------------------------- 1 | 2 | use lib 't'; 3 | 4 | use strict; 5 | use warnings; 6 | use bytes; 7 | 8 | use Test::More ; 9 | use CompTestUtils; 10 | 11 | BEGIN { 12 | # use Test::NoWarnings, if available 13 | my $extra = 0 ; 14 | $extra = 1 15 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 16 | 17 | plan tests => 48 + $extra ; 18 | 19 | } 20 | 21 | sub run 22 | { 23 | my $CompressClass = identify(); 24 | my $AnyClass = getClass(); 25 | my $UncompressClass = getInverse($CompressClass); 26 | my $Error = getErrorRef($CompressClass); 27 | my $UnError = getErrorRef($UncompressClass); 28 | 29 | my @anyUnLz = (); 30 | @anyUnLz = (UnLzma => 1 ) if $CompressClass =~ /lzma/i ; 31 | 32 | my $AnyConstruct = "IO::Uncompress::${AnyClass}" ; 33 | no strict 'refs'; 34 | my $AnyError = \${ "IO::Uncompress::${AnyClass}::${AnyClass}Error" }; 35 | 36 | for my $trans ( 0, 1 ) 37 | { 38 | for my $file ( 0, 1 ) 39 | { 40 | title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ; 41 | my $string = "some text" x 100 ; 42 | 43 | my $buffer ; 44 | my $x = $CompressClass->can('new')->($CompressClass, \$buffer) ; 45 | ok $x, " create $CompressClass object" ; 46 | ok $x->write($string), " write to object" ; 47 | ok $x->close, " close ok" ; 48 | 49 | my $lex = LexFile->new( my $output ); 50 | my $input ; 51 | 52 | if ($file) { 53 | writeFile($output, $buffer); 54 | $input = $output; 55 | } 56 | else { 57 | $input = \$buffer; 58 | } 59 | 60 | { 61 | my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, 62 | RawInflate => 1, 63 | @anyUnLz, 64 | Append => 1 ); 65 | 66 | ok $unc, " Created $AnyClass object" 67 | or print "# $$AnyError\n"; 68 | my $uncomp ; 69 | 1 while $unc->read($uncomp) > 0 ; 70 | #ok $unc->read($uncomp) > 0 71 | # or print "# $$AnyError\n"; 72 | my $y; 73 | is $unc->read($y, 1), 0, " at eof" ; 74 | ok $unc->eof(), " at eof" ; 75 | #ok $unc->type eq $Type; 76 | 77 | is $uncomp, $string, " expected output" ; 78 | } 79 | 80 | { 81 | my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, 82 | RawInflate => 1, 83 | @anyUnLz, 84 | Append => 1 ); 85 | 86 | ok $unc, " Created $AnyClass object" 87 | or print "# $$AnyError\n"; 88 | my $uncomp ; 89 | 1 while $unc->read($uncomp, 100) > 0 ; 90 | #ok $unc->read($uncomp) > 0 91 | # or print "# $$AnyError\n"; 92 | my $y; 93 | is $unc->read($y, 1), 0, " at eof" ; 94 | ok $unc->eof(), " at eof" ; 95 | #ok $unc->type eq $Type; 96 | 97 | is $uncomp, $string, " expected output" ; 98 | } 99 | } 100 | } 101 | } 102 | 103 | 1; 104 | -------------------------------------------------------------------------------- /t/compress/anyunc.pl: -------------------------------------------------------------------------------- 1 | 2 | use lib 't'; 3 | 4 | use strict; 5 | use warnings; 6 | use bytes; 7 | 8 | use Test::More ; 9 | use CompTestUtils; 10 | 11 | BEGIN { 12 | # use Test::NoWarnings, if available 13 | my $extra = 0 ; 14 | $extra = 1 15 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 16 | 17 | plan tests => 36 + $extra ; 18 | } 19 | 20 | sub run 21 | { 22 | my $CompressClass = identify(); 23 | my $AnyClass = getClass(); 24 | my $UncompressClass = getInverse($CompressClass); 25 | my $Error = getErrorRef($CompressClass); 26 | my $UnError = getErrorRef($UncompressClass); 27 | 28 | my $AnyConstruct = "IO::Uncompress::${AnyClass}" ; 29 | no strict refs; 30 | my $AnyError = \${ "IO::Uncompress::${AnyClass}::${AnyClass}Error" }; 31 | 32 | for my $trans ( 0, 1 ) 33 | { 34 | for my $file ( 0, 1 ) 35 | { 36 | title "$AnyClass(Transparent => $trans, File=>$file) with $CompressClass" ; 37 | my $string = "some text" x 100 ; 38 | 39 | my $buffer ; 40 | my $x = $CompressClass->can('new')->( $CompressClass, \$buffer) ; 41 | ok $x, " create $CompressClass object" ; 42 | ok $x->write($string), " write to object" ; 43 | ok $x->close, " close ok" ; 44 | 45 | my $lex = LexFile->new( my $output ); 46 | my $input ; 47 | 48 | if ($file) { 49 | writeFile($output, $buffer); 50 | $input = $output; 51 | } 52 | else { 53 | $input = \$buffer; 54 | } 55 | 56 | { 57 | my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans 58 | Append => 1 ); 59 | 60 | ok $unc, " Created $AnyClass object" 61 | or print "# $$AnyError\n"; 62 | my $uncomp ; 63 | 1 while $unc->read($uncomp) > 0 ; 64 | #ok $unc->read($uncomp) > 0 65 | # or print "# $$AnyError\n"; 66 | my $y; 67 | is $unc->read($y, 1), 0, " at eof" ; 68 | ok $unc->eof(), " at eof" ; 69 | #ok $unc->type eq $Type; 70 | 71 | is $uncomp, $string, " expected output" ; 72 | } 73 | 74 | { 75 | my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, 76 | Append =>1 ); 77 | 78 | ok $unc, " Created $AnyClass object" 79 | or print "# $$AnyError\n"; 80 | my $uncomp ; 81 | 1 while $unc->read($uncomp, 10) > 0 ; 82 | my $y; 83 | is $unc->read($y, 1), 0, " at eof" ; 84 | ok $unc->eof(), " at eof" ; 85 | #ok $unc->type eq $Type; 86 | 87 | is $uncomp, $string, " expected output" ; 88 | } 89 | } 90 | } 91 | } 92 | 93 | 1; 94 | -------------------------------------------------------------------------------- /t/compress/destroy.pl: -------------------------------------------------------------------------------- 1 | 2 | use lib 't'; 3 | use strict; 4 | use warnings; 5 | use bytes; 6 | 7 | use Test::More ; 8 | use CompTestUtils; 9 | 10 | BEGIN 11 | { 12 | plan(skip_all => "Destroy not supported in Perl $]") 13 | if $] == 5.008 || ( $] >= 5.005 && $] < 5.006) ; 14 | 15 | # use Test::NoWarnings, if available 16 | my $extra = 0 ; 17 | $extra = 1 18 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 19 | 20 | plan tests => 15 + $extra ; 21 | 22 | use_ok('IO::File') ; 23 | } 24 | 25 | sub run 26 | { 27 | 28 | my $CompressClass = identify(); 29 | my $UncompressClass = getInverse($CompressClass); 30 | my $Error = getErrorRef($CompressClass); 31 | my $UnError = getErrorRef($UncompressClass); 32 | 33 | title "Testing $CompressClass"; 34 | 35 | { 36 | # Check that the class destructor will call close 37 | 38 | my $lex = LexFile->new( my $name ); 39 | 40 | my $hello = <can('new')->( $CompressClass, $name, -AutoClose => 1 ); 48 | 49 | ok $x->write($hello) ; 50 | } 51 | 52 | is anyUncompress($name), $hello ; 53 | } 54 | 55 | { 56 | # Tied filehandle destructor 57 | 58 | 59 | my $lex = LexFile->new( my $name ); 60 | 61 | my $hello = <new( "> $name" ); 67 | 68 | { 69 | ok my $x = $CompressClass->can('new')->( $CompressClass, $fh, -AutoClose => 1 ); 70 | 71 | $x->write($hello) ; 72 | } 73 | 74 | ok anyUncompress($name) eq $hello ; 75 | } 76 | 77 | { 78 | title "Testing DESTROY doesn't clobber \$! etc "; 79 | 80 | my $lex = LexFile->new( my $name ); 81 | 82 | my $out; 83 | my $result; 84 | 85 | { 86 | ok my $z = $CompressClass->can('new')->( $CompressClass, $name ); 87 | $z->write("abc") ; 88 | $! = 22 ; 89 | 90 | cmp_ok $!, '==', 22, ' $! is 22'; 91 | } 92 | 93 | cmp_ok $!, '==', 22, " \$! has not been changed by $CompressClass destructor"; 94 | 95 | 96 | { 97 | my $uncomp; 98 | ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1) ; 99 | 100 | my $len ; 101 | 1 while ($len = $x->read($result)) > 0 ; 102 | 103 | $! = 22 ; 104 | 105 | cmp_ok $!, '==', 22, ' $! is 22'; 106 | } 107 | 108 | cmp_ok $!, '==', 22, " \$! has not been changed by $UncompressClass destructor"; 109 | 110 | is $result, "abc", " Got uncompressed content ok"; 111 | 112 | } 113 | } 114 | 115 | 1; 116 | -------------------------------------------------------------------------------- /t/compress/encode.pl: -------------------------------------------------------------------------------- 1 | 2 | use strict; 3 | use warnings; 4 | use bytes; 5 | 6 | use Test::More ; 7 | use CompTestUtils; 8 | 9 | BEGIN 10 | { 11 | plan skip_all => "Encode is not available" 12 | if $] < 5.006 ; 13 | 14 | eval { require Encode; Encode->import(); }; 15 | 16 | plan skip_all => "Encode is not available" 17 | if $@ ; 18 | 19 | # use Test::NoWarnings, if available 20 | my $extra = 0 ; 21 | 22 | my $st = eval { require Test::NoWarnings ; Test::NoWarnings->import; 1; }; 23 | $extra = 1 24 | if $st ; 25 | 26 | plan(tests => 29 + $extra) ; 27 | } 28 | 29 | sub run 30 | { 31 | my $CompressClass = identify(); 32 | my $UncompressClass = getInverse($CompressClass); 33 | my $Error = getErrorRef($CompressClass); 34 | my $UnError = getErrorRef($UncompressClass); 35 | 36 | 37 | my $string = "\x{df}\x{100}\x80"; 38 | my $encString = Encode::encode_utf8($string); 39 | my $buffer = $encString; 40 | 41 | #for my $from ( qw(filename filehandle buffer) ) 42 | { 43 | # my $input ; 44 | # my $lex = LexFile->new( my $name ); 45 | # 46 | # 47 | # if ($from eq 'buffer') 48 | # { $input = \$buffer } 49 | # elsif ($from eq 'filename') 50 | # { 51 | # $input = $name ; 52 | # writeFile($name, $buffer); 53 | # } 54 | # elsif ($from eq 'filehandle') 55 | # { 56 | # $input = IO::File->new( "<$name" ); 57 | # } 58 | 59 | for my $to ( qw(filehandle buffer)) 60 | { 61 | title "OO Mode: To $to, Encode by hand"; 62 | 63 | my $lex2 = LexFile->new( my $name2 ); 64 | my $output; 65 | my $buffer; 66 | 67 | if ($to eq 'buffer') 68 | { $output = \$buffer } 69 | elsif ($to eq 'filename') 70 | { 71 | $output = $name2 ; 72 | } 73 | elsif ($to eq 'filehandle') 74 | { 75 | $output = IO::File->new( ">$name2" ); 76 | } 77 | 78 | 79 | my $out ; 80 | my $cs = $CompressClass->can('new')->( $CompressClass, $output, AutoClose =>1); 81 | $cs->print($encString); 82 | $cs->close(); 83 | 84 | my $input; 85 | if ($to eq 'buffer') 86 | { $input = \$buffer } 87 | else 88 | { 89 | $input = $name2 ; 90 | } 91 | 92 | my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1); 93 | my $got; 94 | 1 while $ucs->read($got) > 0 ; 95 | 96 | is $got, $encString, " Expected output"; 97 | 98 | my $decode = Encode::decode_utf8($got); 99 | 100 | 101 | is $decode, $string, " Expected output"; 102 | 103 | 104 | } 105 | } 106 | 107 | { 108 | title "Catch wide characters"; 109 | 110 | my $out; 111 | my $cs = $CompressClass->can('new')->( $CompressClass, \$out); 112 | my $a = "a\xFF\x{100}"; 113 | eval { $cs->syswrite($a) }; 114 | like($@, qr/Wide character in ${CompressClass}::write/, 115 | " wide characters in ${CompressClass}::write"); 116 | 117 | } 118 | 119 | { 120 | title "Unknown encoding"; 121 | my $output; 122 | eval { my $cs = $CompressClass->can('new')->( $CompressClass, \$output, Encode => 'fred'); } ; 123 | like($@, qr/${CompressClass}: Encoding 'fred' is not available/, 124 | " Encoding 'fred' is not available"); 125 | } 126 | 127 | { 128 | title "Encode option"; 129 | 130 | for my $to ( qw(filehandle filename buffer)) 131 | { 132 | title "Encode: To $to, Encode option"; 133 | 134 | my $lex2 = LexFile->new( my $name2 ); 135 | my $output; 136 | my $buffer; 137 | 138 | if ($to eq 'buffer') 139 | { 140 | $output = \$buffer 141 | } 142 | elsif ($to eq 'filename') 143 | { 144 | $output = $name2 ; 145 | } 146 | elsif ($to eq 'filehandle') 147 | { 148 | $output = IO::File->new( ">$name2" ); 149 | } 150 | 151 | my $out ; 152 | my $cs = $CompressClass->can('new')->( $CompressClass, $output, AutoClose =>1, Encode => 'utf8'); 153 | ok $cs->print($string); 154 | ok $cs->close(); 155 | 156 | my $input; 157 | if ($to eq 'buffer') 158 | { 159 | $input = \$buffer 160 | } 161 | elsif ($to eq 'filename') 162 | { 163 | $input = $name2 ; 164 | } 165 | else 166 | { 167 | $input = IO::File->new( "<$name2" ); 168 | } 169 | 170 | { 171 | my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, AutoClose =>1, Append => 1); 172 | my $got; 173 | 1 while $ucs->read($got) > 0 ; 174 | ok length($got) > 0; 175 | is $got, $encString, " Expected output"; 176 | 177 | my $decode = Encode::decode_utf8($got); 178 | 179 | is $decode, $string, " Expected output"; 180 | } 181 | 182 | 183 | # { 184 | # my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1, Decode => 'utf8'); 185 | # my $got; 186 | # 1 while $ucs->read($got) > 0 ; 187 | # ok length($got) > 0; 188 | # is $got, $string, " Expected output"; 189 | # } 190 | } 191 | } 192 | 193 | } 194 | 195 | 196 | 197 | 1; 198 | -------------------------------------------------------------------------------- /t/compress/prime.pl: -------------------------------------------------------------------------------- 1 | 2 | use lib 't'; 3 | use strict; 4 | use warnings; 5 | use bytes; 6 | 7 | use Test::More ; 8 | use CompTestUtils; 9 | 10 | our ($extra); 11 | 12 | BEGIN { 13 | plan skip_all => "Lengthy Tests Disabled\n" . 14 | "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" 15 | unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; 16 | 17 | # use Test::NoWarnings, if available 18 | $extra = 0 ; 19 | $extra = 1 20 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 21 | 22 | } 23 | 24 | sub run 25 | { 26 | 27 | my $CompressClass = identify(); 28 | my $UncompressClass = getInverse($CompressClass); 29 | my $Error = getErrorRef($CompressClass); 30 | my $UnError = getErrorRef($UncompressClass); 31 | 32 | 33 | 34 | my $hello = < (length($compressed) * 6 * 7) + 1 + $extra ; 47 | 48 | is anyUncompress(\$cc), $hello ; 49 | 50 | for my $blocksize (1, 2, 13) 51 | { 52 | for my $i (0 .. length($compressed) - 1) 53 | { 54 | for my $useBuf (0 .. 1) 55 | { 56 | print "#\n# BlockSize $blocksize, Length $i, Buffer $useBuf\n#\n" ; 57 | my $lex = LexFile->new( my $name ); 58 | 59 | my $prime = substr($compressed, 0, $i); 60 | my $rest = substr($compressed, $i); 61 | 62 | my $start ; 63 | if ($useBuf) { 64 | $start = \$rest ; 65 | } 66 | else { 67 | $start = $name ; 68 | writeFile($name, $rest); 69 | } 70 | 71 | #my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, 72 | my $gz = $UncompressClass->can('new')->( $UncompressClass, $start, 73 | -Append => 1, 74 | -BlockSize => $blocksize, 75 | -Prime => $prime, 76 | -Transparent => 0 77 | ); 78 | ok $gz; 79 | ok ! $gz->error() ; 80 | my $un ; 81 | my $status = 1 ; 82 | $status = $gz->read($un) while $status > 0 ; 83 | is $status, 0 ; 84 | ok ! $gz->error() 85 | or print "Error is '" . $gz->error() . "'\n"; 86 | is $un, $hello ; 87 | ok $gz->eof() ; 88 | ok $gz->close() ; 89 | } 90 | } 91 | } 92 | } 93 | 94 | 1; 95 | -------------------------------------------------------------------------------- /t/compress/zlib-generic.pl: -------------------------------------------------------------------------------- 1 | 2 | use strict; 3 | use warnings; 4 | use bytes; 5 | 6 | use Test::More ; 7 | use CompTestUtils; 8 | 9 | BEGIN 10 | { 11 | # use Test::NoWarnings, if available 12 | my $extra = 0 ; 13 | $extra = 1 14 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 15 | 16 | plan tests => 49 + $extra ; 17 | } 18 | 19 | 20 | 21 | my $CompressClass = identify(); 22 | my $UncompressClass = getInverse($CompressClass); 23 | my $Error = getErrorRef($CompressClass); 24 | my $UnError = getErrorRef($UncompressClass); 25 | 26 | use Compress::Raw::Zlib; 27 | use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); 28 | 29 | sub myGZreadFile 30 | { 31 | my $filename = shift ; 32 | my $init = shift ; 33 | 34 | 35 | my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, 36 | -Strict => 1, 37 | -Append => 1 38 | ); 39 | 40 | my $data = ''; 41 | $data = $init if defined $init ; 42 | 1 while $fil->read($data) > 0; 43 | 44 | $fil->close ; 45 | return $data ; 46 | } 47 | 48 | 49 | { 50 | 51 | title "Testing $CompressClass Errors"; 52 | 53 | } 54 | 55 | 56 | { 57 | title "Testing $UncompressClass Errors"; 58 | 59 | } 60 | 61 | { 62 | title "Testing $CompressClass and $UncompressClass"; 63 | 64 | { 65 | title "flush" ; 66 | 67 | 68 | my $lex = LexFile->new( my $name ); 69 | 70 | my $hello = <can('new')->( $CompressClass, $name ); 78 | 79 | ok $x->write($hello), "write" ; 80 | ok $x->flush(Z_FINISH), "flush"; 81 | ok $x->close, "close" ; 82 | } 83 | 84 | { 85 | my $uncomp; 86 | ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1 ); 87 | 88 | my $len ; 89 | 1 while ($len = $x->read($uncomp)) > 0 ; 90 | 91 | is $len, 0, "read returned 0"; 92 | 93 | ok $x->close ; 94 | is $uncomp, $hello ; 95 | } 96 | } 97 | 98 | 99 | if ($CompressClass ne 'RawDeflate') 100 | { 101 | # write empty file 102 | #======================================== 103 | 104 | my $buffer = ''; 105 | { 106 | my $x ; 107 | ok $x = $CompressClass->can('new')->( $CompressClass, \$buffer); 108 | ok $x->close ; 109 | 110 | } 111 | 112 | my $keep = $buffer ; 113 | my $uncomp= ''; 114 | { 115 | my $x ; 116 | ok $x = $UncompressClass->can('new')->( $UncompressClass, \$buffer, Append => 1) ; 117 | 118 | 1 while $x->read($uncomp) > 0 ; 119 | 120 | ok $x->close ; 121 | } 122 | 123 | ok $uncomp eq '' ; 124 | ok $buffer eq $keep ; 125 | 126 | } 127 | 128 | 129 | { 130 | title "inflateSync on plain file"; 131 | 132 | my $hello = "I am a HAL 9000 computer" x 2001 ; 133 | 134 | my $k = $UncompressClass->can('new')->( $UncompressClass, \$hello, Transparent => 1); 135 | ok $k ; 136 | 137 | # Skip to the flush point -- no-op for plain file 138 | my $status = $k->inflateSync(); 139 | is $status, 1 140 | or diag $k->error() ; 141 | 142 | my $rest; 143 | is $k->read($rest, length($hello)), length($hello) 144 | or diag $k->error() ; 145 | ok $rest eq $hello ; 146 | 147 | ok $k->close(); 148 | } 149 | 150 | { 151 | title "$CompressClass: inflateSync for real"; 152 | 153 | # create a deflate stream with flush points 154 | 155 | my $hello = "I am a HAL 9000 computer" x 2001 ; 156 | my $goodbye = "Will I dream?" x 2010; 157 | my ($x, $err, $answer, $X, $Z, $status); 158 | my $Answer ; 159 | 160 | ok ($x = $CompressClass->can('new')->( $CompressClass, \$Answer)); 161 | ok $x ; 162 | 163 | is $x->write($hello), length($hello); 164 | 165 | # create a flush point 166 | ok $x->flush(Z_FULL_FLUSH) ; 167 | 168 | is $x->write($goodbye), length($goodbye); 169 | 170 | ok $x->close() ; 171 | 172 | my $k; 173 | $k = $UncompressClass->can('new')->( $UncompressClass, \$Answer, BlockSize => 1); 174 | ok $k ; 175 | 176 | my $initial; 177 | is $k->read($initial, 1), 1 ; 178 | is $initial, substr($hello, 0, 1); 179 | 180 | # Skip to the flush point 181 | $status = $k->inflateSync(); 182 | is $status, 1, " inflateSync returned 1" 183 | or diag $k->error() ; 184 | 185 | my $rest; 186 | is $k->read($rest, length($hello) + length($goodbye)), 187 | length($goodbye) 188 | or diag $k->error() ; 189 | ok $rest eq $goodbye, " got expected output" ; 190 | 191 | ok $k->close(); 192 | } 193 | 194 | { 195 | title "$CompressClass: inflateSync no FLUSH point"; 196 | 197 | # create a deflate stream with flush points 198 | 199 | my $hello = "I am a HAL 9000 computer" x 2001 ; 200 | my ($x, $err, $answer, $X, $Z, $status); 201 | my $Answer ; 202 | 203 | ok ($x = $CompressClass->can('new')->( $CompressClass, \$Answer)); 204 | ok $x ; 205 | 206 | is $x->write($hello), length($hello); 207 | 208 | ok $x->close() ; 209 | 210 | my $k = $UncompressClass->can('new')->( $UncompressClass, \$Answer, BlockSize => 1); 211 | ok $k ; 212 | 213 | my $initial; 214 | is $k->read($initial, 1), 1 ; 215 | is $initial, substr($hello, 0, 1); 216 | 217 | # Skip to the flush point 218 | $status = $k->inflateSync(); 219 | is $status, 0 220 | or diag $k->error() ; 221 | 222 | ok $k->close(); 223 | is $k->inflateSync(), 0 ; 224 | } 225 | 226 | } 227 | 228 | 229 | 1; 230 | -------------------------------------------------------------------------------- /t/cz-01version.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict ; 10 | use warnings ; 11 | 12 | use Test::More ; 13 | 14 | BEGIN 15 | { 16 | # use Test::NoWarnings, if available 17 | my $extra = 0 ; 18 | $extra = 1 19 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 20 | 21 | plan tests => 2 + $extra ; 22 | 23 | use_ok('Compress::Zlib', 2) ; 24 | } 25 | 26 | # Check zlib_version and ZLIB_VERSION are the same. 27 | 28 | SKIP: { 29 | skip "TEST_SKIP_VERSION_CHECK is set", 1 30 | if $ENV{TEST_SKIP_VERSION_CHECK}; 31 | my $zlib_h = ZLIB_VERSION ; 32 | my $libz = Compress::Zlib::zlib_version; 33 | 34 | is($zlib_h, $libz, "ZLIB_VERSION ($zlib_h) matches Compress::Zlib::zlib_version") 35 | or diag < "Examples needs Perl 5.005 or better - you have Perl $]" ) 21 | if $] < 5.005 ; 22 | 23 | # use Test::NoWarnings, if available 24 | my $extra = 0 ; 25 | $extra = 1 26 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 27 | 28 | plan tests => 26 + $extra ; 29 | } 30 | 31 | 32 | my $Inc = join " ", map qq["-I$_"] => @INC; 33 | $Inc = '"-MExtUtils::testlib"' 34 | if ! $ENV{PERL_CORE} && eval " require ExtUtils::testlib; " ; 35 | 36 | my $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; 37 | $Perl = qq["$Perl"] if $^O eq 'MSWin32' ; 38 | 39 | $Perl = "$Perl $Inc -w" ; 40 | my $examples = $ENV{PERL_CORE} ? "../ext/IO-Compress/examples/compress-zlib" 41 | : "./examples/compress-zlib"; 42 | 43 | my $hello1 = <gzwrite($hello1); 77 | $gz->gzclose(); 78 | 79 | $gz = gzopen($file2, "wb"); 80 | $gz->gzwrite($hello2); 81 | $gz->gzclose(); 82 | 83 | sub check 84 | { 85 | my $command = shift ; 86 | my $expected = shift ; 87 | 88 | my $stderr = 'err.out'; 89 | 1 while unlink $stderr; 90 | 91 | my $cmd = "$command 2>$stderr"; 92 | my $stdout = `$cmd` ; 93 | 94 | my $aok = 1 ; 95 | 96 | $aok &= is $?, 0, " exit status is 0" ; 97 | 98 | $aok &= is readFile($stderr), '', " no stderr" ; 99 | 100 | $aok &= is $stdout, $expected, " expected content is ok" 101 | if defined $expected ; 102 | 103 | if (! $aok) { 104 | diag "Command line: $cmd"; 105 | my ($file, $line) = (caller)[1,2]; 106 | diag "Test called from $file, line $line"; 107 | } 108 | 109 | 1 while unlink $stderr; 110 | } 111 | 112 | # gzcat 113 | # ##### 114 | 115 | title "gzcat - command line" ; 116 | check "$Perl ${examples}/gzcat $file1 $file2", $hello1 . $hello2; 117 | 118 | title "gzcat - stdin" ; 119 | check "$Perl ${examples}/gzcat <$file1 ", $hello1; 120 | 121 | 122 | # gzgrep 123 | # ###### 124 | 125 | title "gzgrep"; 126 | check "$Perl ${examples}/gzgrep the $file1 $file2", 127 | join('', grep(/the/, @hello1, @hello2)); 128 | 129 | for ($file1, $file2, $stderr) { 1 while unlink $_ } ; 130 | 131 | 132 | 133 | # filtdef/filtinf 134 | # ############## 135 | 136 | 137 | writeFile($file1, $hello1) ; 138 | writeFile($file2, $hello2) ; 139 | 140 | title "filtdef" ; 141 | # there's no way to set binmode on backticks in Win32 so we won't use $a later 142 | check "$Perl ${examples}/filtdef $file1 $file2" ; 143 | 144 | title "filtdef | filtinf"; 145 | check "$Perl ${examples}/filtdef $file1 $file2 | $Perl ${examples}/filtinf", 146 | $hello1 . $hello2; 147 | # gzstream 148 | # ######## 149 | 150 | { 151 | title "gzstream" ; 152 | writeFile($file1, $hello1) ; 153 | check "$Perl ${examples}/gzstream <$file1 >$file2"; 154 | 155 | title "gzcat" ; 156 | check "$Perl ${examples}/gzcat $file2", $hello1 ; 157 | } 158 | 159 | END 160 | { 161 | for ($file1, $file2, $stderr) { 1 while unlink $_ } ; 162 | } 163 | -------------------------------------------------------------------------------- /t/cz-06gzsetp.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | use bytes; 12 | 13 | use Test::More ; 14 | use CompTestUtils; 15 | 16 | use Compress::Zlib 2 ; 17 | 18 | use IO::Compress::Gzip ; 19 | use IO::Uncompress::Gunzip ; 20 | 21 | use IO::Compress::Deflate ; 22 | use IO::Uncompress::Inflate ; 23 | 24 | use IO::Compress::RawDeflate ; 25 | use IO::Uncompress::RawInflate ; 26 | 27 | our ($extra); 28 | 29 | 30 | BEGIN 31 | { 32 | # use Test::NoWarnings, if available 33 | $extra = 0 ; 34 | $extra = 1 35 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 36 | } 37 | 38 | my $ver = Compress::Zlib::zlib_version(); 39 | plan skip_all => "gzsetparams needs zlib 1.0.6 or better. You have $ver\n" 40 | if ZLIB_VERNUM() < 0x1060 ; 41 | 42 | plan tests => 51 + $extra ; 43 | 44 | # Check zlib_version and ZLIB_VERSION are the same. 45 | SKIP: { 46 | skip "TEST_SKIP_VERSION_CHECK is set", 1 47 | if $ENV{TEST_SKIP_VERSION_CHECK}; 48 | is Compress::Zlib::zlib_version, ZLIB_VERSION, 49 | "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; 50 | } 51 | 52 | { 53 | # gzsetparams 54 | title "Testing gzsetparams"; 55 | 56 | my $hello = "I am a HAL 9000 computer" x 2001 ; 57 | my $len_hello = length $hello ; 58 | my $goodbye = "Will I dream?" x 2010; 59 | my $len_goodbye = length $goodbye; 60 | 61 | my ($input, $err, $answer, $X, $status, $Answer); 62 | 63 | my $lex = LexFile->new( my $name ); 64 | ok my $x = gzopen($name, "wb"); 65 | 66 | $input .= $hello; 67 | is $x->gzwrite($hello), $len_hello, "gzwrite returned $len_hello" ; 68 | 69 | # Error cases 70 | eval { $x->gzsetparams() }; 71 | like $@, mkErr('^Usage: Compress::Zlib::gzFile::gzsetparams\(file, level, strategy\)'); 72 | 73 | # Change both Level & Strategy 74 | $status = $x->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; 75 | cmp_ok $status, '==', Z_OK, "status is Z_OK"; 76 | 77 | $input .= $goodbye; 78 | is $x->gzwrite($goodbye), $len_goodbye, "gzwrite returned $len_goodbye" ; 79 | 80 | ok ! $x->gzclose, "closed" ; 81 | 82 | ok my $k = gzopen($name, "rb") ; 83 | 84 | # calling gzsetparams on reading is not allowed. 85 | $status = $k->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; 86 | cmp_ok $status, '==', Z_STREAM_ERROR, "status is Z_STREAM_ERROR" ; 87 | 88 | my $len = length $input ; 89 | my $uncompressed; 90 | is $len, $k->gzread($uncompressed, $len) ; 91 | 92 | ok $uncompressed eq $input ; 93 | ok $k->gzeof ; 94 | ok ! $k->gzclose ; 95 | ok $k->gzeof ; 96 | } 97 | 98 | 99 | foreach my $CompressClass ('IO::Compress::Gzip', 100 | 'IO::Compress::Deflate', 101 | 'IO::Compress::RawDeflate', 102 | ) 103 | { 104 | my $UncompressClass = getInverse($CompressClass); 105 | 106 | title "Testing $CompressClass"; 107 | 108 | 109 | # deflateParams 110 | 111 | my $hello = "I am a HAL 9000 computer" x 2001 ; 112 | my $len_hello = length $hello ; 113 | my $goodbye = "Will I dream?" x 2010; 114 | my $len_goodbye = length $goodbye; 115 | 116 | #my ($input, $err, $answer, $X, $status, $Answer); 117 | my $compressed; 118 | 119 | ok my $x = $CompressClass->can('new')->( $CompressClass, \$compressed) ; 120 | 121 | my $input .= $hello; 122 | is $x->write($hello), $len_hello, "wrote $len_hello bytes" ; 123 | 124 | # Change both Level & Strategy 125 | ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY), "deflateParams ok"; 126 | 127 | $input .= $goodbye; 128 | is $x->write($goodbye), $len_goodbye, "wrote $len_goodbye bytes" ; 129 | 130 | ok $x->close, "closed $CompressClass object" ; 131 | 132 | my $k = $UncompressClass->can('new')->( $UncompressClass, \$compressed); 133 | isa_ok $k, $UncompressClass; 134 | 135 | my $len = length $input ; 136 | my $uncompressed; 137 | is $k->read($uncompressed, $len), $len 138 | or diag "$IO::Uncompress::Gunzip::GunzipError" ; 139 | 140 | ok $uncompressed eq $input, "got expected uncompressed data" 141 | or diag("unc len = " . length($uncompressed) . ", input len = " . 142 | length($input) . "\n") ; 143 | ok $k->eof, "eof" ; 144 | ok $k->close, "closed" ; 145 | ok $k->eof, "eof" ; 146 | } 147 | -------------------------------------------------------------------------------- /t/cz-08encoding.t: -------------------------------------------------------------------------------- 1 | BEGIN { 2 | if ($ENV{PERL_CORE}) { 3 | chdir 't' if -d 't'; 4 | @INC = ("../lib", "lib/compress"); 5 | } 6 | } 7 | 8 | use lib qw(t t/compress); 9 | use strict; 10 | use warnings; 11 | use bytes; 12 | 13 | use Test::More ; 14 | use CompTestUtils; 15 | 16 | BEGIN 17 | { 18 | plan skip_all => "Encode is not available" 19 | if $] < 5.006 ; 20 | 21 | eval { require Encode; Encode->import(); }; 22 | 23 | plan skip_all => "Encode is not available" 24 | if $@ ; 25 | 26 | # use Test::NoWarnings, if available 27 | my $extra = 0 ; 28 | $extra = 1 29 | if eval { require Test::NoWarnings ; Test::NoWarnings->import; 1 }; 30 | 31 | plan tests => 29 + $extra ; 32 | 33 | use_ok('Compress::Zlib', qw(:ALL zlib_version memGunzip memGzip)); 34 | } 35 | 36 | 37 | 38 | 39 | # Check zlib_version and ZLIB_VERSION are the same. 40 | SKIP: { 41 | skip "TEST_SKIP_VERSION_CHECK is set", 1 42 | if $ENV{TEST_SKIP_VERSION_CHECK}; 43 | is Compress::Zlib::zlib_version, ZLIB_VERSION, 44 | "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; 45 | } 46 | 47 | { 48 | title "memGzip" ; 49 | # length of this string is 2 characters 50 | my $s = "\x{df}\x{100}"; 51 | 52 | my $cs = memGzip(Encode::encode_utf8($s)); 53 | 54 | # length stored at end of gzip file should be 4 55 | my ($crc, $len) = unpack ("VV", substr($cs, -8, 8)); 56 | 57 | is $len, 4, " length is 4"; 58 | } 59 | 60 | { 61 | title "memGunzip when compressed gzip has been encoded" ; 62 | my $s = "hello world" ; 63 | 64 | my $co = memGzip($s); 65 | is memGunzip(my $x = $co), $s, " match uncompressed"; 66 | 67 | utf8::upgrade($co); 68 | 69 | my $un = memGunzip($co); 70 | ok $un, " got uncompressed"; 71 | 72 | is $un, $s, " uncompressed matched original"; 73 | } 74 | 75 | { 76 | title "compress/uncompress"; 77 | 78 | my $s = "\x{df}\x{100}"; 79 | my $s_copy = $s ; 80 | 81 | my $ces = compress(Encode::encode_utf8($s_copy)); 82 | 83 | ok $ces, " compressed ok" ; 84 | 85 | my $un = Encode::decode_utf8(uncompress($ces)); 86 | is $un, $s, " decode_utf8 ok"; 87 | 88 | utf8::upgrade($ces); 89 | $un = Encode::decode_utf8(uncompress($ces)); 90 | is $un, $s, " decode_utf8 ok"; 91 | 92 | } 93 | 94 | { 95 | title "gzopen" ; 96 | 97 | my $s = "\x{df}\x{100}"; 98 | my $byte_len = length( Encode::encode_utf8($s) ); 99 | my ($uncomp) ; 100 | 101 | my $lex = LexFile->new( my $name ); 102 | ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ; 103 | 104 | is $fil->gzwrite(Encode::encode_utf8($s)), $byte_len, " wrote $byte_len bytes" ; 105 | 106 | ok ! $fil->gzclose, " gzclose ok" ; 107 | 108 | ok $fil = gzopen($name, "rb"), " gzopen for read ok" ; 109 | 110 | is $fil->gzread($uncomp), $byte_len, " read $byte_len bytes" ; 111 | is length($uncomp), $byte_len, " uncompress is $byte_len bytes"; 112 | 113 | ok ! $fil->gzclose, "gzclose ok" ; 114 | 115 | is $s, Encode::decode_utf8($uncomp), " decode_utf8 ok" ; 116 | } 117 | 118 | { 119 | title "Catch wide characters"; 120 | 121 | my $a = "a\xFF\x{100}"; 122 | eval { memGzip($a) }; 123 | like($@, qr/Wide character in memGzip/, " wide characters in memGzip"); 124 | 125 | eval { memGunzip($a) }; 126 | like($@, qr/Wide character in memGunzip/, " wide characters in memGunzip"); 127 | 128 | eval { compress($a) }; 129 | like($@, qr/Wide character in compress/, " wide characters in compress"); 130 | 131 | eval { uncompress($a) }; 132 | like($@, qr/Wide character in uncompress/, " wide characters in uncompress"); 133 | 134 | my $lex = LexFile->new( my $name ); 135 | ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ; 136 | 137 | eval { $fil->gzwrite($a); } ; 138 | like($@, qr/Wide character in gzwrite/, " wide characters in gzwrite"); 139 | 140 | ok ! $fil->gzclose, " gzclose ok" ; 141 | } 142 | -------------------------------------------------------------------------------- /t/files/bad-efs.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/bad-efs.zip -------------------------------------------------------------------------------- /t/files/encrypt-aes.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/encrypt-aes.zip -------------------------------------------------------------------------------- /t/files/encrypt-standard.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/encrypt-standard.zip -------------------------------------------------------------------------------- /t/files/jar.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/jar.zip -------------------------------------------------------------------------------- /t/files/meta.xml: -------------------------------------------------------------------------------- 1 | 2 | 2018-12-25T11:36:11.4372605432018-12-25T11:36:55.657945697PT54S1LibreOffice/6.0.7.3$Linux_X86_64 LibreOffice_project/00m0$Build-3 -------------------------------------------------------------------------------- /t/files/test.ods: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/test.ods -------------------------------------------------------------------------------- /t/files/testfile1.odt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/testfile1.odt -------------------------------------------------------------------------------- /t/files/time-UX.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/time-UX.zip -------------------------------------------------------------------------------- /t/files/time-dos.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/time-dos.zip -------------------------------------------------------------------------------- /t/files/time-ntfs.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/time-ntfs.zip -------------------------------------------------------------------------------- /t/files/time-ut.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/time-ut.zip -------------------------------------------------------------------------------- /t/files/valid-cp850.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/valid-cp850.zip -------------------------------------------------------------------------------- /t/files/valid-utf8-bom-efs.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/valid-utf8-bom-efs.zip -------------------------------------------------------------------------------- /t/files/valid-utf8-efs.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pmqs/IO-Compress/e70223ed043fb11c0dcaad3204286ee0a263f58e/t/files/valid-utf8-efs.zip --------------------------------------------------------------------------------