xref: /aoo41x/main/solenv/bin/cleanzip.pl (revision 7e90fac2)
1#!/usr/bin/perl -w
2#**************************************************************
3#
4#  Licensed to the Apache Software Foundation (ASF) under one
5#  or more contributor license agreements.  See the NOTICE file
6#  distributed with this work for additional information
7#  regarding copyright ownership.  The ASF licenses this file
8#  to you under the Apache License, Version 2.0 (the
9#  "License"); you may not use this file except in compliance
10#  with the License.  You may obtain a copy of the License at
11#
12#    http://www.apache.org/licenses/LICENSE-2.0
13#
14#  Unless required by applicable law or agreed to in writing,
15#  software distributed under the License is distributed on an
16#  "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
17#  KIND, either express or implied.  See the License for the
18#  specific language governing permissions and limitations
19#  under the License.
20#
21#**************************************************************
22
23
24
25sub usage
26{
27	print "Cleanup unwanted unix attributes in zip archives\n\n";
28	print "Usage:\n";
29	print "$0 archive\n\n";
30    exit(1);
31}
32
33usage() if ! defined $ARGV[0];
34
35my $filename = $ARGV[0];
36use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
37my $zip = Archive::Zip->new();
38
39unless ( $zip->read( $filename ) == AZ_OK ) {
40	die "$0: ERROR reading $filename\n";
41}
42my @members = $zip ->members();
43
44foreach my $member ( @members ) {
45#	printf ( "%o\n",$member->unixFileAttributes());
46#	printf ( "%o\n",$member->unixFileAttributes() & 0b111111111111);
47	my $attribs = $member->unixFileAttributes();
48	if ( $member->isDirectory ) {
49		$attribs = $attribs & 0b101111111111;
50		$member->unixFileAttributes($attribs)
51	}
52#	printf ( "%o\n",$member->unixFileAttributes());
53#	printf ( "%o\n",$member->unixFileAttributes() & 0b111111111111);
54#	print ( $member->fileName()."\n");
55}
56unless ( $zip->writeToFileNamed( ${filename}."_new" ) == AZ_OK ) {
57	die "$0: ERROR reading ${filename}_new\n";
58}
59rename($filename."_new", $filename);
60
61