solenv/bin/cleanzip.pl

   1 #!/usr/bin/perl -w
   2 #*************************************************************************
   3 #
   4 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   5 #
   6 # Copyright 2008 by Sun Microsystems, Inc.
   7 #
   8 # OpenOffice.org - a multi-platform office productivity suite
   9 #
  10 # $RCSfile: cleanzip.pl,v $
  11 #
  12 # $Revision$
  13 #
  14 # This file is part of OpenOffice.org.
  15 #
  16 # OpenOffice.org is free software: you can redistribute it and/or modify
  17 # it under the terms of the GNU Lesser General Public License version 3
  18 # only, as published by the Free Software Foundation.
  19 #
  20 # OpenOffice.org is distributed in the hope that it will be useful,
  21 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 # GNU Lesser General Public License version 3 for more details
  24 # (a copy is included in the LICENSE file that accompanied this code).
  25 #
  26 # You should have received a copy of the GNU Lesser General Public License
  27 # version 3 along with OpenOffice.org.  If not, see
  28 # <http://www.openoffice.org/license.html>
  29 # for a copy of the LGPLv3 License.
  30 #
  31 #*************************************************************************
  32
  33 sub usage
  34 {
  35     print "Cleanup unwanted unix attributes in zip archives\n\n";
  36     print "Usage:\n";
  37     print "$0 archive\n\n";
  38     exit(1);
  39 }
  40
  41 usage() if ! defined $ARGV[0];
  42
  43 my $filename = $ARGV[0];
  44 use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
  45 my $zip = Archive::Zip->new();
  46
  47 unless ( $zip->read( $filename ) == AZ_OK ) {
  48     die "$0: ERROR reading $filename\n";
  49 }
  50 my @members = $zip ->members();
  51
  52 foreach my $member ( @members ) {
  53 #       printf ( "%o\n",$member->unixFileAttributes());
  54 #       printf ( "%o\n",$member->unixFileAttributes() & 0b111111111111);
  55     my $attribs = $member->unixFileAttributes();
  56     if ( $member->isDirectory ) {
  57         $attribs = $attribs & 0b101111111111;
  58         $member->unixFileAttributes($attribs)
  59     }
  60 #       printf ( "%o\n",$member->unixFileAttributes());
  61 #       printf ( "%o\n",$member->unixFileAttributes() & 0b111111111111);
  62 #       print ( $member->fileName()."\n");
  63 }
  64 unless ( $zip->writeToFileNamed( ${filename}."_new" ) == AZ_OK ) {
  65     die "$0: ERROR reading ${filename}_new\n";
  66 }
  67 rename($filename."_new", $filename);
  68