git.maemo.org Git - pkg-perl/blob - deb-src/libarchive-zip-perl/libarchive-zip-perl-1.18/examples/zipcheck.pl

   1 #!/bin/perl -w
   2 # usage: valid zipname.zip
   3 # exits with non-zero status if invalid zip
   4 # status = 1: invalid arguments
   5 # status = 2: generic error somewhere
   6 # status = 3: format error
   7 # status = 4: IO error
   8 use strict;
   9 use Archive::Zip qw(:ERROR_CODES);
  10 use IO::Handle;
  11 use File::Spec;
  12
  13 # instead of stack dump:
  14 Archive::Zip::setErrorHandler( sub { warn shift() } );
  15
  16 my $nullFileName = File::Spec->devnull();
  17 my $zip = Archive::Zip->new();
  18 my $zipName = shift(@ARGV) || exit 1;
  19 eval
  20 {
  21         my $status = $zip->read( $zipName );
  22         exit $status if $status != AZ_OK;
  23 };
  24 if ($@) { warn 'error reading zip:', $@, "\n"; exit 2 }
  25
  26 eval
  27 {
  28         foreach my $member ($zip->members)
  29         {
  30                 my $fh = IO::File->new();
  31                 $fh->open(">$nullFileName") || die "can't open $nullFileName\: $!\n";
  32                 my $status = $member->extractToFileHandle($fh);
  33                 if ($status != AZ_OK)
  34                 {
  35                         warn "Extracting ", $member->fileName(), " from $zipName failed\n";
  36                         exit $status;
  37                 }
  38         }
  39 }