3 # Copyright (C) 2010 Morten Welinder.
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License as published by
7 # the Free Software Foundation; either version 2 of the License, or
8 # (at your option) any later version.
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, see <https://www.gnu.org/licenses/>.
28 # -----------------------------------------------------------------------------
31 my $subfuzzer = 'fuzzxml %i %o';
34 Getopt
::Long
::Configure
("bundling");
35 &GetOptions
("subfile=s" => \
@subfile,
36 "subfuzzer=s" => \
$subfuzzer,
37 "v|verbose" => \
$verbose,
40 my $infile = shift @ARGV;
41 my $outfile = shift @ARGV;
42 die "$me: usage [options] infile outfile\n" unless defined $outfile;
44 $outfile = File
::Spec
->rel2abs ($outfile);
46 die "$me: one or more subfiles should be specified with --subfile\n"
49 my @quiet = $verbose ?
() : ("-q");
51 # -----------------------------------------------------------------------------
53 my $tmpdir = File
::Temp
::tempdir
("fuzzzip.XXXXXX",
58 my @cmd = ("unzip", @quiet, $infile, "-d", $tmpdir);
59 print STDERR
"@cmd\n" if $verbose;
60 my $res = system (@cmd);
61 die "$me: unzipping failed.\n" unless $res == 0;
64 # -----------------------------------------------------------------------------
66 foreach my $file (@subfile) {
67 die "Archive has no $file" unless -f
"$tmpdir/$file";
69 my $tmpfile = "$file.tmp";
72 $cmd =~ s{\%i}{$tmpdir/$file};
73 $cmd =~ s{\%o}{$tmpdir/$tmpfile};
75 print STDERR
"$cmd\n" if $verbose;
76 my $res = system ($cmd);
77 die "$me: fuzzing failed.\n" unless $res == 0;
79 # system ("diff -uw $tmpdir/$tmpfile $tmpdir/$file");
81 rename "$tmpdir/$tmpfile", "$tmpdir/$file" or
82 die "$me: cannot renamed $tmpfile into place: $!\n";
85 # -----------------------------------------------------------------------------
87 print STDERR
"chdir $tmpdir\n" if $verbose;
88 chdir $tmpdir || die "$me: cannot chdir to $tmpdir: $!\n";
95 my $name = $File::Find
::name
;
97 if ($name eq 'mimetype') {
98 push @stored_files, $name;
108 my $archive = "foo.zip";
111 my @cmd = ("zip", @quiet, $archive, "-0", @stored_files);
112 print STDERR
"@cmd\n" if $verbose;
113 my $res = system (@cmd);
114 die "$me: zipping failed.\n" unless $res == 0;
118 my @cmd = ("zip", @quiet, $archive, "-9", @files);
119 print STDERR
"@cmd\n" if $verbose;
120 my $res = system (@cmd);
121 die "$me: zipping failed.\n" unless $res == 0;
124 &File
::Copy
::move
($archive, $outfile);
127 # Some versions need this for tmpdir cleanup.
128 chdir "/" or chdir $ENV{'HOME'};
130 # -----------------------------------------------------------------------------